WIP2

Author: phadej

cabal-install-parsers/Changelog.md

@@ -1,3 +1,7 @@
+## 0.6.4
+
+- Add support for reading project files with conditionals.
+
 ## 0.6.3
 
 - Drop support for GHC prior 8.8.4

cabal-install-parsers/cabal-install-parsers.cabal

@@ -1,6 +1,6 @@
 cabal-version:      2.2
 name:               cabal-install-parsers
-version:            0.6.3
+version:            0.6.4
 synopsis:           Utilities to work with cabal-install files
 description:
   @cabal-install-parsers@ provides parsers for @cabal-install@ files:

cabal-install-parsers/src/Cabal/Project.hs

@@ -15,6 +15,8 @@ module Cabal.Project (
     -- * Parse project
     readProject,
     parseProject,
+    readProjectWithConditionals,
+    parseProjectWithConditionals,
     -- * Resolve project
     resolveProject,
     ResolveError (..),
@@ -179,6 +181,13 @@ readProject fp = do
     prj1 <- resolveProject fp prj0 >>= either throwIO return
     readPackagesOfProject prj1 >>= either throwIO return
 
+readProjectWithConditionals :: FilePath -> IO (C.CondTree C.ConfVar () (Project URI Void (FilePath, C.GenericPackageDescription)))
+readProjectWithConditionals fp = do
+    contents <- BS.readFile fp
+    prj0 <- either throwIO return (parseProjectWithConditionals fp contents)
+    prj1 <- traverse (\p -> resolveProject fp p >>= either throwIO return) prj0
+    traverse (\p -> readPackagesOfProject p >>= either throwIO return) prj1
+
 -- | Parse project file. Extracts only few fields.
 --
 -- >>> fmap prjPackages $ parseProject "cabal.project" "packages: foo bar/*.cabal"
@@ -207,6 +216,39 @@ parseProject = parseWith $ \fields0 -> do
 
     parseSec _ = return id
 
+-- | Parse project files with conditionals.
+--
+-- >>> fmap (fmap prjPackages) $ parseProjectWithConditionals "cabal.project" "packages: foo bar/*.cabal"
+-- Right (CondNode {condTreeData = ["foo","bar/*.cabal"], condTreeConstraints = (), condTreeComponents = []})
+--
+-- TODO:
+--
+-- >>> fmap (fmap prjPackages) $ parseProjectWithConditionals "cabal.project" "packages: foo bar/*.cabal\nif impl(ghc >=9)\n  packages: quu"
+-- Right (CondNode {condTreeData = ["foo","bar/*.cabal"], condTreeConstraints = (), condTreeComponents = []})
+--
+parseProjectWithConditionals :: FilePath -> ByteString -> Either (ParseError NonEmpty) (C.CondTree C.ConfVar () (Project Void String String))
+parseProjectWithConditionals = parseWith $ \fields0 -> do
+    let (fields1, sections) = C.partitionFields fields0
+    let fields2  = M.filterWithKey (\k _ -> k `elem` knownFields) fields1
+    (\n -> C.CondNode n () []) <$> parse fields0 fields2 sections
+  where
+    knownFields = C.fieldGrammarKnownFieldList $ grammar []
+
+    parse otherFields fields sections = do
+        let prettyOtherFields = map void $ C.fromParsecFields $ filter otherFieldName otherFields
+        prj <- C.parseFieldGrammar C.cabalSpecLatest fields $ grammar prettyOtherFields
+        foldl' (&) prj <$> traverse parseSec (concat sections)
+
+    -- Special case for source-repository-package. If you add another such
+    -- special case, make sure to update otherFieldName appropriately.
+    parseSec :: C.Section C.Position -> C.ParseResult (Project Void String String -> Project Void String String)
+    parseSec (C.MkSection (C.Name _pos name) [] fields) | name == sourceRepoSectionName = do
+        let fields' = fst $ C.partitionFields fields
+        repos <- C.parseFieldGrammar C.cabalSpecLatest fields' sourceRepositoryPackageGrammar
+        return $ over prjSourceReposL (++ toList (srpFanOut repos))
+
+    parseSec _ = return id
+
 -- | Returns 'True' if a field should be a part of 'prjOtherFields'. This
 -- excludes any field that is a part of 'grammar' as well as
 -- @source-repository-package@ (see 'parseProject', which has a special case