module Distribution.Simple.PackageDescription (
readGenericPackageDescription,
readHookedBuildInfo,
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 = readAndParseFile parseGenericPackageDescription
readHookedBuildInfo :: Verbosity -> FilePath -> IO HookedBuildInfo
readHookedBuildInfo = readAndParseFile parseHookedBuildInfo
readAndParseFile
:: (BS.ByteString -> ParseResult a)
-> Verbosity
-> FilePath
-> IO a
readAndParseFile parser verbosity fpath = do
exists <- doesFileExist fpath
unless exists $
die' verbosity $
"Error Parsing: file \"" ++ fpath ++ "\" doesn't exist. Cannot continue."
bs <- BS.readFile fpath
parseString parser verbosity fpath bs
parseString
:: (BS.ByteString -> ParseResult a)
-> Verbosity
-> String
-> BS.ByteString
-> IO a
parseString parser verbosity name bs = do
let (warnings, result) = runParseResult (parser bs)
traverse_ (warn verbosity . showPWarning name) (flattenDups verbosity warnings)
case result of
Right x -> return x
Left (_, errors) -> do
traverse_ (warn verbosity . showPError name) errors
die' verbosity $ "Failed parsing \"" ++ name ++ "\"."
flattenDups :: Verbosity -> [PWarning] -> [PWarning]
flattenDups verbosity ws
| verbosity <= normal = rest ++ experimentals
| otherwise = ws
where
(exps, rest) = partition (\(PWarning w _ _) -> w == PWTExperimental) ws
experimentals =
concatMap flatCount
. groupBy (equating warningStr)
. sortBy (comparing warningStr)
$ exps
warningStr (PWarning _ _ w) = w
flatCount :: [PWarning] -> [PWarning]
flatCount w@[] = w
flatCount w@[_] = w
flatCount w@[_,_] = w
flatCount (PWarning t pos w:xs) =
[PWarning t pos
(w <> printf " (and %d more occurrences)" (length xs))
]