content: {-# LANGUAGE DeriveDataTypeable #-}
  {-# LANGUAGE FlexibleContexts #-}
  {-# LANGUAGE GeneralizedNewtypeDeriving #-}
  {-# LANGUAGE LambdaCase #-}
  {-# LANGUAGE RankNTypes #-}
  {-# LANGUAGE RecordWildCards #-}
  module Distribution.Simple.GHC.EnvironmentParser 
      ( parseGhcEnvironmentFile, readGhcEnvironmentFile, ParseErrorExc(..) ) where
  
  import Prelude ()
  import Distribution.Compat.Prelude
  
  import Distribution.Simple.Compiler
      ( PackageDB(..) )
  import Distribution.Simple.GHC.Internal
      ( GhcEnvironmentFileEntry(..) )
  import Distribution.Types.UnitId
      ( mkUnitId )
  
  import Control.Exception
      ( Exception, throwIO )
  import qualified Text.Parsec as P
  import Text.Parsec.String 
      ( Parser, parseFromFile )
  
  parseEnvironmentFileLine :: Parser GhcEnvironmentFileEntry
  parseEnvironmentFileLine =      GhcEnvFileComment             <$> comment
                         <|>      GhcEnvFilePackageId           <$> unitId
                         <|>      GhcEnvFilePackageDb           <$> packageDb
                         <|> pure GhcEnvFileClearPackageDbStack <*  clearDb
      where
          comment = P.string "--" *> P.many (P.noneOf "\r\n")
          unitId = P.try $ P.string "package-id" *> P.spaces *> 
              (mkUnitId <$> P.many1 (P.satisfy $ \c -> isAlphaNum c || c `elem` "-_.+"))
          packageDb = (P.string "global-package-db"      *> pure GlobalPackageDB)
                  <|> (P.string "user-package-db"        *> pure UserPackageDB)
                  <|> (P.string "package-db" *> P.spaces *> (SpecificPackageDB <$> P.many1 (P.noneOf "\r\n") <* P.lookAhead P.endOfLine))
          clearDb = P.string "clear-package-db"
  
  newtype ParseErrorExc = ParseErrorExc P.ParseError
                        deriving (Show, Typeable)
  
  instance Exception ParseErrorExc
  
  parseGhcEnvironmentFile :: Parser [GhcEnvironmentFileEntry]
  parseGhcEnvironmentFile = parseEnvironmentFileLine `P.sepEndBy` P.endOfLine <* P.eof
  
  readGhcEnvironmentFile :: FilePath -> IO [GhcEnvironmentFileEntry]
  readGhcEnvironmentFile path =
      either (throwIO . ParseErrorExc) return =<<
          parseFromFile parseGhcEnvironmentFile path
  