Cabal/src/Distribution/Simple/GHC/EnvironmentParser.hs

   1 {-# LANGUAGE DeriveDataTypeable #-}
   2 {-# LANGUAGE FlexibleContexts #-}
   3 {-# LANGUAGE GeneralizedNewtypeDeriving #-}
   4 {-# LANGUAGE LambdaCase #-}
   5 {-# LANGUAGE RankNTypes #-}
   6 {-# LANGUAGE RecordWildCards #-}
   7
   8 module Distribution.Simple.GHC.EnvironmentParser (parseGhcEnvironmentFile, readGhcEnvironmentFile, ParseErrorExc (..)) where
   9
  10 import Distribution.Compat.Prelude
  11 import Prelude ()
  12
  13 import Distribution.Simple.Compiler
  14   ( PackageDB (..)
  15   )
  16 import Distribution.Simple.GHC.Internal
  17   ( GhcEnvironmentFileEntry (..)
  18   )
  19 import Distribution.Types.UnitId
  20   ( mkUnitId
  21   )
  22
  23 import qualified Text.Parsec as P
  24 import Text.Parsec.String
  25   ( Parser
  26   , parseFromFile
  27   )
  28
  29 parseEnvironmentFileLine :: Parser GhcEnvironmentFileEntry
  30 parseEnvironmentFileLine =
  31   GhcEnvFileComment <$> comment
  32     <|> GhcEnvFilePackageId <$> unitId
  33     <|> GhcEnvFilePackageDb <$> packageDb
  34     <|> pure GhcEnvFileClearPackageDbStack <* clearDb
  35   where
  36     comment = P.string "--" *> P.many (P.noneOf "\r\n")
  37     unitId =
  38       P.try $
  39         P.string "package-id"
  40           *> P.spaces
  41           *> (mkUnitId <$> P.many1 (P.satisfy $ \c -> isAlphaNum c || c `elem` "-_.+"))
  42     packageDb =
  43       (P.string "global-package-db" *> pure GlobalPackageDB)
  44         <|> (P.string "user-package-db" *> pure UserPackageDB)
  45         <|> (P.string "package-db" *> P.spaces *> (SpecificPackageDB <$> P.many1 (P.noneOf "\r\n") <* P.lookAhead P.endOfLine))
  46     clearDb = P.string "clear-package-db"
  47
  48 newtype ParseErrorExc = ParseErrorExc P.ParseError
  49   deriving (Show, Typeable)
  50
  51 instance Exception ParseErrorExc
  52
  53 parseGhcEnvironmentFile :: Parser [GhcEnvironmentFileEntry]
  54 parseGhcEnvironmentFile = parseEnvironmentFileLine `P.sepEndBy` P.endOfLine <* P.eof
  55
  56 readGhcEnvironmentFile :: FilePath -> IO [GhcEnvironmentFileEntry]
  57 readGhcEnvironmentFile path =
  58   either (throwIO . ParseErrorExc) return
  59     =<< parseFromFile parseGhcEnvironmentFile path