Skip to content

Commit cfbcd5b

Browse files
jagonalezjagonalez
authored
[ANE-1827] - Replace "tomland" with "toml-parser" for parsing toml files (#1459)
* use toml-parser * remove unused import * polish * lint * field is optional * update test case * update version * update changelog * handle fpm metadeps * update error
1 parent 855b7cd commit cfbcd5b

24 files changed

+614
-437
lines changed

‎Changelog.md

+1
Original file line numberDiff line numberDiff line change
@@ -2,6 +2,7 @@
22

33
## Unreleased
44

5+
- Resolve an issue parsing toml configuration files. ([#1459](https://github.com/fossas/fossa-cli/pull/1459))
56
- Gradle: ignore deprecated configurations ([#1457](https://github.com/fossas/fossa-cli/pull/1457))
67

78
## 3.9.30

‎integration-test/Analysis/Python/PoetrySpec.hs

+1-1
Original file line numberDiff line numberDiff line change
@@ -24,4 +24,4 @@ poetry =
2424

2525
spec :: Spec
2626
spec = do
27-
testSuiteDepResultSummary poetry PoetryProjectType (DependencyResultsSummary 66 29 69 1 Complete)
27+
testSuiteDepResultSummary poetry PoetryProjectType (DependencyResultsSummary 65 29 69 1 Complete)

‎spectrometer.cabal

+1-1
Original file line numberDiff line numberDiff line change
@@ -152,7 +152,7 @@ common deps
152152
, th-lift-instances ^>=0.1.17
153153
, time >=1.9 && <1.13
154154
, tls ^>=2.0
155-
, tomland ^>=1.3.3.0
155+
, toml-parser ^>=2.0.1.0
156156
, transformers
157157
, typed-process ^>=0.2.6
158158
, unix-compat ^>=0.7

‎src/Effect/ReadFS.hs

+6-5
Original file line numberDiff line numberDiff line change
@@ -122,6 +122,7 @@ import System.PosixCompat.Types (CDev (..), CIno (..))
122122
import Text.Megaparsec (Parsec, runParser)
123123
import Text.Megaparsec.Error (errorBundlePretty)
124124
import Toml qualified
125+
import Toml.Schema qualified
125126

126127
-- | A unique file identifier for a directory.
127128
-- Uniqueness is guaranteed within a single OS.
@@ -365,12 +366,12 @@ readContentsJson file = context ("Parsing JSON file '" <> toText (toString file)
365366
Left err -> errSupport (fileParseErrorSupportMsg file) $ fatal $ FileParseError (toString file) (toText err)
366367
Right a -> pure a
367368

368-
readContentsToml :: (Has ReadFS sig m, Has Diagnostics sig m) => Toml.TomlCodec a -> Path Abs File -> m a
369-
readContentsToml codec file = context ("Parsing TOML file '" <> toText (toString file) <> "'") $ do
369+
readContentsToml :: (Toml.Schema.FromValue a, Has ReadFS sig m, Has Diagnostics sig m) => Path Abs File -> m a
370+
readContentsToml file = context ("Parsing TOML file '" <> toText (toString file) <> "'") $ do
370371
contents <- readContentsText file
371-
case Toml.decode codec contents of
372-
Left err -> errSupport (fileParseErrorSupportMsg file) $ fatal $ FileParseError (toString file) (Toml.prettyTomlDecodeErrors err)
373-
Right a -> pure a
372+
case Toml.decode contents of
373+
Toml.Failure err -> errSupport (fileParseErrorSupportMsg file) $ fatal $ FileParseError (toString file) (toText $ show err)
374+
Toml.Success _ a -> pure a
374375

375376
-- | Read YAML from a file
376377
readContentsYaml :: (FromJSON a, Has ReadFS sig m, Has Diagnostics sig m) => Path Abs File -> m a

‎src/Strategy/Cargo.hs

+13-14
Original file line numberDiff line numberDiff line change
@@ -88,8 +88,7 @@ import Text.Megaparsec (
8888
try,
8989
)
9090
import Text.Megaparsec.Char (char, digitChar, space)
91-
import Toml (TomlCodec, dioptional, diwrap, (.=))
92-
import Toml qualified
91+
import Toml.Schema qualified
9392
import Types (
9493
DepEnvironment (EnvDevelopment, EnvProduction),
9594
DepType (CargoType),
@@ -244,11 +243,12 @@ data CargoPackage = CargoPackage
244243
}
245244
deriving (Eq, Show)
246245

247-
cargoPackageCodec :: TomlCodec CargoPackage
248-
cargoPackageCodec =
249-
CargoPackage
250-
<$> dioptional (Toml.text "license") .= license
251-
<*> dioptional (Toml.string "license-file") .= cargoLicenseFile
246+
instance Toml.Schema.FromValue CargoPackage where
247+
fromValue =
248+
Toml.Schema.parseTableFromValue $
249+
CargoPackage
250+
<$> Toml.Schema.optKey "license"
251+
<*> Toml.Schema.optKey "license-file"
252252

253253
-- | Representation of a Cargo.toml file. See
254254
-- [here](https://doc.rust-lang.org/cargo/reference/manifest.html)
@@ -257,12 +257,11 @@ newtype CargoToml = CargoToml
257257
{cargoPackage :: CargoPackage}
258258
deriving (Eq, Show)
259259

260-
cargoTomlCodec :: TomlCodec CargoToml
261-
cargoTomlCodec = diwrap (Toml.table cargoPackageCodec "package")
262-
-- ^ ^ The above is a bit obscure. It's generating a TomlCodec CargoPackage and
263-
-- then using 'diwrap'/Coercible to make a TomlCodec CargoToml. I can't use
264-
-- 'CargoToml <$>' because TomlCodec aliases (Codec a a) and only (Codec a)
265-
-- has a Functor instance, so I'd end up with a (Codec CargoPackage CargoToml).
260+
instance Toml.Schema.FromValue CargoToml where
261+
fromValue =
262+
Toml.Schema.parseTableFromValue $
263+
CargoToml
264+
<$> Toml.Schema.reqKey "package"
266265

267266
instance LicenseAnalyzeProject CargoProject where
268267
licenseAnalyzeProject = analyzeLicenses . cargoToml
@@ -271,7 +270,7 @@ instance LicenseAnalyzeProject CargoProject where
271270
-- (here)[https://doc.rust-lang.org/cargo/reference/manifest.html#the-license-and-license-file-fields]
272271
analyzeLicenses :: (Has ReadFS sig m, Has Diagnostics sig m) => Path Abs File -> m [LicenseResult]
273272
analyzeLicenses tomlPath = do
274-
pkg <- cargoPackage <$> readContentsToml cargoTomlCodec tomlPath
273+
pkg <- cargoPackage <$> readContentsToml tomlPath
275274
licensePathText <- maybe (pure Nothing) mkLicensePath (cargoLicenseFile pkg)
276275

277276
-- The license-file field in Cargo.toml is relative to the dir of the

‎src/Strategy/Fortran/FpmToml.hs

+53-38
Original file line numberDiff line numberDiff line change
@@ -6,11 +6,10 @@ module Strategy.Fortran.FpmToml (
66
FpmDependency (..),
77
FpmPathDependency (..),
88
FpmGitDependency (..),
9+
FpmTomlExecutables (..),
910
buildGraph,
10-
fpmTomlCodec,
1111
) where
1212

13-
import Control.Applicative (Alternative ((<|>)))
1413
import Control.Effect.Diagnostics (Diagnostics, context)
1514
import Data.Foldable (asum)
1615
import Data.Map (Map, elems)
@@ -25,35 +24,68 @@ import DepTypes (
2524
import Effect.ReadFS (Has, ReadFS, readContentsToml)
2625
import Graphing (Graphing, directs, induceJust)
2726
import Path
28-
import Toml (TomlCodec, (.=))
2927
import Toml qualified
28+
import Toml.Schema qualified
3029

3130
-- | Represents the content of the fpm manifest.
32-
-- Reference: https://github.com/fortran-lang/fpm/blob/main/manifest-reference.md
31+
-- Reference: https://fpm.fortran-lang.org/spec/manifest.html
3332
data FpmToml = FpmToml
3433
{ fpmDependencies :: Map Text FpmDependency
3534
, fpmDevDependencies :: Map Text FpmDependency
36-
, fpmExecutables :: [Map Text FpmDependency]
35+
, fpmExecutables :: [FpmTomlExecutables]
3736
}
3837
deriving (Eq, Ord, Show)
3938

40-
fpmTomlCodec :: TomlCodec FpmToml
41-
fpmTomlCodec =
42-
FpmToml
43-
<$> Toml.tableMap Toml._KeyText fpmDependenciesCodec "dependencies" .= fpmDependencies
44-
<*> Toml.tableMap Toml._KeyText fpmDependenciesCodec "dev-dependencies" .= fpmDevDependencies
45-
<*> Toml.list fpmExecutableDependenciesCodec "executable" .= fpmExecutables
39+
instance Toml.Schema.FromValue FpmToml where
40+
fromValue =
41+
Toml.Schema.parseTableFromValue $
42+
FpmToml
43+
<$> Toml.Schema.pickKey [Toml.Schema.Key "dependencies" Toml.Schema.fromValue, Toml.Schema.Else $ pure mempty]
44+
<*> Toml.Schema.pickKey [Toml.Schema.Key "dev-dependencies" Toml.Schema.fromValue, Toml.Schema.Else $ pure mempty]
45+
<*> Toml.Schema.pickKey [Toml.Schema.Key "executable" Toml.Schema.fromValue, Toml.Schema.Else $ pure []]
46+
47+
newtype FpmTomlExecutables = FpmTomlExecutables
48+
{ fpmExecutableDependencies :: Map Text FpmDependency
49+
}
50+
deriving (Eq, Ord, Show)
51+
52+
instance Toml.Schema.FromValue FpmTomlExecutables where
53+
fromValue =
54+
Toml.Schema.parseTableFromValue $
55+
FpmTomlExecutables
56+
<$> Toml.Schema.pickKey [Toml.Schema.Key "dependencies" Toml.Schema.fromValue, Toml.Schema.Else $ pure mempty]
4657

4758
data FpmDependency
4859
= FpmGitDep FpmGitDependency
4960
| FpmPathDep FpmPathDependency
61+
| FpmMetaDep Text
62+
deriving (Eq, Ord, Show)
63+
64+
instance Toml.Schema.FromValue FpmDependency where
65+
fromValue v@(Toml.Schema.Table' l t) =
66+
Toml.Schema.parseTable
67+
( Toml.Schema.pickKey
68+
[ Toml.Schema.Key "git" (const (FpmGitDep <$> Toml.Schema.fromValue v))
69+
, Toml.Schema.Key "path" (const (FpmPathDep <$> Toml.Schema.fromValue v))
70+
, Toml.Schema.Else (Toml.Schema.failAt (Toml.valueAnn v) "Expected either 'git' or 'path' key got: ")
71+
]
72+
)
73+
l
74+
t
75+
fromValue (Toml.Schema.Text' _ t) = pure $ FpmMetaDep t
76+
fromValue v = Toml.Schema.failAt (Toml.valueAnn v) "Invalid dependency value, expected a table or a string"
77+
78+
newtype FpmMetaDependency = FpmMetaDependency Text
5079
deriving (Eq, Ord, Show)
5180

5281
newtype FpmPathDependency = FpmPathDependency
5382
{ pathOf :: Text
5483
}
5584
deriving (Eq, Ord, Show)
5685

86+
instance Toml.Schema.FromValue FpmPathDependency where
87+
fromValue = Toml.Schema.parseTableFromValue $ FpmPathDependency <$> Toml.Schema.reqKey "path"
88+
5789
data FpmGitDependency = FpmGitDependency
5890
{ url :: Text
5991
, branch :: Maybe Text
@@ -62,32 +94,14 @@ data FpmGitDependency = FpmGitDependency
6294
}
6395
deriving (Eq, Ord, Show)
6496

65-
fpmExecutableDependenciesCodec :: TomlCodec (Map Text FpmDependency)
66-
fpmExecutableDependenciesCodec = Toml.tableMap Toml._KeyText fpmDependenciesCodec "dependencies"
67-
68-
fpmDependenciesCodec :: Toml.Key -> TomlCodec FpmDependency
69-
fpmDependenciesCodec key =
70-
Toml.dimatch matchFpmPathDep FpmPathDep (Toml.table fpmPathDependencyCodec key)
71-
<|> Toml.dimatch matchFpmGitDep FpmGitDep (Toml.table fpmGitDependencyCodec key)
72-
where
73-
matchFpmPathDep :: FpmDependency -> Maybe FpmPathDependency
74-
matchFpmPathDep (FpmPathDep pathDep) = Just pathDep
75-
matchFpmPathDep _ = Nothing
76-
77-
matchFpmGitDep :: FpmDependency -> Maybe FpmGitDependency
78-
matchFpmGitDep (FpmGitDep gitDep) = Just gitDep
79-
matchFpmGitDep _ = Nothing
80-
81-
fpmPathDependencyCodec :: TomlCodec FpmPathDependency
82-
fpmPathDependencyCodec = FpmPathDependency <$> Toml.text "path" .= pathOf
83-
84-
fpmGitDependencyCodec :: TomlCodec FpmGitDependency
85-
fpmGitDependencyCodec =
97+
instance Toml.Schema.FromValue FpmGitDependency where
98+
fromValue =
99+
Toml.Schema.parseTableFromValue $
86100
FpmGitDependency
87-
<$> Toml.text "git" .= url
88-
<*> Toml.dioptional (Toml.text "branch") .= branch
89-
<*> Toml.dioptional (Toml.text "tag") .= tag
90-
<*> Toml.dioptional (Toml.text "rev") .= rev
101+
<$> Toml.Schema.reqKey "git"
102+
<*> Toml.Schema.optKey "branch"
103+
<*> Toml.Schema.optKey "tag"
104+
<*> Toml.Schema.optKey "rev"
91105

92106
buildGraph :: FpmToml -> Graphing Dependency
93107
buildGraph fpmToml = induceJust $ foldMap directs [deps, execDeps, devDeps]
@@ -96,7 +110,7 @@ buildGraph fpmToml = induceJust $ foldMap directs [deps, execDeps, devDeps]
96110
deps = map toProdDependency (elems $ fpmDependencies fpmToml)
97111

98112
execDeps :: [Maybe Dependency]
99-
execDeps = map toProdDependency (foldMap elems $ fpmExecutables fpmToml)
113+
execDeps = map toProdDependency (foldMap (elems . fpmExecutableDependencies) (fpmExecutables fpmToml))
100114

101115
devDeps :: [Maybe Dependency]
102116
devDeps = map toDevDependency (elems $ fpmDevDependencies fpmToml)
@@ -109,6 +123,7 @@ buildGraph fpmToml = induceJust $ foldMap directs [deps, execDeps, devDeps]
109123

110124
toDependency :: Maybe DepEnvironment -> FpmDependency -> Maybe Dependency
111125
toDependency _ (FpmPathDep _) = Nothing
126+
toDependency _ (FpmMetaDep _) = Nothing
112127
toDependency env (FpmGitDep dep) =
113128
Just $
114129
Dependency
@@ -128,5 +143,5 @@ analyzeFpmToml ::
128143
Path Abs File ->
129144
m (Graphing Dependency)
130145
analyzeFpmToml tomlFile = do
131-
fpmTomlContent <- readContentsToml fpmTomlCodec tomlFile
146+
fpmTomlContent <- readContentsToml tomlFile
132147
context "Building dependency graph from fpm.toml" $ pure $ buildGraph fpmTomlContent

‎src/Strategy/Go/GopkgLock.hs

+16-16
Original file line numberDiff line numberDiff line change
@@ -5,7 +5,6 @@ module Strategy.Go.GopkgLock (
55
GoLock (..),
66
Project (..),
77
buildGraph,
8-
golockCodec,
98
) where
109

1110
import Control.Effect.Diagnostics
@@ -24,33 +23,34 @@ import Graphing (Graphing)
2423
import Path
2524
import Strategy.Go.Transitive (fillInTransitive)
2625
import Strategy.Go.Types
27-
import Toml (TomlCodec, (.=))
28-
import Toml qualified
29-
30-
golockCodec :: TomlCodec GoLock
31-
golockCodec =
32-
GoLock
33-
<$> Toml.list projectCodec "projects" .= lockProjects
34-
35-
projectCodec :: TomlCodec Project
36-
projectCodec =
37-
Project
38-
<$> Toml.text "name" .= projectName
39-
<*> Toml.dioptional (Toml.text "source") .= projectSource
40-
<*> Toml.text "revision" .= projectRevision
26+
import Toml.Schema qualified
4127

4228
newtype GoLock = GoLock
4329
{ lockProjects :: [Project]
4430
}
4531
deriving (Eq, Ord, Show)
4632

33+
instance Toml.Schema.FromValue GoLock where
34+
fromValue =
35+
Toml.Schema.parseTableFromValue $
36+
GoLock
37+
<$> Toml.Schema.reqKey "projects"
38+
4739
data Project = Project
4840
{ projectName :: Text
4941
, projectSource :: Maybe Text
5042
, projectRevision :: Text
5143
}
5244
deriving (Eq, Ord, Show)
5345

46+
instance Toml.Schema.FromValue Project where
47+
fromValue =
48+
Toml.Schema.parseTableFromValue $
49+
Project
50+
<$> Toml.Schema.reqKey "name"
51+
<*> Toml.Schema.optKey "source"
52+
<*> Toml.Schema.reqKey "revision"
53+
5454
analyze' ::
5555
( Has ReadFS sig m
5656
, Has Exec sig m
@@ -59,7 +59,7 @@ analyze' ::
5959
Path Abs File ->
6060
m (Graphing Dependency)
6161
analyze' file = graphingGolang $ do
62-
golock <- readContentsToml golockCodec file
62+
golock <- readContentsToml file
6363
context "Building dependency graph" $ buildGraph (lockProjects golock)
6464
void
6565
. recover

‎src/Strategy/Go/GopkgToml.hs

+19-19
Original file line numberDiff line numberDiff line change
@@ -5,7 +5,6 @@ module Strategy.Go.GopkgToml (
55
PkgConstraint (..),
66
analyze',
77
buildGraph,
8-
gopkgCodec,
98
) where
109

1110
import Control.Applicative ((<|>))
@@ -27,30 +26,21 @@ import Graphing (Graphing)
2726
import Path
2827
import Strategy.Go.Transitive (fillInTransitive)
2928
import Strategy.Go.Types
30-
import Toml (TomlCodec, (.=))
31-
import Toml qualified
32-
33-
gopkgCodec :: TomlCodec Gopkg
34-
gopkgCodec =
35-
Gopkg
36-
<$> Toml.list constraintCodec "constraint" .= pkgConstraints
37-
<*> Toml.list constraintCodec "override" .= pkgOverrides
38-
39-
constraintCodec :: TomlCodec PkgConstraint
40-
constraintCodec =
41-
PkgConstraint
42-
<$> Toml.text "name" .= constraintName
43-
<*> Toml.dioptional (Toml.text "source") .= constraintSource
44-
<*> Toml.dioptional (Toml.text "version") .= constraintVersion
45-
<*> Toml.dioptional (Toml.text "branch") .= constraintBranch
46-
<*> Toml.dioptional (Toml.text "revision") .= constraintRevision
29+
import Toml.Schema qualified
4730

4831
data Gopkg = Gopkg
4932
{ pkgConstraints :: [PkgConstraint]
5033
, pkgOverrides :: [PkgConstraint]
5134
}
5235
deriving (Eq, Ord, Show)
5336

37+
instance Toml.Schema.FromValue Gopkg where
38+
fromValue =
39+
Toml.Schema.parseTableFromValue $
40+
Gopkg
41+
<$> Toml.Schema.reqKey "constraint"
42+
<*> Toml.Schema.reqKey "override"
43+
5444
data PkgConstraint = PkgConstraint
5545
{ constraintName :: Text
5646
, constraintSource :: Maybe Text
@@ -60,6 +50,16 @@ data PkgConstraint = PkgConstraint
6050
}
6151
deriving (Eq, Ord, Show)
6252

53+
instance Toml.Schema.FromValue PkgConstraint where
54+
fromValue =
55+
Toml.Schema.parseTableFromValue $
56+
PkgConstraint
57+
<$> Toml.Schema.reqKey "name"
58+
<*> Toml.Schema.optKey "source"
59+
<*> Toml.Schema.optKey "version"
60+
<*> Toml.Schema.optKey "branch"
61+
<*> Toml.Schema.optKey "revision"
62+
6363
analyze' ::
6464
( Has ReadFS sig m
6565
, Has Exec sig m
@@ -68,7 +68,7 @@ analyze' ::
6868
Path Abs File ->
6969
m (Graphing Dependency)
7070
analyze' file = graphingGolang $ do
71-
gopkg <- readContentsToml gopkgCodec file
71+
gopkg <- readContentsToml file
7272
context "Building dependency graph" $ buildGraph gopkg
7373
void
7474
. recover

0 commit comments

Comments
 (0)