Replace cabal project parsing with Parsec

Cabal-syntax/src/Distribution/FieldGrammar.hs

@@ -65,6 +65,20 @@ x ^^^ f = f x
 data PS ann = PS (Fields ann) [Section ann] [[Section ann]]
 
 -- | Partition field list into field map and groups of sections.
+-- Groups sections between fields. This means that the following snippet contains
+-- two section groups:
+--
+-- @
+-- -- first group
+-- some-section
+--     field: value
+-- another-section
+--     field: value
+-- foo: bar
+-- -- second group
+-- yet-another-section
+--     field: value
+-- @
 partitionFields :: [Field ann] -> (Fields ann, [[Section ann]])
 partitionFields = finalize . foldl' f (PS mempty mempty mempty)
   where

Cabal-syntax/src/Distribution/Fields/ParseResult.hs

@@ -16,6 +16,7 @@ module Distribution.Fields.ParseResult
   , getCabalSpecVersion
   , setCabalSpecVersion
   , withoutWarnings
+  , liftPR
   ) where
 
 import Distribution.Parsec.Error (PError (..))
@@ -73,6 +74,16 @@ runParseResult pr = unPR pr emptyPRState failure success
     -- If there are any errors, don't return the result
     success (PRState warns (err : errs) v) _ = (warns, Left (v, err :| errs))
 
