{-# 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 qualified Text.Parsec as P import Text.Parsec.String ( Parser, parseFromFile ) parseEnvironmentFileLine :: Parser GhcEnvironmentFileEntry parseEnvironmentFileLine :: Parser GhcEnvironmentFileEntry parseEnvironmentFileLine = String -> GhcEnvironmentFileEntry GhcEnvFileComment forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> forall {u}. ParsecT String u Identity String comment forall (f :: * -> *) a. Alternative f => f a -> f a -> f a <|> UnitId -> GhcEnvironmentFileEntry GhcEnvFilePackageId forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> forall {u}. ParsecT String u Identity UnitId unitId forall (f :: * -> *) a. Alternative f => f a -> f a -> f a <|> PackageDB -> GhcEnvironmentFileEntry GhcEnvFilePackageDb forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> forall {u}. ParsecT String u Identity PackageDB packageDb forall (f :: * -> *) a. Alternative f => f a -> f a -> f a <|> forall (f :: * -> *) a. Applicative f => a -> f a pure GhcEnvironmentFileEntry GhcEnvFileClearPackageDbStack forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a <* forall {u}. ParsecT String u Identity String clearDb where comment :: ParsecT String u Identity String comment = forall s (m :: * -> *) u. Stream s m Char => String -> ParsecT s u m String P.string String "--" forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b *> forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a] P.many (forall s (m :: * -> *) u. Stream s m Char => String -> ParsecT s u m Char P.noneOf String "\r\n") unitId :: ParsecT String u Identity UnitId unitId = forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a P.try forall a b. (a -> b) -> a -> b $ forall s (m :: * -> *) u. Stream s m Char => String -> ParsecT s u m String P.string String "package-id" forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b *> forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m () P.spaces forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b *> (String -> UnitId mkUnitId forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> forall s (m :: * -> *) t u a. Stream s m t => ParsecT s u m a -> ParsecT s u m [a] P.many1 (forall s (m :: * -> *) u. Stream s m Char => (Char -> Bool) -> ParsecT s u m Char P.satisfy forall a b. (a -> b) -> a -> b $ \Char c -> Char -> Bool isAlphaNum Char c Bool -> Bool -> Bool || Char c forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool `elem` String "-_.+")) packageDb :: ParsecT String u Identity PackageDB packageDb = (forall s (m :: * -> *) u. Stream s m Char => String -> ParsecT s u m String P.string String "global-package-db" forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b *> forall (f :: * -> *) a. Applicative f => a -> f a pure PackageDB GlobalPackageDB) forall (f :: * -> *) a. Alternative f => f a -> f a -> f a <|> (forall s (m :: * -> *) u. Stream s m Char => String -> ParsecT s u m String P.string String "user-package-db" forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b *> forall (f :: * -> *) a. Applicative f => a -> f a pure PackageDB UserPackageDB) forall (f :: * -> *) a. Alternative f => f a -> f a -> f a <|> (forall s (m :: * -> *) u. Stream s m Char => String -> ParsecT s u m String P.string String "package-db" forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b *> forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m () P.spaces forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b *> (String -> PackageDB SpecificPackageDB forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> forall s (m :: * -> *) t u a. Stream s m t => ParsecT s u m a -> ParsecT s u m [a] P.many1 (forall s (m :: * -> *) u. Stream s m Char => String -> ParsecT s u m Char P.noneOf String "\r\n") forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a <* forall s (m :: * -> *) t u a. Stream s m t => ParsecT s u m a -> ParsecT s u m a P.lookAhead forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char P.endOfLine)) clearDb :: ParsecT String u Identity String clearDb = forall s (m :: * -> *) u. Stream s m Char => String -> ParsecT s u m String P.string String "clear-package-db" newtype ParseErrorExc = ParseErrorExc P.ParseError deriving (Int -> ParseErrorExc -> ShowS [ParseErrorExc] -> ShowS ParseErrorExc -> String forall a. (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a showList :: [ParseErrorExc] -> ShowS $cshowList :: [ParseErrorExc] -> ShowS show :: ParseErrorExc -> String $cshow :: ParseErrorExc -> String showsPrec :: Int -> ParseErrorExc -> ShowS $cshowsPrec :: Int -> ParseErrorExc -> ShowS Show, Typeable) instance Exception ParseErrorExc parseGhcEnvironmentFile :: Parser [GhcEnvironmentFileEntry] parseGhcEnvironmentFile :: Parser [GhcEnvironmentFileEntry] parseGhcEnvironmentFile = Parser GhcEnvironmentFileEntry parseEnvironmentFileLine forall s (m :: * -> *) t u a sep. Stream s m t => ParsecT s u m a -> ParsecT s u m sep -> ParsecT s u m [a] `P.sepEndBy` forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char P.endOfLine forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a <* forall s (m :: * -> *) t u. (Stream s m t, Show t) => ParsecT s u m () P.eof readGhcEnvironmentFile :: FilePath -> IO [GhcEnvironmentFileEntry] readGhcEnvironmentFile :: String -> IO [GhcEnvironmentFileEntry] readGhcEnvironmentFile String path = forall a c b. (a -> c) -> (b -> c) -> Either a b -> c either (forall e a. Exception e => e -> IO a throwIO forall b c a. (b -> c) -> (a -> b) -> a -> c . ParseError -> ParseErrorExc ParseErrorExc) forall (m :: * -> *) a. Monad m => a -> m a return forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b =<< forall a. Parser a -> String -> IO (Either ParseError a) parseFromFile Parser [GhcEnvironmentFileEntry] parseGhcEnvironmentFile String path