[ANE-1827] - Replace "tomland" with "toml-parser" for parsing toml files

Changelog.md

@@ -2,6 +2,7 @@
 
 ## Unreleased
 
+- Resolve an issue parsing toml configuration files. ([#1459](https://github.com/fossas/fossa-cli/pull/1459))
 - Gradle: ignore deprecated configurations ([#1457](https://github.com/fossas/fossa-cli/pull/1457))
 
 ## 3.9.30

integration-test/Analysis/Python/PoetrySpec.hs

@@ -24,4 +24,4 @@ poetry =
 
 spec :: Spec
 spec = do
-  testSuiteDepResultSummary poetry PoetryProjectType (DependencyResultsSummary 66 29 69 1 Complete)
+  testSuiteDepResultSummary poetry PoetryProjectType (DependencyResultsSummary 65 29 69 1 Complete)

spectrometer.cabal

@@ -152,7 +152,7 @@ common deps
     , th-lift-instances            ^>=0.1.17
     , time                         >=1.9       && <1.13
     , tls                          ^>=2.0
-    , tomland                      ^>=1.3.3.0
+    , toml-parser                  ^>=2.0.1.0
     , transformers
     , typed-process                ^>=0.2.6
     , unix-compat                  ^>=0.7

src/Effect/ReadFS.hs

@@ -122,6 +122,7 @@ import System.PosixCompat.Types (CDev (..), CIno (..))
 import Text.Megaparsec (Parsec, runParser)
 import Text.Megaparsec.Error (errorBundlePretty)
 import Toml qualified
+import Toml.Schema qualified
 
 -- | A unique file identifier for a directory.
 -- Uniqueness is guaranteed within a single OS.
@@ -365,12 +366,12 @@ readContentsJson file = context ("Parsing JSON file '" <> toText (toString file)
     Left err -> errSupport (fileParseErrorSupportMsg file) $ fatal $ FileParseError (toString file) (toText err)
     Right a -> pure a
 
-readContentsToml :: (Has ReadFS sig m, Has Diagnostics sig m) => Toml.TomlCodec a -> Path Abs File -> m a
-readContentsToml codec file = context ("Parsing TOML file '" <> toText (toString file) <> "'") $ do
+readContentsToml :: (Toml.Schema.FromValue a, Has ReadFS sig m, Has Diagnostics sig m) => Path Abs File -> m a
+readContentsToml file = context ("Parsing TOML file '" <> toText (toString file) <> "'") $ do
   contents <- readContentsText file
-  case Toml.decode codec contents of
-    Left err -> errSupport (fileParseErrorSupportMsg file) $ fatal $ FileParseError (toString file) (Toml.prettyTomlDecodeErrors err)
-    Right a -> pure a
+  case Toml.decode contents of
+    Toml.Failure err -> errSupport (fileParseErrorSupportMsg file) $ fatal $ FileParseError (toString file) (toText $ show err)
+    Toml.Success _ a -> pure a
 
 -- | Read YAML from a file
 readContentsYaml :: (FromJSON a, Has ReadFS sig m, Has Diagnostics sig m) => Path Abs File -> m a

src/Strategy/Cargo.hs

@@ -88,8 +88,7 @@ import Text.Megaparsec (
   try,
  )
 import Text.Megaparsec.Char (char, digitChar, space)
-import Toml (TomlCodec, dioptional, diwrap, (.=))
-import Toml qualified
+import Toml.Schema qualified
 import Types (
   DepEnvironment (EnvDevelopment, EnvProduction),
   DepType (CargoType),
@@ -244,11 +243,12 @@ data CargoPackage = CargoPackage
   }
   deriving (Eq, Show)
 
-cargoPackageCodec :: TomlCodec CargoPackage
-cargoPackageCodec =
-  CargoPackage
-    <$> dioptional (Toml.text "license") .= license
-    <*> dioptional (Toml.string "license-file") .= cargoLicenseFile
+instance Toml.Schema.FromValue CargoPackage where
+  fromValue =
+    Toml.Schema.parseTableFromValue $
+      CargoPackage
+        <$> Toml.Schema.optKey "license"
+        <*> Toml.Schema.optKey "license-file"
 
 -- | Representation of a Cargo.toml file. See
 --  [here](https://doc.rust-lang.org/cargo/reference/manifest.html)
@@ -257,12 +257,11 @@ newtype CargoToml = CargoToml
   {cargoPackage :: CargoPackage}
   deriving (Eq, Show)
 
-cargoTomlCodec :: TomlCodec CargoToml
-cargoTomlCodec = diwrap (Toml.table cargoPackageCodec "package")
--- ^ ^ The above is a bit obscure. It's generating a TomlCodec CargoPackage and
---  then using 'diwrap'/Coercible to make a TomlCodec CargoToml.  I can't use
---  'CargoToml <$>' because TomlCodec aliases (Codec a a) and only (Codec a)
---  has a Functor instance, so I'd end up with a (Codec CargoPackage CargoToml).
+instance Toml.Schema.FromValue CargoToml where
+  fromValue =
+    Toml.Schema.parseTableFromValue $
+      CargoToml
+        <$> Toml.Schema.reqKey "package"
 
 instance LicenseAnalyzeProject CargoProject where
   licenseAnalyzeProject = analyzeLicenses . cargoToml
@@ -271,7 +270,7 @@ instance LicenseAnalyzeProject CargoProject where
 --  (here)[https://doc.rust-lang.org/cargo/reference/manifest.html#the-license-and-license-file-fields]
 analyzeLicenses :: (Has ReadFS sig m, Has Diagnostics sig m) => Path Abs File -> m [LicenseResult]
 analyzeLicenses tomlPath = do
-  pkg <- cargoPackage <$> readContentsToml cargoTomlCodec tomlPath
+  pkg <- cargoPackage <$> readContentsToml tomlPath
   licensePathText <- maybe (pure Nothing) mkLicensePath (cargoLicenseFile pkg)
 
   -- The license-file field in Cargo.toml is relative to the dir of the

src/Strategy/Fortran/FpmToml.hs

@@ -6,11 +6,10 @@ module Strategy.Fortran.FpmToml (
   FpmDependency (..),
   FpmPathDependency (..),
   FpmGitDependency (..),
+  FpmTomlExecutables (..),
   buildGraph,
-  fpmTomlCodec,
 ) where
 
-import Control.Applicative (Alternative ((<|>)))
 import Control.Effect.Diagnostics (Diagnostics, context)
 import Data.Foldable (asum)
 import Data.Map (Map, elems)
@@ -25,35 +24,68 @@ import DepTypes (
 import Effect.ReadFS (Has, ReadFS, readContentsToml)
 import Graphing (Graphing, directs, induceJust)
 import Path
-import Toml (TomlCodec, (.=))
 import Toml qualified
+import Toml.Schema qualified
 
 -- | Represents the content of the fpm manifest.
--- Reference: https://github.com/fortran-lang/fpm/blob/main/manifest-reference.md
+-- Reference: https://fpm.fortran-lang.org/spec/manifest.html
 data FpmToml = FpmToml
   { fpmDependencies :: Map Text FpmDependency
   , fpmDevDependencies :: Map Text FpmDependency
-  , fpmExecutables :: [Map Text FpmDependency]
+  , fpmExecutables :: [FpmTomlExecutables]
   }
   deriving (Eq, Ord, Show)
 
-fpmTomlCodec :: TomlCodec FpmToml
-fpmTomlCodec =
-  FpmToml
-    <$> Toml.tableMap Toml._KeyText fpmDependenciesCodec "dependencies" .= fpmDependencies
-    <*> Toml.tableMap Toml._KeyText fpmDependenciesCodec "dev-dependencies" .= fpmDevDependencies
-    <*> Toml.list fpmExecutableDependenciesCodec "executable" .= fpmExecutables
+instance Toml.Schema.FromValue FpmToml where
+  fromValue =
+    Toml.Schema.parseTableFromValue $
+      FpmToml
+        <$> Toml.Schema.pickKey [Toml.Schema.Key "dependencies" Toml.Schema.fromValue, Toml.Schema.Else $ pure mempty]
+        <*> Toml.Schema.pickKey [Toml.Schema.Key "dev-dependencies" Toml.Schema.fromValue, Toml.Schema.Else $ pure mempty]
+        <*> Toml.Schema.pickKey [Toml.Schema.Key "executable" Toml.Schema.fromValue, Toml.Schema.Else $ pure []]
+
+newtype FpmTomlExecutables = FpmTomlExecutables
+  { fpmExecutableDependencies :: Map Text FpmDependency
+  }
+  deriving (Eq, Ord, Show)
+
+instance Toml.Schema.FromValue FpmTomlExecutables where
+  fromValue =
+    Toml.Schema.parseTableFromValue $
+      FpmTomlExecutables
+        <$> Toml.Schema.pickKey [Toml.Schema.Key "dependencies" Toml.Schema.fromValue, Toml.Schema.Else $ pure mempty]
 
 data FpmDependency
   = FpmGitDep FpmGitDependency
   | FpmPathDep FpmPathDependency
+  | FpmMetaDep Text
+  deriving (Eq, Ord, Show)
+
+instance Toml.Schema.FromValue FpmDependency where
+  fromValue v@(Toml.Schema.Table' l t) =
+    Toml.Schema.parseTable
+      ( Toml.Schema.pickKey
+          [ Toml.Schema.Key "git" (const (FpmGitDep <$> Toml.Schema.fromValue v))
+          , Toml.Schema.Key "path" (const (FpmPathDep <$> Toml.Schema.fromValue v))
+          , Toml.Schema.Else (Toml.Schema.failAt (Toml.valueAnn v) "Expected either 'git' or 'path' key got: ")
+          ]
+      )
+      l
+      t
+  fromValue (Toml.Schema.Text' _ t) = pure $ FpmMetaDep t
+  fromValue v = Toml.Schema.failAt (Toml.valueAnn v) "Invalid dependency value, expected a table or a string"
+
+newtype FpmMetaDependency = FpmMetaDependency Text
   deriving (Eq, Ord, Show)
 
 newtype FpmPathDependency = FpmPathDependency
   { pathOf :: Text
   }
   deriving (Eq, Ord, Show)
 
+instance Toml.Schema.FromValue FpmPathDependency where
+  fromValue = Toml.Schema.parseTableFromValue $ FpmPathDependency <$> Toml.Schema.reqKey "path"
+
 data FpmGitDependency = FpmGitDependency
   { url :: Text
   , branch :: Maybe Text
@@ -62,32 +94,14 @@ data FpmGitDependency = FpmGitDependency
   }
   deriving (Eq, Ord, Show)
 
-fpmExecutableDependenciesCodec :: TomlCodec (Map Text FpmDependency)
-fpmExecutableDependenciesCodec = Toml.tableMap Toml._KeyText fpmDependenciesCodec "dependencies"
-
-fpmDependenciesCodec :: Toml.Key -> TomlCodec FpmDependency
-fpmDependenciesCodec key =
-  Toml.dimatch matchFpmPathDep FpmPathDep (Toml.table fpmPathDependencyCodec key)
-    <|> Toml.dimatch matchFpmGitDep FpmGitDep (Toml.table fpmGitDependencyCodec key)
-  where
-    matchFpmPathDep :: FpmDependency -> Maybe FpmPathDependency
-    matchFpmPathDep (FpmPathDep pathDep) = Just pathDep
-    matchFpmPathDep _ = Nothing
-
-    matchFpmGitDep :: FpmDependency -> Maybe FpmGitDependency
-    matchFpmGitDep (FpmGitDep gitDep) = Just gitDep
-    matchFpmGitDep _ = Nothing
-
-    fpmPathDependencyCodec :: TomlCodec FpmPathDependency
-    fpmPathDependencyCodec = FpmPathDependency <$> Toml.text "path" .= pathOf
-
-    fpmGitDependencyCodec :: TomlCodec FpmGitDependency
-    fpmGitDependencyCodec =
+instance Toml.Schema.FromValue FpmGitDependency where
+  fromValue =
+    Toml.Schema.parseTableFromValue $
       FpmGitDependency
-        <$> Toml.text "git" .= url
-        <*> Toml.dioptional (Toml.text "branch") .= branch
-        <*> Toml.dioptional (Toml.text "tag") .= tag
-        <*> Toml.dioptional (Toml.text "rev") .= rev
+        <$> Toml.Schema.reqKey "git"
+        <*> Toml.Schema.optKey "branch"
+        <*> Toml.Schema.optKey "tag"
+        <*> Toml.Schema.optKey "rev"
 
 buildGraph :: FpmToml -> Graphing Dependency
 buildGraph fpmToml = induceJust $ foldMap directs [deps, execDeps, devDeps]
@@ -96,7 +110,7 @@ buildGraph fpmToml = induceJust $ foldMap directs [deps, execDeps, devDeps]
     deps = map toProdDependency (elems $ fpmDependencies fpmToml)
 
     execDeps :: [Maybe Dependency]
-    execDeps = map toProdDependency (foldMap elems $ fpmExecutables fpmToml)
+    execDeps = map toProdDependency (foldMap (elems . fpmExecutableDependencies) (fpmExecutables fpmToml))
 
     devDeps :: [Maybe Dependency]
     devDeps = map toDevDependency (elems $ fpmDevDependencies fpmToml)
@@ -109,6 +123,7 @@ buildGraph fpmToml = induceJust $ foldMap directs [deps, execDeps, devDeps]
 
     toDependency :: Maybe DepEnvironment -> FpmDependency -> Maybe Dependency
     toDependency _ (FpmPathDep _) = Nothing
+    toDependency _ (FpmMetaDep _) = Nothing
     toDependency env (FpmGitDep dep) =
       Just $
         Dependency
@@ -128,5 +143,5 @@ analyzeFpmToml ::
   Path Abs File ->
   m (Graphing Dependency)
 analyzeFpmToml tomlFile = do
-  fpmTomlContent <- readContentsToml fpmTomlCodec tomlFile
+  fpmTomlContent <- readContentsToml tomlFile
   context "Building dependency graph from fpm.toml" $ pure $ buildGraph fpmTomlContent

src/Strategy/Go/GopkgLock.hs

@@ -5,7 +5,6 @@ module Strategy.Go.GopkgLock (
   GoLock (..),
   Project (..),
   buildGraph,
-  golockCodec,
 ) where
 
 import Control.Effect.Diagnostics
@@ -24,33 +23,34 @@ import Graphing (Graphing)
 import Path
 import Strategy.Go.Transitive (fillInTransitive)
 import Strategy.Go.Types
-import Toml (TomlCodec, (.=))
-import Toml qualified
-
-golockCodec :: TomlCodec GoLock
-golockCodec =
-  GoLock
-    <$> Toml.list projectCodec "projects" .= lockProjects
-
-projectCodec :: TomlCodec Project
-projectCodec =
-  Project
-    <$> Toml.text "name" .= projectName
-    <*> Toml.dioptional (Toml.text "source") .= projectSource
-    <*> Toml.text "revision" .= projectRevision
+import Toml.Schema qualified
 
 newtype GoLock = GoLock
   { lockProjects :: [Project]
   }
   deriving (Eq, Ord, Show)
 
+instance Toml.Schema.FromValue GoLock where
+  fromValue =
+    Toml.Schema.parseTableFromValue $
+      GoLock
+        <$> Toml.Schema.reqKey "projects"
+
 data Project = Project
   { projectName :: Text
   , projectSource :: Maybe Text
   , projectRevision :: Text
   }
   deriving (Eq, Ord, Show)
 
+instance Toml.Schema.FromValue Project where
+  fromValue =
+    Toml.Schema.parseTableFromValue $
+      Project
+        <$> Toml.Schema.reqKey "name"
+        <*> Toml.Schema.optKey "source"
+        <*> Toml.Schema.reqKey "revision"
+
 analyze' ::
   ( Has ReadFS sig m
   , Has Exec sig m
@@ -59,7 +59,7 @@ analyze' ::
   Path Abs File ->
   m (Graphing Dependency)
 analyze' file = graphingGolang $ do
-  golock <- readContentsToml golockCodec file
+  golock <- readContentsToml file
   context "Building dependency graph" $ buildGraph (lockProjects golock)
   void
     . recover

src/Strategy/Go/GopkgToml.hs

@@ -5,7 +5,6 @@ module Strategy.Go.GopkgToml (
   PkgConstraint (..),
   analyze',
   buildGraph,
-  gopkgCodec,
 ) where
 
 import Control.Applicative ((<|>))
@@ -27,30 +26,21 @@ import Graphing (Graphing)
 import Path
 import Strategy.Go.Transitive (fillInTransitive)
 import Strategy.Go.Types
-import Toml (TomlCodec, (.=))
-import Toml qualified
-
-gopkgCodec :: TomlCodec Gopkg
-gopkgCodec =
-  Gopkg
-    <$> Toml.list constraintCodec "constraint" .= pkgConstraints
-    <*> Toml.list constraintCodec "override" .= pkgOverrides
-
-constraintCodec :: TomlCodec PkgConstraint
-constraintCodec =
-  PkgConstraint
-    <$> Toml.text "name" .= constraintName
-    <*> Toml.dioptional (Toml.text "source") .= constraintSource
-    <*> Toml.dioptional (Toml.text "version") .= constraintVersion
-    <*> Toml.dioptional (Toml.text "branch") .= constraintBranch
-    <*> Toml.dioptional (Toml.text "revision") .= constraintRevision
+import Toml.Schema qualified
 
 data Gopkg = Gopkg
   { pkgConstraints :: [PkgConstraint]
   , pkgOverrides :: [PkgConstraint]
   }
   deriving (Eq, Ord, Show)
 
+instance Toml.Schema.FromValue Gopkg where
+  fromValue =
+    Toml.Schema.parseTableFromValue $
+      Gopkg
+        <$> Toml.Schema.reqKey "constraint"
+        <*> Toml.Schema.reqKey "override"
+
 data PkgConstraint = PkgConstraint
   { constraintName :: Text
   , constraintSource :: Maybe Text
@@ -60,6 +50,16 @@ data PkgConstraint = PkgConstraint
   }
   deriving (Eq, Ord, Show)
 
+instance Toml.Schema.FromValue PkgConstraint where
+  fromValue =
+    Toml.Schema.parseTableFromValue $
+      PkgConstraint
+        <$> Toml.Schema.reqKey "name"
+        <*> Toml.Schema.optKey "source"
+        <*> Toml.Schema.optKey "version"
+        <*> Toml.Schema.optKey "branch"
+        <*> Toml.Schema.optKey "revision"
+
 analyze' ::
   ( Has ReadFS sig m
   , Has Exec sig m
@@ -68,7 +68,7 @@ analyze' ::
   Path Abs File ->
   m (Graphing Dependency)
 analyze' file = graphingGolang $ do
-  gopkg <- readContentsToml gopkgCodec file
+  gopkg <- readContentsToml file
   context "Building dependency graph" $ buildGraph gopkg
   void
     . recover