Skip to content

WIP/RFC: Parse .cabal files to a source code representation #6621

New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Draft
wants to merge 5 commits into
base: master
Choose a base branch
from
Draft

WIP/RFC: Parse .cabal files to a source code representation #6621

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
5 commits
Select commit Hold shift + click to select a range
7b459cb
Initial check-in of PackageSourceDescription.
m-renaud Mar 28, 2020
58b748b
Checkpoint: common stanzas definitions maintained.
m-renaud Mar 29, 2020
f968f9a
Checkpoint: Maintain common stanza imports within sections.
m-renaud Mar 29, 2020
cc40b4c
Simplify parser.
m-renaud Mar 29, 2020
3b4e80c
Clean up code, update cabal format command.
m-renaud Mar 29, 2020
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
8 changes: 8 additions & 0 deletions Cabal/Cabal.cabal
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -447,6 +447,8 @@ library
Distribution.Types.MungedPackageId
Distribution.Types.PackageId
Distribution.Types.UnitId
Distribution.Types.CommonStanza
Distribution.Types.CommonStanzaImports
Distribution.Types.Executable
Distribution.Types.ExecutableScope
Distribution.Types.Library
Expand Down Expand Up @@ -474,6 +476,7 @@ library
Distribution.Types.TestSuiteInterface
Distribution.Types.TestType
Distribution.Types.GenericPackageDescription
Distribution.Types.PackageSourceDescription
Distribution.Types.Condition
Distribution.Types.CondTree
Distribution.Types.HookedBuildInfo
Expand Down Expand Up @@ -520,6 +523,8 @@ library
Distribution.FieldGrammar.Parsec
Distribution.FieldGrammar.Pretty
Distribution.PackageDescription.FieldGrammar
Distribution.PackageDescription.PackageSourceDescriptionParser
Distribution.PackageDescription.PackageSourceDescriptionPrettyPrint
Distribution.PackageDescription.Parsec
Distribution.PackageDescription.Quirks
Distribution.Parsec
Expand All @@ -543,9 +548,12 @@ library
Distribution.Types.Lens
Distribution.Types.Benchmark.Lens
Distribution.Types.BuildInfo.Lens
Distribution.Types.CommonStanza.Lens
Distribution.Types.CommonStanzaImports.Lens
Distribution.Types.Executable.Lens
Distribution.Types.ForeignLib.Lens
Distribution.Types.GenericPackageDescription.Lens
Distribution.Types.PackageSourceDescription.Lens
Distribution.Types.InstalledPackageInfo.Lens
Distribution.Types.Library.Lens
Distribution.Types.PackageDescription.Lens
Expand Down
59 changes: 50 additions & 9 deletions Cabal/Distribution/PackageDescription/FieldGrammar.hs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -3,6 +3,8 @@
module Distribution.PackageDescription.FieldGrammar (
-- * Package description
packageDescriptionFieldGrammar,
-- * Common Stanza
commonStanzaFieldGrammar,
-- * Library
libraryFieldGrammar,
-- * Foreign library
Expand Down Expand Up @@ -53,6 +55,8 @@ import Distribution.Parsec
import Distribution.Parsec.Newtypes
import Distribution.Fields
import Distribution.Pretty (prettyShow)
import Distribution.Types.CommonStanza
import Distribution.Types.CommonStanzaImports (CommonStanzaImports, emptyCommonStanzaImports)
import Distribution.Types.ExecutableScope
import Distribution.Types.ForeignLib
import Distribution.Types.ForeignLibType
Expand Down Expand Up @@ -117,6 +121,20 @@ packageDescriptionFieldGrammar = PackageDescription
<*> monoidalFieldAla "license-files" (alaList' FSep FilePathNT) L.licenseFiles
^^^ hiddenField

-------------------------------------------------------------------------------
-- Common Stanza
-------------------------------------------------------------------------------

commonStanzaFieldGrammar
:: (FieldGrammar g, Applicative (g CommonStanza), Applicative (g BuildInfo))
=> UnqualComponentName -> g CommonStanza CommonStanza
commonStanzaFieldGrammar n = CommonStanza n
<$> optionalFieldDef "import" L.commonStanzaRecursiveImports emptyCommonStanzaImports
<*> blurFieldGrammar L.buildInfo buildInfoFieldGrammar
{-# SPECIALIZE commonStanzaFieldGrammar :: UnqualComponentName -> ParsecFieldGrammar' CommonStanza #-}
{-# SPECIALIZE commonStanzaFieldGrammar :: UnqualComponentName -> PrettyFieldGrammar' CommonStanza #-}


-------------------------------------------------------------------------------
-- Library
-------------------------------------------------------------------------------
Expand All @@ -126,7 +144,8 @@ libraryFieldGrammar
=> LibraryName
-> g Library Library
libraryFieldGrammar n = Library n
<$> monoidalFieldAla "exposed-modules" (alaList' VCat MQuoted) L.exposedModules
<$> optionalFieldDef "import" L.libImports emptyCommonStanzaImports
<*> monoidalFieldAla "exposed-modules" (alaList' VCat MQuoted) L.exposedModules
<*> monoidalFieldAla "reexported-modules" (alaList CommaVCat) L.reexportedModules
<*> monoidalFieldAla "signatures" (alaList' VCat MQuoted) L.signatures
^^^ availableSince CabalSpecV2_0 []
Expand All @@ -153,7 +172,8 @@ foreignLibFieldGrammar
:: (FieldGrammar g, Applicative (g ForeignLib), Applicative (g BuildInfo))
=> UnqualComponentName -> g ForeignLib ForeignLib
foreignLibFieldGrammar n = ForeignLib n
<$> optionalFieldDef "type" L.foreignLibType ForeignLibTypeUnknown
<$> optionalFieldDef "import" L.foreignLibImports emptyCommonStanzaImports
<*> optionalFieldDef "type" L.foreignLibType ForeignLibTypeUnknown
<*> monoidalFieldAla "options" (alaList FSep) L.foreignLibOptions
<*> blurFieldGrammar L.foreignLibBuildInfo buildInfoFieldGrammar
<*> optionalField "lib-version-info" L.foreignLibVersionInfo
Expand All @@ -171,7 +191,8 @@ executableFieldGrammar
=> UnqualComponentName -> g Executable Executable
executableFieldGrammar n = Executable n
-- main-is is optional as conditional blocks don't have it
<$> optionalFieldDefAla "main-is" FilePathNT L.modulePath ""
<$> optionalFieldDef "import" L.exeImports emptyCommonStanzaImports
<*> optionalFieldDefAla "main-is" FilePathNT L.modulePath ""
<*> optionalFieldDef "scope" L.exeScope ExecutablePublic
^^^ availableSince CabalSpecV2_0 ExecutablePublic
<*> blurFieldGrammar L.buildInfo buildInfoFieldGrammar
Expand All @@ -185,15 +206,23 @@ executableFieldGrammar n = Executable n
-- | An intermediate type just used for parsing the test-suite stanza.
-- After validation it is converted into the proper 'TestSuite' type.
data TestSuiteStanza = TestSuiteStanza
{ _testStanzaTestType :: Maybe TestType
{ _testStanzaImports :: CommonStanzaImports
, _testStanzaTestType :: Maybe TestType
, _testStanzaMainIs :: Maybe FilePath
, _testStanzaTestModule :: Maybe ModuleName
, _testStanzaBuildInfo :: BuildInfo
}

instance L.HasCommonStanzaImports TestSuiteStanza where
commonStanzaImports = testStanzaImports

instance L.HasBuildInfo TestSuiteStanza where
buildInfo = testStanzaBuildInfo

testStanzaImports :: Lens' TestSuiteStanza CommonStanzaImports
testStanzaImports f s = fmap (\x -> s { _testStanzaImports = x }) (f (_testStanzaImports s))
{-# INLINE testStanzaImports #-}

testStanzaTestType :: Lens' TestSuiteStanza (Maybe TestType)
testStanzaTestType f s = fmap (\x -> s { _testStanzaTestType = x }) (f (_testStanzaTestType s))
{-# INLINE testStanzaTestType #-}
Expand All @@ -214,7 +243,8 @@ testSuiteFieldGrammar
:: (FieldGrammar g, Applicative (g TestSuiteStanza), Applicative (g BuildInfo))
=> g TestSuiteStanza TestSuiteStanza
testSuiteFieldGrammar = TestSuiteStanza
<$> optionalField "type" testStanzaTestType
<$> optionalFieldDef "import" testStanzaImports emptyCommonStanzaImports
<*> optionalField "type" testStanzaTestType
<*> optionalFieldAla "main-is" FilePathNT testStanzaMainIs
<*> optionalField "test-module" testStanzaTestModule
<*> blurFieldGrammar testStanzaBuildInfo buildInfoFieldGrammar
Expand Down Expand Up @@ -269,7 +299,8 @@ validateTestSuite pos stanza = case _testStanzaTestType stanza of

unvalidateTestSuite :: TestSuite -> TestSuiteStanza
unvalidateTestSuite t = TestSuiteStanza
{ _testStanzaTestType = ty
{ _testStanzaImports = view L.testImports t
, _testStanzaTestType = ty
, _testStanzaMainIs = ma
, _testStanzaTestModule = mo
, _testStanzaBuildInfo = testBuildInfo t
Expand All @@ -287,15 +318,23 @@ unvalidateTestSuite t = TestSuiteStanza
-- | An intermediate type just used for parsing the benchmark stanza.
-- After validation it is converted into the proper 'Benchmark' type.
data BenchmarkStanza = BenchmarkStanza
{ _benchmarkStanzaBenchmarkType :: Maybe BenchmarkType
{ _benchmarkStanzaImports :: CommonStanzaImports
, _benchmarkStanzaBenchmarkType :: Maybe BenchmarkType
, _benchmarkStanzaMainIs :: Maybe FilePath
, _benchmarkStanzaBenchmarkModule :: Maybe ModuleName
, _benchmarkStanzaBuildInfo :: BuildInfo
}

instance L.HasCommonStanzaImports BenchmarkStanza where
commonStanzaImports = benchmarkStanzaImports

instance L.HasBuildInfo BenchmarkStanza where
buildInfo = benchmarkStanzaBuildInfo

benchmarkStanzaImports :: Lens' BenchmarkStanza CommonStanzaImports
benchmarkStanzaImports f s = fmap (\x -> s { _benchmarkStanzaImports = x }) (f (_benchmarkStanzaImports s))
{-# INLINE benchmarkStanzaImports #-}

benchmarkStanzaBenchmarkType :: Lens' BenchmarkStanza (Maybe BenchmarkType)
benchmarkStanzaBenchmarkType f s = fmap (\x -> s { _benchmarkStanzaBenchmarkType = x }) (f (_benchmarkStanzaBenchmarkType s))
{-# INLINE benchmarkStanzaBenchmarkType #-}
Expand All @@ -316,7 +355,8 @@ benchmarkFieldGrammar
:: (FieldGrammar g, Applicative (g BenchmarkStanza), Applicative (g BuildInfo))
=> g BenchmarkStanza BenchmarkStanza
benchmarkFieldGrammar = BenchmarkStanza
<$> optionalField "type" benchmarkStanzaBenchmarkType
<$> optionalFieldDef "import" benchmarkStanzaImports emptyCommonStanzaImports
<*> optionalField "type" benchmarkStanzaBenchmarkType
<*> optionalFieldAla "main-is" FilePathNT benchmarkStanzaMainIs
<*> optionalField "benchmark-module" benchmarkStanzaBenchmarkModule
<*> blurFieldGrammar benchmarkStanzaBuildInfo buildInfoFieldGrammar
Expand Down Expand Up @@ -357,7 +397,8 @@ validateBenchmark pos stanza = case _benchmarkStanzaBenchmarkType stanza of

unvalidateBenchmark :: Benchmark -> BenchmarkStanza
unvalidateBenchmark b = BenchmarkStanza
{ _benchmarkStanzaBenchmarkType = ty
{ _benchmarkStanzaImports = view L.benchmarkImports b
, _benchmarkStanzaBenchmarkType = ty
, _benchmarkStanzaMainIs = ma
, _benchmarkStanzaBenchmarkModule = mo
, _benchmarkStanzaBuildInfo = benchmarkBuildInfo b
Expand Down
Loading