+liftPR :: (a -> IO (ParseResult b)) -> ParseResult a -> IO (ParseResult b)
+liftPR f pr = unPR pr emptyPRState failure success
+  where
+    failure s = return $ PR $ \s' failure' _ -> failure' (concatPRState s s')
+    success s a = do
+      pr' <- f a
+      return $ PR $ \s' failure' success' -> unPR pr' (concatPRState s s') failure' success'
+    concatPRState (PRState warnings errors version) (PRState warnings' errors' version') =
+      (PRState (warnings ++ warnings') (toList errors ++ errors') (version <|> version'))
+
 instance Functor ParseResult where
   fmap f (PR pr) = PR $ \ !s failure success ->
     pr s failure $ \ !s' a ->

Cabal/src/Distribution/Simple/Compiler.hs

@@ -40,6 +40,7 @@ module Distribution.Simple.Compiler
   , registrationPackageDB
   , absolutePackageDBPaths
   , absolutePackageDBPath
+  , readPackageDb
 
     -- * Support for optimisation levels
   , OptimisationLevel (..)
@@ -77,7 +78,9 @@ module Distribution.Simple.Compiler
   , showProfDetailLevel
   ) where
 
+import Distribution.Compat.CharParsing
 import Distribution.Compat.Prelude
+import Distribution.Parsec
 import Distribution.Pretty
 import Prelude ()
 
@@ -88,6 +91,7 @@ import Distribution.Version
 
 import Language.Haskell.Extension
 
+import Data.Bool (bool)
 import qualified Data.Map as Map (lookup)
 import System.Directory (canonicalizePath)
 import System.FilePath (isRelative)
@@ -186,6 +190,15 @@ data PackageDB
 instance Binary PackageDB
 instance Structured PackageDB
 
+-- | Parse a PackageDB stack entry
+--
+-- @since 3.7.0.0
+readPackageDb :: String -> Maybe PackageDB
+readPackageDb "clear" = Nothing
+readPackageDb "global" = Just GlobalPackageDB
+readPackageDb "user" = Just UserPackageDB
+readPackageDb other = Just (SpecificPackageDB other)
+
 -- | We typically get packages from several databases, and stack them
 -- together. This type lets us be explicit about that stacking. For example
 -- typical stacks include:
@@ -248,20 +261,32 @@ data OptimisationLevel
 instance Binary OptimisationLevel
 instance Structured OptimisationLevel
 
+instance Parsec OptimisationLevel where
+  parsec = parsecOptimisationLevel
+
+parsecOptimisationLevel :: CabalParsing m => m OptimisationLevel
+parsecOptimisationLevel = boolParser <|> intParser
+  where
+    boolParser = (bool NoOptimisation NormalOptimisation) <$> parsec
+    intParser = intToOptimisationLevel <$> integral
+
 flagToOptimisationLevel :: Maybe String -> OptimisationLevel
 flagToOptimisationLevel Nothing = NormalOptimisation
 flagToOptimisationLevel (Just s) = case reads s of
-  [(i, "")]
-    | i >= fromEnum (minBound :: OptimisationLevel)
-        && i <= fromEnum (maxBound :: OptimisationLevel) ->
-        toEnum i
-    | otherwise ->
-        error $
-          "Bad optimisation level: "
-            ++ show i
-            ++ ". Valid values are 0..2"
+  [(i, "")] -> intToOptimisationLevel i
   _ -> error $ "Can't parse optimisation level " ++ s
 
+intToOptimisationLevel :: Int -> OptimisationLevel
+intToOptimisationLevel i
+  | i >= fromEnum (minBound :: OptimisationLevel)
+      && i <= fromEnum (maxBound :: OptimisationLevel) =
+      toEnum i
+  | otherwise =
+      error $
+        "Bad optimisation level: "
+          ++ show i
+          ++ ". Valid values are 0..2"
+
 -- ------------------------------------------------------------
 
 -- * Debug info levels
@@ -281,6 +306,12 @@ data DebugInfoLevel
 instance Binary DebugInfoLevel
 instance Structured DebugInfoLevel
 
+instance Parsec DebugInfoLevel where
+  parsec = parsecDebugInfoLevel
+
+parsecDebugInfoLevel :: CabalParsing m => m DebugInfoLevel
+parsecDebugInfoLevel = flagToDebugInfoLevel <$> pure <$> parsecToken
+
 flagToDebugInfoLevel :: Maybe String -> DebugInfoLevel
 flagToDebugInfoLevel Nothing = NormalDebugInfo
 flagToDebugInfoLevel (Just s) = case reads s of
@@ -475,6 +506,12 @@ data ProfDetailLevel
 instance Binary ProfDetailLevel
 instance Structured ProfDetailLevel
 
+instance Parsec ProfDetailLevel where
+  parsec = parsecProfDetailLevel
+
+parsecProfDetailLevel :: CabalParsing m => m ProfDetailLevel
+parsecProfDetailLevel = flagToProfDetailLevel <$> parsecToken
+
 flagToProfDetailLevel :: String -> ProfDetailLevel
 flagToProfDetailLevel "" = ProfDetailDefault
 flagToProfDetailLevel s =

Cabal/src/Distribution/Simple/Flag.hs

@@ -35,6 +35,7 @@ module Distribution.Simple.Flag
 
 import Distribution.Compat.Prelude hiding (get)
 import Distribution.Compat.Stack
+import Distribution.Parsec
 import Prelude ()
 
 -- ------------------------------------------------------------
@@ -100,6 +101,12 @@ instance Enum a => Enum (Flag a) where
   enumFromThenTo (Flag a) (Flag b) (Flag c) = toFlag `map` enumFromThenTo a b c
   enumFromThenTo _ _ _ = []
 
+instance Parsec a => Parsec (Flag a) where
+  parsec = parsecFlag
+
+parsecFlag :: (Parsec a, CabalParsing m) => m (Flag a)
+parsecFlag = (Flag <$> parsec) <|> pure mempty
+
 -- | Wraps a value in 'Flag'.
 toFlag :: a -> Flag a
 toFlag = Flag

Cabal/src/Distribution/Simple/InstallDirs.hs

@@ -54,6 +54,7 @@ import Prelude ()
 import Distribution.Compat.Environment (lookupEnv)
 import Distribution.Compiler
 import Distribution.Package
+import Distribution.Parsec
 import Distribution.Pretty
 import Distribution.Simple.InstallDirs.Internal
 import Distribution.System
@@ -507,6 +508,12 @@ instance Read PathTemplate where
     , (template, "") <- reads path
     ]
 
+instance Parsec PathTemplate where
+  parsec = parsecPathTemplate
+
+parsecPathTemplate :: CabalParsing m => m PathTemplate
+parsecPathTemplate = parsecFilePath >>= return . toPathTemplate
+
 -- ---------------------------------------------------------------------------
 -- Internal utilities
 

Cabal/src/Distribution/Simple/PackageDescription.hs

@@ -18,6 +18,8 @@ module Distribution.Simple.PackageDescription
 
     -- * Utility Parsing function
   , parseString
+  , readAndParseFile
+  , flattenDups
   ) where
 
 import Distribution.Compat.Prelude

Cabal/src/Distribution/Simple/Setup/Config.hs

@@ -873,15 +873,6 @@ configureOptions showOrParseArgs =
 readPackageDbList :: String -> [Maybe PackageDB]
 readPackageDbList str = [readPackageDb str]
 
--- | Parse a PackageDB stack entry
---
--- @since 3.7.0.0
-readPackageDb :: String -> Maybe PackageDB
-readPackageDb "clear" = Nothing
-readPackageDb "global" = Just GlobalPackageDB
-readPackageDb "user" = Just UserPackageDB
-readPackageDb other = Just (SpecificPackageDB other)
-
 showPackageDbList :: [Maybe PackageDB] -> [String]
 showPackageDbList = map showPackageDb
 

Cabal/src/Distribution/Types/DumpBuildInfo.hs

@@ -6,6 +6,7 @@ module Distribution.Types.DumpBuildInfo
   ) where
 
 import Distribution.Compat.Prelude
