    {-# LANGUAGE DeriveDataTypeable #-}
    {-# LANGUAGE FlexibleContexts #-}
    {-# LANGUAGE GeneralizedNewtypeDeriving #-}
    {-# LANGUAGE LambdaCase #-}
    {-# LANGUAGE RankNTypes #-}
    {-# LANGUAGE RecordWildCards #-}

    module Distribution.Simple.GHC.EnvironmentParser (parseGhcEnvironmentFile, readGhcEnvironmentFile, ParseErrorExc (..)) where

    import Distribution.Compat.Prelude
    import 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 (String -> GhcEnvironmentFileEntry)
    -> ParsecT String () Identity String
    -> Parser GhcEnvironmentFileEntry
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> ParsecT String () Identity String
    forall {u}. ParsecT String u Identity String
    comment
        Parser GhcEnvironmentFileEntry
    -> Parser GhcEnvironmentFileEntry -> Parser GhcEnvironmentFileEntry
    forall a.
    ParsecT String () Identity a
    -> ParsecT String () Identity a -> ParsecT String () Identity a
    forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
    <|> UnitId -> GhcEnvironmentFileEntry
    GhcEnvFilePackageId (UnitId -> GhcEnvironmentFileEntry)
    -> ParsecT String () Identity UnitId
    -> Parser GhcEnvironmentFileEntry
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> ParsecT String () Identity UnitId
    forall {u}. ParsecT String u Identity UnitId
    unitId
        Parser GhcEnvironmentFileEntry
    -> Parser GhcEnvironmentFileEntry -> Parser GhcEnvironmentFileEntry
    forall a.
    ParsecT String () Identity a
    -> ParsecT String () Identity a -> ParsecT String () Identity a
    forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
    <|> PackageDB -> GhcEnvironmentFileEntry
    GhcEnvFilePackageDb (PackageDB -> GhcEnvironmentFileEntry)
    -> ParsecT String () Identity PackageDB
    -> Parser GhcEnvironmentFileEntry
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> ParsecT String () Identity PackageDB
    forall {u}. ParsecT String u Identity PackageDB
    packageDb
        Parser GhcEnvironmentFileEntry
    -> Parser GhcEnvironmentFileEntry -> Parser GhcEnvironmentFileEntry
    forall a.
    ParsecT String () Identity a
    -> ParsecT String () Identity a -> ParsecT String () Identity a
    forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
    <|> GhcEnvironmentFileEntry -> Parser GhcEnvironmentFileEntry
    forall a. a -> ParsecT String () Identity a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure GhcEnvironmentFileEntry
    GhcEnvFileClearPackageDbStack Parser GhcEnvironmentFileEntry
    -> ParsecT String () Identity String
    -> Parser GhcEnvironmentFileEntry
    forall a b.
    ParsecT String () Identity a
    -> ParsecT String () Identity b -> ParsecT String () Identity a
    forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
    <* ParsecT String () Identity String
    forall {u}. ParsecT String u Identity String
    clearDb
      where
        comment :: ParsecT String u Identity String
    comment = String -> ParsecT String u Identity String
    forall s (m :: * -> *) u.
    Stream s m Char =>
    String -> ParsecT s u m String
    P.string String
    "--" ParsecT String u Identity String
    -> ParsecT String u Identity String
    -> ParsecT String u Identity String
    forall a b.
    ParsecT String u Identity a
    -> ParsecT String u Identity b -> ParsecT String u Identity b
    forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
    *> ParsecT String u Identity Char -> ParsecT String u Identity String
    forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
    P.many (String -> ParsecT String u Identity Char
    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 =
          ParsecT String u Identity UnitId
    -> ParsecT String u Identity UnitId
    forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
    P.try (ParsecT String u Identity UnitId
     -> ParsecT String u Identity UnitId)
    -> ParsecT String u Identity UnitId
    -> ParsecT String u Identity UnitId
    forall a b. (a -> b) -> a -> b
    $
            String -> ParsecT String u Identity String
    forall s (m :: * -> *) u.
    Stream s m Char =>
    String -> ParsecT s u m String
    P.string String
    "package-id"
              ParsecT String u Identity String
    -> ParsecT String u Identity () -> ParsecT String u Identity ()
    forall a b.
    ParsecT String u Identity a
    -> ParsecT String u Identity b -> ParsecT String u Identity b
    forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
    *> ParsecT String u Identity ()
    forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m ()
    P.spaces
              ParsecT String u Identity ()
    -> ParsecT String u Identity UnitId
    -> ParsecT String u Identity UnitId
    forall a b.
    ParsecT String u Identity a
    -> ParsecT String u Identity b -> ParsecT String u Identity b
    forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
    *> (String -> UnitId
    mkUnitId (String -> UnitId)
    -> ParsecT String u Identity String
    -> ParsecT String u Identity UnitId
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> ParsecT String u Identity Char -> ParsecT String u Identity String
    forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
    P.many1 ((Char -> Bool) -> ParsecT String u Identity Char
    forall s (m :: * -> *) u.
    Stream s m Char =>
    (Char -> Bool) -> ParsecT s u m Char
    P.satisfy ((Char -> Bool) -> ParsecT String u Identity Char)
    -> (Char -> Bool) -> ParsecT String u Identity Char
    forall a b. (a -> b) -> a -> b
    $ \Char
    c -> Char -> Bool
    isAlphaNum Char
    c Bool -> Bool -> Bool
    || Char
    c Char -> String -> Bool
    forall a. Eq a => a -> [a] -> Bool
    forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
    `elem` String
    "-_.+"))
        packageDb :: ParsecT String u Identity PackageDB
    packageDb =
          (String -> ParsecT String u Identity String
    forall s (m :: * -> *) u.
    Stream s m Char =>
    String -> ParsecT s u m String
    P.string String
    "global-package-db" ParsecT String u Identity String
    -> ParsecT String u Identity PackageDB
    -> ParsecT String u Identity PackageDB
    forall a b.
    ParsecT String u Identity a
    -> ParsecT String u Identity b -> ParsecT String u Identity b
    forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
    *> PackageDB -> ParsecT String u Identity PackageDB
    forall a. a -> ParsecT String u Identity a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure PackageDB
    GlobalPackageDB)
            ParsecT String u Identity PackageDB
    -> ParsecT String u Identity PackageDB
    -> ParsecT String u Identity PackageDB
    forall a.
    ParsecT String u Identity a
    -> ParsecT String u Identity a -> ParsecT String u Identity a
    forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
    <|> (String -> ParsecT String u Identity String
    forall s (m :: * -> *) u.
    Stream s m Char =>
    String -> ParsecT s u m String
    P.string String
    "user-package-db" ParsecT String u Identity String
    -> ParsecT String u Identity PackageDB
    -> ParsecT String u Identity PackageDB
    forall a b.
    ParsecT String u Identity a
    -> ParsecT String u Identity b -> ParsecT String u Identity b
    forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
    *> PackageDB -> ParsecT String u Identity PackageDB
    forall a. a -> ParsecT String u Identity a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure PackageDB
    UserPackageDB)
            ParsecT String u Identity PackageDB
    -> ParsecT String u Identity PackageDB
    -> ParsecT String u Identity PackageDB
    forall a.
    ParsecT String u Identity a
    -> ParsecT String u Identity a -> ParsecT String u Identity a
    forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
    <|> (String -> ParsecT String u Identity String
    forall s (m :: * -> *) u.
    Stream s m Char =>
    String -> ParsecT s u m String
    P.string String
    "package-db" ParsecT String u Identity String
    -> ParsecT String u Identity () -> ParsecT String u Identity ()
    forall a b.
    ParsecT String u Identity a
    -> ParsecT String u Identity b -> ParsecT String u Identity b
    forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
    *> ParsecT String u Identity ()
    forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m ()
    P.spaces ParsecT String u Identity ()
    -> ParsecT String u Identity PackageDB
    -> ParsecT String u Identity PackageDB
    forall a b.
    ParsecT String u Identity a
    -> ParsecT String u Identity b -> ParsecT String u Identity b
    forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
    *> (String -> PackageDB
    SpecificPackageDB (String -> PackageDB)
    -> ParsecT String u Identity String
    -> ParsecT String u Identity PackageDB
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> ParsecT String u Identity Char -> ParsecT String u Identity String
    forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
    P.many1 (String -> ParsecT String u Identity Char
    forall s (m :: * -> *) u.
    Stream s m Char =>
    String -> ParsecT s u m Char
    P.noneOf String
    "\r\n") ParsecT String u Identity PackageDB
    -> ParsecT String u Identity Char
    -> ParsecT String u Identity PackageDB
    forall a b.
    ParsecT String u Identity a
    -> ParsecT String u Identity b -> ParsecT String u Identity a
    forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
    <* ParsecT String u Identity Char -> ParsecT String u Identity Char
    forall s (m :: * -> *) t u a.
    Stream s m t =>
    ParsecT s u m a -> ParsecT s u m a
    P.lookAhead ParsecT String u Identity Char
    forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
    P.endOfLine))
        clearDb :: ParsecT String u Identity String
    clearDb = String -> ParsecT String u Identity String
    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
    (Int -> ParseErrorExc -> ShowS)
    -> (ParseErrorExc -> String)
    -> ([ParseErrorExc] -> ShowS)
    -> Show ParseErrorExc
    forall a.
    (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
    $cshowsPrec :: Int -> ParseErrorExc -> ShowS
    showsPrec :: Int -> ParseErrorExc -> ShowS
    $cshow :: ParseErrorExc -> String
    show :: ParseErrorExc -> String
    $cshowList :: [ParseErrorExc] -> ShowS
    showList :: [ParseErrorExc] -> ShowS
    Show, Typeable)

    instance Exception ParseErrorExc

    parseGhcEnvironmentFile :: Parser [GhcEnvironmentFileEntry]
    parseGhcEnvironmentFile :: Parser [GhcEnvironmentFileEntry]
    parseGhcEnvironmentFile = Parser GhcEnvironmentFileEntry
    parseEnvironmentFileLine Parser GhcEnvironmentFileEntry
    -> ParsecT String () Identity Char
    -> Parser [GhcEnvironmentFileEntry]
    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` ParsecT String () Identity Char
    forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
    P.endOfLine Parser [GhcEnvironmentFileEntry]
    -> ParsecT String () Identity ()
    -> Parser [GhcEnvironmentFileEntry]
    forall a b.
    ParsecT String () Identity a
    -> ParsecT String () Identity b -> ParsecT String () Identity a
    forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
    <* ParsecT String () Identity ()
    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 =
      (ParseError -> IO [GhcEnvironmentFileEntry])
    -> ([GhcEnvironmentFileEntry] -> IO [GhcEnvironmentFileEntry])
    -> Either ParseError [GhcEnvironmentFileEntry]
    -> IO [GhcEnvironmentFileEntry]
    forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
    either (ParseErrorExc -> IO [GhcEnvironmentFileEntry]
    forall e a. (HasCallStack, Exception e) => e -> IO a
    throwIO (ParseErrorExc -> IO [GhcEnvironmentFileEntry])
    -> (ParseError -> ParseErrorExc)
    -> ParseError
    -> IO [GhcEnvironmentFileEntry]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ParseError -> ParseErrorExc
    ParseErrorExc) [GhcEnvironmentFileEntry] -> IO [GhcEnvironmentFileEntry]
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return
        (Either ParseError [GhcEnvironmentFileEntry]
     -> IO [GhcEnvironmentFileEntry])
    -> IO (Either ParseError [GhcEnvironmentFileEntry])
    -> IO [GhcEnvironmentFileEntry]
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
    =<< Parser [GhcEnvironmentFileEntry]
    -> String -> IO (Either ParseError [GhcEnvironmentFileEntry])
    forall a. Parser a -> String -> IO (Either ParseError a)
    parseFromFile Parser [GhcEnvironmentFileEntry]
    parseGhcEnvironmentFile String
    path