{-# 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