+import Distribution.Parsec
 
 data DumpBuildInfo
   = NoDumpBuildInfo
@@ -14,3 +15,14 @@ data DumpBuildInfo
 
 instance Binary DumpBuildInfo
 instance Structured DumpBuildInfo
+
+instance Parsec DumpBuildInfo where
+  parsec = parsecDumpBuildInfo
+
+parsecDumpBuildInfo :: CabalParsing m => m DumpBuildInfo
+parsecDumpBuildInfo = boolToDumpBuildInfo <$> parsec
+
+boolToDumpBuildInfo :: Bool -> DumpBuildInfo
+boolToDumpBuildInfo bool = case bool of
+  True -> DumpBuildInfo
+  _ -> NoDumpBuildInfo

cabal-install-solver/src/Distribution/Solver/Types/Settings.hs

@@ -105,3 +105,26 @@ instance Parsec OnlyConstrained where
     , P.string "none" >> return OnlyConstrainedNone
     ]
 
+instance Parsec ReorderGoals where
+  parsec = ReorderGoals <$> parsec
+
+instance Parsec CountConflicts where
+  parsec = CountConflicts <$> parsec
+
+instance Parsec FineGrainedConflicts where
+  parsec = FineGrainedConflicts <$> parsec
+
+instance Parsec MinimizeConflictSet where
+  parsec = MinimizeConflictSet <$> parsec
+
+instance Parsec StrongFlags where
+  parsec = StrongFlags <$> parsec
+
+instance Parsec AllowBootLibInstalls where
+  parsec = AllowBootLibInstalls <$> parsec
+
+instance Parsec PreferOldest where
+  parsec = PreferOldest <$> parsec
+
+instance Parsec IndependentGoals where
+  parsec = IndependentGoals <$> parsec

cabal-install/cabal-install.cabal

@@ -165,7 +165,10 @@ library
         Distribution.Client.ProjectBuilding.PackageFileMonitor
         Distribution.Client.ProjectBuilding.Types
         Distribution.Client.ProjectConfig
+        Distribution.Client.ProjectConfig.FieldGrammar
         Distribution.Client.ProjectConfig.Legacy
+        Distribution.Client.ProjectConfig.Lens
+        Distribution.Client.ProjectConfig.Parsec
         Distribution.Client.ProjectConfig.Types
         Distribution.Client.ProjectFlags
         Distribution.Client.ProjectOrchestration