    -----------------------------------------------------------------------------
    -- |
    -- Module      :  Distribution.Simple.PackageDescription
    -- Copyright   :  Isaac Jones 2003-2005
    -- License     :  BSD3
    --
    -- Maintainer  :  cabal-devel@haskell.org
    -- Portability :  portable
    --
    -- This defines parsers for the @.cabal@ format

    module Distribution.Simple.PackageDescription (
        -- * Read and Parse files
        readGenericPackageDescription,
        readHookedBuildInfo,

        -- * Utility Parsing function
        parseString,
        ) where

    import Prelude ()
    import Distribution.Compat.Prelude

    import Distribution.Fields.ParseResult
    import Distribution.PackageDescription
    import Distribution.PackageDescription.Parsec
        ( parseGenericPackageDescription, parseHookedBuildInfo )
    import Distribution.Parsec.Error ( showPError )
    import Distribution.Parsec.Warning
        ( PWarning(..), PWarnType(PWTExperimental), showPWarning )
    import Distribution.Simple.Utils ( equating, die', warn )
    import Distribution.Verbosity ( normal, Verbosity )

    import Data.List ( groupBy )
    import Text.Printf ( printf )
    import qualified Data.ByteString as BS
    import System.Directory (doesFileExist)

    readGenericPackageDescription :: Verbosity -> FilePath -> IO GenericPackageDescription
    readGenericPackageDescription :: Verbosity -> String -> IO GenericPackageDescription
    readGenericPackageDescription = (ByteString -> ParseResult GenericPackageDescription)
    -> Verbosity -> String -> IO GenericPackageDescription
    forall a.
    (ByteString -> ParseResult a) -> Verbosity -> String -> IO a
    readAndParseFile ByteString -> ParseResult GenericPackageDescription
    parseGenericPackageDescription

    readHookedBuildInfo :: Verbosity -> FilePath -> IO HookedBuildInfo
    readHookedBuildInfo :: Verbosity -> String -> IO HookedBuildInfo
    readHookedBuildInfo = (ByteString -> ParseResult HookedBuildInfo)
    -> Verbosity -> String -> IO HookedBuildInfo
    forall a.
    (ByteString -> ParseResult a) -> Verbosity -> String -> IO a
    readAndParseFile ByteString -> ParseResult HookedBuildInfo
    parseHookedBuildInfo

    -- | Helper combinator to do parsing plumbing for files.
    --
    -- Given a parser and a filename, return the parse of the file,
    -- after checking if the file exists.
    --
    -- Argument order is chosen to encourage partial application.
    readAndParseFile
        :: (BS.ByteString -> ParseResult a)  -- ^ File contents to final value parser
        -> Verbosity                         -- ^ Verbosity level
        -> FilePath                          -- ^ File to read
        -> IO a
    readAndParseFile :: forall a.
    (ByteString -> ParseResult a) -> Verbosity -> String -> IO a
    readAndParseFile ByteString -> ParseResult a
    parser Verbosity
    verbosity String
    fpath = do
        Bool
    exists <- String -> IO Bool
    doesFileExist String
    fpath
        Bool -> IO () -> IO ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    unless Bool
    exists (IO () -> IO ()) -> IO () -> IO ()
    forall a b. (a -> b) -> a -> b
    $
          Verbosity -> String -> IO ()
    forall a. Verbosity -> String -> IO a
    die' Verbosity
    verbosity (String -> IO ()) -> String -> IO ()
    forall a b. (a -> b) -> a -> b
    $
            String
    "Error Parsing: file \"" String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    fpath String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    "\" doesn't exist. Cannot continue."
        ByteString
    bs <- String -> IO ByteString
    BS.readFile String
    fpath
        (ByteString -> ParseResult a)
    -> Verbosity -> String -> ByteString -> IO a
    forall a.
    (ByteString -> ParseResult a)
    -> Verbosity -> String -> ByteString -> IO a
    parseString ByteString -> ParseResult a
    parser Verbosity
    verbosity String
    fpath ByteString
    bs

    parseString
        :: (BS.ByteString -> ParseResult a)  -- ^ File contents to final value parser
        -> Verbosity                         -- ^ Verbosity level
        -> String                            -- ^ File name
        -> BS.ByteString
        -> IO a
    parseString :: forall a.
    (ByteString -> ParseResult a)
    -> Verbosity -> String -> ByteString -> IO a
    parseString ByteString -> ParseResult a
    parser Verbosity
    verbosity String
    name ByteString
    bs = do
        let ([PWarning]
    warnings, Either (Maybe Version, NonEmpty PError) a
    result) = ParseResult a
    -> ([PWarning], Either (Maybe Version, NonEmpty PError) a)
    forall a.
    ParseResult a
    -> ([PWarning], Either (Maybe Version, NonEmpty PError) a)
    runParseResult (ByteString -> ParseResult a
    parser ByteString
    bs)
        (PWarning -> IO ()) -> [PWarning] -> IO ()
    forall (t :: * -> *) (f :: * -> *) a b.
    (Foldable t, Applicative f) =>
    (a -> f b) -> t a -> f ()
    traverse_ (Verbosity -> String -> IO ()
    warn Verbosity
    verbosity (String -> IO ()) -> (PWarning -> String) -> PWarning -> IO ()
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> PWarning -> String
    showPWarning String
    name) (Verbosity -> [PWarning] -> [PWarning]
    flattenDups Verbosity
    verbosity [PWarning]
    warnings)
        case Either (Maybe Version, NonEmpty PError) a
    result of
            Right a
    x -> a -> IO a
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return a
    x
            Left (Maybe Version
    _, NonEmpty PError
    errors) -> do
                (PError -> IO ()) -> NonEmpty PError -> IO ()
    forall (t :: * -> *) (f :: * -> *) a b.
    (Foldable t, Applicative f) =>
    (a -> f b) -> t a -> f ()
    traverse_ (Verbosity -> String -> IO ()
    warn Verbosity
    verbosity (String -> IO ()) -> (PError -> String) -> PError -> IO ()
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> PError -> String
    showPError String
    name) NonEmpty PError
    errors
                Verbosity -> String -> IO a
    forall a. Verbosity -> String -> IO a
    die' Verbosity
    verbosity (String -> IO a) -> String -> IO a
    forall a b. (a -> b) -> a -> b
    $ String
    "Failed parsing \"" String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    name String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    "\"."

    -- | Collapse duplicate experimental feature warnings into single warning, with
    -- a count of further sites
    flattenDups :: Verbosity -> [PWarning] -> [PWarning]
    flattenDups :: Verbosity -> [PWarning] -> [PWarning]
    flattenDups Verbosity
    verbosity [PWarning]
    ws
        | Verbosity
    verbosity Verbosity -> Verbosity -> Bool
    forall a. Ord a => a -> a -> Bool
    <= Verbosity
    normal = [PWarning]
    rest [PWarning] -> [PWarning] -> [PWarning]
    forall a. [a] -> [a] -> [a]
    ++ [PWarning]
    experimentals
        | Bool
    otherwise = [PWarning]
    ws -- show all instances
        where
            ([PWarning]
    exps, [PWarning]
    rest) = (PWarning -> Bool) -> [PWarning] -> ([PWarning], [PWarning])
    forall a. (a -> Bool) -> [a] -> ([a], [a])
    partition (\(PWarning PWarnType
    w Position
    _ String
    _) -> PWarnType
    w PWarnType -> PWarnType -> Bool
    forall a. Eq a => a -> a -> Bool
    == PWarnType
    PWTExperimental) [PWarning]
    ws
            experimentals :: [PWarning]
    experimentals =
                 ([PWarning] -> [PWarning]) -> [[PWarning]] -> [PWarning]
    forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
    concatMap [PWarning] -> [PWarning]
    flatCount
               ([[PWarning]] -> [PWarning])
    -> ([PWarning] -> [[PWarning]]) -> [PWarning] -> [PWarning]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (PWarning -> PWarning -> Bool) -> [PWarning] -> [[PWarning]]
    forall a. (a -> a -> Bool) -> [a] -> [[a]]
    groupBy ((PWarning -> String) -> PWarning -> PWarning -> Bool
    forall a b. Eq a => (b -> a) -> b -> b -> Bool
    equating PWarning -> String
    warningStr)
               ([PWarning] -> [[PWarning]])
    -> ([PWarning] -> [PWarning]) -> [PWarning] -> [[PWarning]]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (PWarning -> PWarning -> Ordering) -> [PWarning] -> [PWarning]
    forall a. (a -> a -> Ordering) -> [a] -> [a]
    sortBy ((PWarning -> String) -> PWarning -> PWarning -> Ordering
    forall a b. Ord a => (b -> a) -> b -> b -> Ordering
    comparing PWarning -> String
    warningStr)
               ([PWarning] -> [PWarning]) -> [PWarning] -> [PWarning]
    forall a b. (a -> b) -> a -> b
    $ [PWarning]
    exps

            warningStr :: PWarning -> String
    warningStr (PWarning PWarnType
    _ Position
    _ String
    w) = String
    w

            -- flatten if we have 3 or more examples
            flatCount :: [PWarning] -> [PWarning]
            flatCount :: [PWarning] -> [PWarning]
    flatCount w :: [PWarning]
    w@[] = [PWarning]
    w
            flatCount w :: [PWarning]
    w@[PWarning
    _] = [PWarning]
    w
            flatCount w :: [PWarning]
    w@[PWarning
    _,PWarning
    _] = [PWarning]
    w
            flatCount (PWarning PWarnType
    t Position
    pos String
    w:[PWarning]
    xs) =
                [PWarnType -> Position -> String -> PWarning
    PWarning PWarnType
    t Position
    pos
                    (String
    w String -> String -> String
    forall a. Semigroup a => a -> a -> a
    <> String -> Int -> String
    forall r. PrintfType r => String -> r
    printf String
    " (and %d more occurrences)" ([PWarning] -> Int
    forall a. [a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length [PWarning]
    xs))
                ]