{-# LANGUAGE DataKinds #-}

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

-- |
-- 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
  , readAndParseFile
  , flattenDups
  ) 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 (showPErrorWithSource)
import Distribution.Parsec.Source
import Distribution.Parsec.Warning
  ( PWarnType (PWTExperimental)
  , PWarning (..)
  , PWarningWithSource (..)
  , showPWarningWithSource
  )
import Distribution.Simple.Errors
import Distribution.Simple.Utils (dieWithException, equating, warn)
import Distribution.Utils.Path
import Distribution.Verbosity (Verbosity, VerbosityLevel (..), verbosityLevel)
import System.Directory (doesFileExist)
import Text.Printf (printf)

readGenericPackageDescription
  :: Verbosity
  -> Maybe (SymbolicPath CWD (Dir Pkg))
  -> SymbolicPath Pkg File
  -> IO GenericPackageDescription
readGenericPackageDescription :: Verbosity
-> Maybe (SymbolicPath CWD ('Dir Pkg))
-> SymbolicPath Pkg 'File
-> IO GenericPackageDescription
readGenericPackageDescription =
  (ByteString
 -> ParseResult CabalFileSource GenericPackageDescription)
-> Verbosity
-> Maybe (SymbolicPath CWD ('Dir Pkg))
-> SymbolicPath Pkg 'File
-> IO GenericPackageDescription
forall a.
(ByteString -> ParseResult CabalFileSource a)
-> Verbosity
-> Maybe (SymbolicPath CWD ('Dir Pkg))
-> SymbolicPath Pkg 'File
-> IO a
readAndParseFile ByteString -> ParseResult CabalFileSource GenericPackageDescription
forall src. ByteString -> ParseResult src GenericPackageDescription
parseGenericPackageDescription

readHookedBuildInfo
  :: Verbosity
  -> Maybe (SymbolicPath CWD (Dir Pkg))
  -- ^ working directory
  -> SymbolicPath Pkg File
  -> IO HookedBuildInfo
readHookedBuildInfo :: Verbosity
-> Maybe (SymbolicPath CWD ('Dir Pkg))
-> SymbolicPath Pkg 'File
-> IO HookedBuildInfo
readHookedBuildInfo =
  (ByteString -> ParseResult CabalFileSource HookedBuildInfo)
-> Verbosity
-> Maybe (SymbolicPath CWD ('Dir Pkg))
-> SymbolicPath Pkg 'File
-> IO HookedBuildInfo
forall a.
(ByteString -> ParseResult CabalFileSource a)
-> Verbosity
-> Maybe (SymbolicPath CWD ('Dir Pkg))
-> SymbolicPath Pkg 'File
-> IO a
readAndParseFile ByteString -> ParseResult CabalFileSource HookedBuildInfo
forall src. ByteString -> ParseResult src 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 CabalFileSource a)
  -- ^ File contents to final value parser
  -> Verbosity
  -- ^ Verbosity level
  -> Maybe (SymbolicPath CWD (Dir Pkg))
  -- ^ Working directory
  -> SymbolicPath Pkg File
  -- ^ File to read
  -> IO a
readAndParseFile :: forall a.
(ByteString -> ParseResult CabalFileSource a)
-> Verbosity
-> Maybe (SymbolicPath CWD ('Dir Pkg))
-> SymbolicPath Pkg 'File
-> IO a
readAndParseFile ByteString -> ParseResult CabalFileSource a
parser Verbosity
verbosity Maybe (SymbolicPath CWD ('Dir Pkg))
mbWorkDir SymbolicPath Pkg 'File
fpath = do
  let ipath :: FilePath
ipath = Maybe (SymbolicPath CWD ('Dir Pkg))
-> SymbolicPath Pkg 'File -> FilePath
forall from (allowAbsolute :: AllowAbsolute) (to :: FileOrDir).
Maybe (SymbolicPath CWD ('Dir from))
-> SymbolicPathX allowAbsolute from to -> FilePath
interpretSymbolicPath Maybe (SymbolicPath CWD ('Dir Pkg))
mbWorkDir SymbolicPath Pkg 'File
fpath
      upath :: FilePath
upath = SymbolicPath Pkg 'File -> FilePath
forall (allowAbsolute :: AllowAbsolute) from (to :: FileOrDir).
SymbolicPathX allowAbsolute from to -> FilePath
getSymbolicPath SymbolicPath Pkg 'File
fpath
  exists <- FilePath -> IO Bool
doesFileExist FilePath
ipath
  unless exists $
    dieWithException verbosity $
      ErrorParsingFileDoesntExist upath
  bs <- BS.readFile ipath
  parseString parser verbosity upath bs

parseString
  :: (BS.ByteString -> ParseResult CabalFileSource a)
  -- ^ File contents to final value parser
  -> Verbosity
  -- ^ Verbosity level
  -> String
  -- ^ File name
  -> BS.ByteString
  -> IO a
parseString :: forall a.
(ByteString -> ParseResult CabalFileSource a)
-> Verbosity -> FilePath -> ByteString -> IO a
parseString ByteString -> ParseResult CabalFileSource a
parser Verbosity
verbosity FilePath
name ByteString
bs = do
  let ([PWarningWithSource CabalFileSource]
warnings, Either
  (Maybe Version, NonEmpty (PErrorWithSource CabalFileSource)) a
result) = ParseResult CabalFileSource a
-> ([PWarningWithSource CabalFileSource],
    Either
      (Maybe Version, NonEmpty (PErrorWithSource CabalFileSource)) a)
forall src a.
ParseResult src a
-> ([PWarningWithSource src],
    Either (Maybe Version, NonEmpty (PErrorWithSource src)) a)
runParseResult (ParseResult CabalFileSource a
 -> ([PWarningWithSource CabalFileSource],
     Either
       (Maybe Version, NonEmpty (PErrorWithSource CabalFileSource)) a))
-> ParseResult CabalFileSource a
-> ([PWarningWithSource CabalFileSource],
    Either
      (Maybe Version, NonEmpty (PErrorWithSource CabalFileSource)) a)
forall a b. (a -> b) -> a -> b
$ CabalFileSource
-> ParseResult CabalFileSource a -> ParseResult CabalFileSource a
forall src a. src -> ParseResult src a -> ParseResult src a
withSource ((FilePath, ByteString) -> CabalFileSource
PCabalFile (FilePath
name, ByteString
bs)) (ByteString -> ParseResult CabalFileSource a
parser ByteString
bs)
  (PWarningWithSource CabalFileSource -> IO ())
-> [PWarningWithSource CabalFileSource] -> IO ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ (Verbosity -> FilePath -> IO ()
warn Verbosity
verbosity (FilePath -> IO ())
-> (PWarningWithSource CabalFileSource -> FilePath)
-> PWarningWithSource CabalFileSource
-> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PWarningWithSource FilePath -> FilePath
showPWarningWithSource (PWarningWithSource FilePath -> FilePath)
-> (PWarningWithSource CabalFileSource
    -> PWarningWithSource FilePath)
-> PWarningWithSource CabalFileSource
-> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (CabalFileSource -> FilePath)
-> PWarningWithSource CabalFileSource
-> PWarningWithSource FilePath
forall a b.
(a -> b) -> PWarningWithSource a -> PWarningWithSource b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap CabalFileSource -> FilePath
renderCabalFileSource) (Verbosity
-> [PWarningWithSource CabalFileSource]
-> [PWarningWithSource CabalFileSource]
forall src.
Verbosity -> [PWarningWithSource src] -> [PWarningWithSource src]
flattenDups Verbosity
verbosity [PWarningWithSource CabalFileSource]
warnings)
  case Either
  (Maybe Version, NonEmpty (PErrorWithSource CabalFileSource)) 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 (PErrorWithSource CabalFileSource)
errors) -> do
      (PErrorWithSource CabalFileSource -> IO ())
-> NonEmpty (PErrorWithSource CabalFileSource) -> IO ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ (Verbosity -> FilePath -> IO ()
warn Verbosity
verbosity (FilePath -> IO ())
-> (PErrorWithSource CabalFileSource -> FilePath)
-> PErrorWithSource CabalFileSource
-> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PErrorWithSource FilePath -> FilePath
showPErrorWithSource (PErrorWithSource FilePath -> FilePath)
-> (PErrorWithSource CabalFileSource -> PErrorWithSource FilePath)
-> PErrorWithSource CabalFileSource
-> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (CabalFileSource -> FilePath)
-> PErrorWithSource CabalFileSource -> PErrorWithSource FilePath
forall a b. (a -> b) -> PErrorWithSource a -> PErrorWithSource b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap CabalFileSource -> FilePath
renderCabalFileSource) NonEmpty (PErrorWithSource CabalFileSource)
errors
      Verbosity -> CabalException -> IO a
forall a1 a.
(HasCallStack, Exception (VerboseException a1)) =>
Verbosity -> a1 -> IO a
dieWithException Verbosity
verbosity (CabalException -> IO a) -> CabalException -> IO a
forall a b. (a -> b) -> a -> b
$ FilePath -> CabalException
FailedParsing FilePath
name

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

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

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