    -----------------------------------------------------------------------------

    -- |
    -- 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 Distribution.Compat.Prelude
    import Prelude ()

    import qualified Data.ByteString as BS
    import Data.List (groupBy)
    import Distribution.Fields.ParseResult
    import Distribution.PackageDescription
    import Distribution.PackageDescription.Parsec
      ( parseGenericPackageDescription
      , parseHookedBuildInfo
      )
    import Distribution.Parsec.Error (showPError)
    import Distribution.Parsec.Warning
      ( PWarnType (PWTExperimental)
      , PWarning (..)
      , showPWarning
      )
    import Distribution.Simple.Errors
    import Distribution.Simple.Utils (dieWithException, equating, warn)
    import Distribution.Verbosity (Verbosity, normal)
    import System.Directory (doesFileExist)
    import Text.Printf (printf)

    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
      exists <- String -> IO Bool
    doesFileExist String
    fpath
      unless exists $
        dieWithException verbosity $
          ErrorParsingFileDoesntExist fpath
      bs <- BS.readFile fpath
      parseString parser verbosity fpath 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 -> CabalException -> IO a
    forall a1 a.
    (HasCallStack, Show a1, Typeable a1,
     Exception (VerboseException a1)) =>
    Verbosity -> a1 -> IO a
    dieWithException Verbosity
    verbosity (CabalException -> IO a) -> CabalException -> IO a
    forall a b. (a -> b) -> a -> b
    $ String -> CabalException
    FailedParsing String
    name

    -- | 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))
          ]