{-# Language PatternGuards, CPP #-}

module CabalCargs.Spec
   ( Spec(..)
   , fromCmdArgs
   ) where

import Distribution.PackageDescription (GenericPackageDescription)
import Distribution.PackageDescription.Parsec (parseGenericPackageDescription, runParseResult)
import Distribution.Parsec.Warning (PWarning)
import qualified Distribution.System as Sys
import CabalCargs.Args (Args)
import qualified CabalCargs.Args as A
import qualified CabalCargs.Fields as F
import qualified CabalLenses as CL
import Control.Monad.Trans.Except (ExceptT, throwE, runExceptT)
import Control.Monad.IO.Class
import Control.Lens
import System.Directory (getCurrentDirectory)
import qualified Filesystem.Path.CurrentOS as FP
import Filesystem.Path.CurrentOS ((</>))
import qualified Filesystem as FS
import Data.List ((\\))
import qualified Data.List as L
import Data.Maybe (isJust)
import qualified Data.ByteString as BS

#if __GLASGOW_HASKELL__ < 710
import Control.Applicative ((<$>))
#endif


-- | Specifies which compiler args from which sections should be collected.
data Spec = Spec
   { Spec -> [Section]
sections      :: [CL.Section]              -- ^ the sections used for collecting the compiler args
   , Spec -> Fields
fields        :: F.Fields                  -- ^ for these fields compiler args are collected
   , Spec -> CondVars
condVars      :: CL.CondVars               -- ^ used for the evaluation of the conditional fields in the cabal file
   , Spec -> GenericPackageDescription
pkgDescrp     :: GenericPackageDescription -- ^ the package description of the read in cabal file
   , Spec -> Error
cabalFile     :: FilePath                  -- ^ the cabal file read from
   , Spec -> Maybe Error
distDir       :: Maybe FilePath            -- ^ the dist directory of the cabal build
   , Spec -> Maybe Error
packageDB     :: Maybe FilePath            -- ^ the directory of package database of the cabal sandbox
   , Spec -> Bool
relativePaths :: Bool                      -- ^ if all returned paths are relative to the directory of the cabal file, otherwise all paths are absolute
   }


type Error = String

io :: MonadIO m => IO a -> m a
io :: forall (m :: * -> *) a. MonadIO m => IO a -> m a
io = IO a -> m a
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO


-- | Create a 'Spec' by the command line arguments given to 'cabal-cargs'.
--
--   Depending on the command line arguments 'fromCmdArgs' might behave like
--   'fromCabalFile', if only a cabal file was given, like 'fromSourceFile',
--   if only a source file was given or like a mix of both, if a cabal file
--   and a source file have been given.
fromCmdArgs :: Args -> IO (Either Error Spec)
fromCmdArgs :: Args -> IO (Either Error Spec)
fromCmdArgs Args
args
   | Just Error
cabalFile <- Args -> Maybe Error
A.cabalFile Args
args = ExceptT Error IO Spec -> IO (Either Error Spec)
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT (ExceptT Error IO Spec -> IO (Either Error Spec))
-> ExceptT Error IO Spec -> IO (Either Error Spec)
forall a b. (a -> b) -> a -> b
$ do
      Spec
spec        <- Error -> ExceptT Error IO Spec
fromCabalFile Error
cabalFile
      [Section]
srcSections <- IO [Section] -> ExceptT Error IO [Section]
forall (m :: * -> *) a. MonadIO m => IO a -> m a
io (IO [Section] -> ExceptT Error IO [Section])
-> IO [Section] -> ExceptT Error IO [Section]
forall a b. (a -> b) -> a -> b
$ case Args -> Maybe Error
A.sourceFile Args
args of
                               Just Error
srcFile -> Error -> Error -> GenericPackageDescription -> IO [Section]
findSections Error
srcFile Error
cabalFile (Spec -> GenericPackageDescription
pkgDescrp Spec
spec)
                               Maybe Error
_            -> [Section] -> IO [Section]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return []

      Spec -> ExceptT Error IO Spec
forall a. a -> ExceptT Error IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Spec -> ExceptT Error IO Spec) -> Spec -> ExceptT Error IO Spec
forall a b. (a -> b) -> a -> b
$ Spec -> Spec
applyCondVars (Spec -> Spec) -> Spec -> Spec
forall a b. (a -> b) -> a -> b
$ Spec
spec { sections      = combineSections (args, pkgDescrp spec) srcSections
                                    , fields        = fields_ args
                                    , relativePaths = A.relative args
                                    }

   | Just Error
sourceFile <- Args -> Maybe Error
A.sourceFile Args
args = ExceptT Error IO Spec -> IO (Either Error Spec)
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT (ExceptT Error IO Spec -> IO (Either Error Spec))
-> ExceptT Error IO Spec -> IO (Either Error Spec)
forall a b. (a -> b) -> a -> b
$ do
      Spec
spec <- Error -> ExceptT Error IO Spec
fromSourceFile Error
sourceFile
      Spec -> ExceptT Error IO Spec
forall a. a -> ExceptT Error IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Spec -> ExceptT Error IO Spec) -> Spec -> ExceptT Error IO Spec
forall a b. (a -> b) -> a -> b
$ Spec -> Spec
applyCondVars (Spec -> Spec) -> Spec -> Spec
forall a b. (a -> b) -> a -> b
$ Spec
spec { sections      = combineSections (args, pkgDescrp spec) (sections spec)
                                    , fields        = fields_ args
                                    , relativePaths = A.relative args
                                    }

   | Bool
otherwise = ExceptT Error IO Spec -> IO (Either Error Spec)
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT (ExceptT Error IO Spec -> IO (Either Error Spec))
-> ExceptT Error IO Spec -> IO (Either Error Spec)
forall a b. (a -> b) -> a -> b
$ do
      Error
curDir    <- IO Error -> ExceptT Error IO Error
forall (m :: * -> *) a. MonadIO m => IO a -> m a
io IO Error
getCurrentDirectory
      Error
cabalFile <- Error -> ExceptT Error IO Error
CL.findCabalFile Error
curDir
      Spec
spec      <- Error -> ExceptT Error IO Spec
fromCabalFile Error
cabalFile
      Spec -> ExceptT Error IO Spec
forall a. a -> ExceptT Error IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Spec -> ExceptT Error IO Spec) -> Spec -> ExceptT Error IO Spec
forall a b. (a -> b) -> a -> b
$ Spec -> Spec
applyCondVars (Spec -> Spec) -> Spec -> Spec
forall a b. (a -> b) -> a -> b
$ Spec
spec { sections      = sections_ args (pkgDescrp spec)
                                    , fields        = fields_ args
                                    , relativePaths = A.relative args
                                    }

   where
      applyCondVars :: Spec -> Spec
applyCondVars = Args -> Spec -> Spec
applyFlags Args
args (Spec -> Spec) -> (Spec -> Spec) -> Spec -> Spec
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Args -> Spec -> Spec
applyOS Args
args (Spec -> Spec) -> (Spec -> Spec) -> Spec -> Spec
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Args -> Spec -> Spec
applyArch Args
args



-- | Create a 'Spec' from the given cabal file.
--
--   If a cabal sandbox is present in the directory of the cabal file, then
--   the path to its package database is also returned.
fromCabalFile :: FilePath -> ExceptT Error IO Spec
fromCabalFile :: Error -> ExceptT Error IO Spec
fromCabalFile Error
file = do
   GenericPackageDescription
pkgDescrp <- Error -> ExceptT Error IO GenericPackageDescription
packageDescription Error
file
   Maybe Error
pkgDB     <- Error -> ExceptT Error IO (Maybe Error)
CL.findPackageDB Error
file
   Maybe Error
distDir   <- IO (Maybe Error) -> ExceptT Error IO (Maybe Error)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
io (IO (Maybe Error) -> ExceptT Error IO (Maybe Error))
-> IO (Maybe Error) -> ExceptT Error IO (Maybe Error)
forall a b. (a -> b) -> a -> b
$ Error -> IO (Maybe Error)
CL.findDistDir Error
file
   Error
absFile   <- FilePath -> Error
FP.encodeString (FilePath -> Error)
-> ExceptT Error IO FilePath -> ExceptT Error IO Error
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO FilePath -> ExceptT Error IO FilePath
forall (m :: * -> *) a. MonadIO m => IO a -> m a
io (Error -> IO FilePath
absoluteFile Error
file)
   Spec -> ExceptT Error IO Spec
forall a. a -> ExceptT Error IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Spec -> ExceptT Error IO Spec) -> Spec -> ExceptT Error IO Spec
forall a b. (a -> b) -> a -> b
$ Spec
      { sections :: [Section]
sections      = GenericPackageDescription -> [Section]
CL.allSections GenericPackageDescription
pkgDescrp
      , fields :: Fields
fields        = Fields
F.allFields
      , condVars :: CondVars
condVars      = GenericPackageDescription -> CondVars
CL.fromDefaults GenericPackageDescription
pkgDescrp
      , pkgDescrp :: GenericPackageDescription
pkgDescrp     = GenericPackageDescription
pkgDescrp
      , cabalFile :: Error
cabalFile     = Error
absFile
      , distDir :: Maybe Error
distDir       = Maybe Error
distDir
      , packageDB :: Maybe Error
packageDB     = Maybe Error
pkgDB
      , relativePaths :: Bool
relativePaths = Bool
False
      }


-- | Create a 'Spec' from the given source file.
--
--   Starting at the directory of the source file a cabal file is searched
--   upwards the directory tree.
--
--   The found cabal file is searched for a fitting section for the source file.
--   If no fitting section could be found, then all sections are used.
--
--   If a cabal sandbox is present in the directory of the cabal file, then
--   the path to its package database is also returned.
fromSourceFile :: FilePath -> ExceptT Error IO Spec
fromSourceFile :: Error -> ExceptT Error IO Spec
fromSourceFile Error
file = do
   Error
cabalFile   <- Error -> ExceptT Error IO Error
CL.findCabalFile Error
file
   Maybe Error
pkgDB       <- Error -> ExceptT Error IO (Maybe Error)
CL.findPackageDB Error
cabalFile
   Maybe Error
distDir     <- IO (Maybe Error) -> ExceptT Error IO (Maybe Error)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
io (IO (Maybe Error) -> ExceptT Error IO (Maybe Error))
-> IO (Maybe Error) -> ExceptT Error IO (Maybe Error)
forall a b. (a -> b) -> a -> b
$ Error -> IO (Maybe Error)
CL.findDistDir Error
cabalFile
   GenericPackageDescription
pkgDescrp   <- Error -> ExceptT Error IO GenericPackageDescription
packageDescription Error
cabalFile
   [Section]
srcSections <- IO [Section] -> ExceptT Error IO [Section]
forall (m :: * -> *) a. MonadIO m => IO a -> m a
io (IO [Section] -> ExceptT Error IO [Section])
-> IO [Section] -> ExceptT Error IO [Section]
forall a b. (a -> b) -> a -> b
$ Error -> Error -> GenericPackageDescription -> IO [Section]
findSections Error
file Error
cabalFile GenericPackageDescription
pkgDescrp
   Spec -> ExceptT Error IO Spec
forall a. a -> ExceptT Error IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Spec -> ExceptT Error IO Spec) -> Spec -> ExceptT Error IO Spec
forall a b. (a -> b) -> a -> b
$ Spec
      { sections :: [Section]
sections      = [Section]
srcSections
      , fields :: Fields
fields        = Fields
F.allFields
      , condVars :: CondVars
condVars      = GenericPackageDescription -> CondVars
CL.fromDefaults GenericPackageDescription
pkgDescrp
      , pkgDescrp :: GenericPackageDescription
pkgDescrp     = GenericPackageDescription
pkgDescrp
      , cabalFile :: Error
cabalFile     = Error
cabalFile
      , distDir :: Maybe Error
distDir       = Maybe Error
distDir
      , packageDB :: Maybe Error
packageDB     = Maybe Error
pkgDB
      , relativePaths :: Bool
relativePaths = Bool
False
      }


applyFlags :: Args -> Spec -> Spec
applyFlags :: Args -> Spec -> Spec
applyFlags Args
args Spec
spec =
   Spec
spec { condVars = disableFlags . enableFlags $ condVars spec }
   where
      disableFlags :: CondVars -> CondVars
disableFlags CondVars
condVars = (Error -> CondVars -> CondVars) -> CondVars -> [Error] -> CondVars
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Error -> CondVars -> CondVars
CL.disableFlag CondVars
condVars (Args -> [Error]
A.disable Args
args)
      enableFlags :: CondVars -> CondVars
enableFlags  CondVars
condVars = (Error -> CondVars -> CondVars) -> CondVars -> [Error] -> CondVars
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Error -> CondVars -> CondVars
CL.enableFlag CondVars
condVars (Args -> [Error]
A.enable Args
args)


applyOS :: Args -> Spec -> Spec
applyOS :: Args -> Spec -> Spec
applyOS (A.Args { os :: Args -> Maybe Error
A.os = Maybe Error
os }) Spec
spec
   | Just Error
str    <- Maybe Error
os
   , [(OS
name, Error
_)] <- ReadS OS
forall a. Read a => ReadS a
reads Error
str :: [(Sys.OS, String)]
   = OS -> Spec
setOS OS
name

   | Just Error
str    <- Maybe Error
os
   = OS -> Spec
setOS (OS -> Spec) -> OS -> Spec
forall a b. (a -> b) -> a -> b
$ Error -> OS
Sys.OtherOS Error
str

   | Bool
otherwise
   = Spec
spec

   where
      setOS :: OS -> Spec
setOS OS
name = Spec
spec { condVars = (condVars spec) { CL.os = name } }


applyArch :: Args -> Spec -> Spec
applyArch :: Args -> Spec -> Spec
applyArch (A.Args { arch :: Args -> Maybe Error
A.arch = Maybe Error
arch }) Spec
spec
   | Just Error
str    <- Maybe Error
arch
   , [(Arch
name, Error
_)] <- ReadS Arch
forall a. Read a => ReadS a
reads Error
str :: [(Sys.Arch, String)]
   = Arch -> Spec
setArch Arch
name

   | Just Error
str    <- Maybe Error
arch
   = Arch -> Spec
setArch (Arch -> Spec) -> Arch -> Spec
forall a b. (a -> b) -> a -> b
$ Error -> Arch
Sys.OtherArch Error
str

   | Bool
otherwise
   = Spec
spec

   where
      setArch :: Arch -> Spec
setArch Arch
name = Spec
spec { condVars = (condVars spec) { CL.arch = name } }


packageDescription :: FilePath -> ExceptT Error IO GenericPackageDescription
packageDescription :: Error -> ExceptT Error IO GenericPackageDescription
packageDescription Error
file = do
   ByteString
contents <- IO ByteString -> ExceptT Error IO ByteString
forall (m :: * -> *) a. MonadIO m => IO a -> m a
io (IO ByteString -> ExceptT Error IO ByteString)
-> IO ByteString -> ExceptT Error IO ByteString
forall a b. (a -> b) -> a -> b
$ Error -> IO ByteString
BS.readFile Error
file
   let ([PWarning]
warnings, Either (Maybe Version, NonEmpty PError) GenericPackageDescription
result) = ParseResult GenericPackageDescription
-> ([PWarning],
    Either (Maybe Version, NonEmpty PError) GenericPackageDescription)
forall a.
ParseResult a
-> ([PWarning], Either (Maybe Version, NonEmpty PError) a)
runParseResult (ParseResult GenericPackageDescription
 -> ([PWarning],
     Either (Maybe Version, NonEmpty PError) GenericPackageDescription))
-> ParseResult GenericPackageDescription
-> ([PWarning],
    Either (Maybe Version, NonEmpty PError) GenericPackageDescription)
forall a b. (a -> b) -> a -> b
$ ByteString -> ParseResult GenericPackageDescription
parseGenericPackageDescription ByteString
contents
   IO () -> ExceptT Error IO ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
io (IO () -> ExceptT Error IO ()) -> IO () -> ExceptT Error IO ()
forall a b. (a -> b) -> a -> b
$ [PWarning] -> IO ()
showWarnings [PWarning]
warnings
   case Either (Maybe Version, NonEmpty PError) GenericPackageDescription
result of
        Left (Maybe Version
_, NonEmpty PError
errors) -> Error -> ExceptT Error IO GenericPackageDescription
forall (m :: * -> *) e a. Monad m => e -> ExceptT e m a
throwE (Error -> ExceptT Error IO GenericPackageDescription)
-> Error -> ExceptT Error IO GenericPackageDescription
forall a b. (a -> b) -> a -> b
$ NonEmpty PError -> Error
forall a. Show a => a -> Error
show NonEmpty PError
errors
        Right GenericPackageDescription
pkgDescrp  -> GenericPackageDescription
-> ExceptT Error IO GenericPackageDescription
forall a. a -> ExceptT Error IO a
forall (m :: * -> *) a. Monad m => a -> m a
return GenericPackageDescription
pkgDescrp

   where
      showWarnings :: [PWarning] -> IO ()
      showWarnings :: [PWarning] -> IO ()
showWarnings [] = () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
      showWarnings [PWarning]
ws = Error -> IO ()
putStrLn (Error -> IO ()) -> Error -> IO ()
forall a b. (a -> b) -> a -> b
$ Error
"cabal-cargs: " Error -> Error -> Error
forall a. [a] -> [a] -> [a]
++ (Error -> [Error] -> Error
forall a. [a] -> [[a]] -> [a]
L.intercalate Error
", " ([Error] -> Error) -> [Error] -> Error
forall a b. (a -> b) -> a -> b
$ (PWarning -> Error) -> [PWarning] -> [Error]
forall a b. (a -> b) -> [a] -> [b]
map PWarning -> Error
forall a. Show a => a -> Error
show [PWarning]
ws)


-- | Find matching sections in the package description for the given source file.
--   This is done by checking if the source file is contained in the directory
--   or a sub directory of the directories listed in the 'hs-source-dirs' field
--   of the section.
findSections :: FilePath -> FilePath -> GenericPackageDescription -> IO [CL.Section]
findSections :: Error -> Error -> GenericPackageDescription -> IO [Section]
findSections Error
srcFile Error
cabalFile GenericPackageDescription
pkgDescrp = do
   FilePath
absSrcFile <- Error -> IO FilePath
absoluteFile Error
srcFile
   FilePath
cabalDir   <- Error -> IO FilePath
absoluteDirectory Error
cabalFile
   let sections :: [(Section, [FilePath])]
sections = ((Section, [FilePath]) -> Bool)
-> [(Section, [FilePath])] -> [(Section, [FilePath])]
forall a. (a -> Bool) -> [a] -> [a]
filter (FilePath -> FilePath -> (Section, [FilePath]) -> Bool
forall {a}. FilePath -> FilePath -> (a, [FilePath]) -> Bool
fittingSection FilePath
absSrcFile FilePath
cabalDir) (GenericPackageDescription -> [(Section, [FilePath])]
allHsSourceDirs GenericPackageDescription
pkgDescrp)
   [Section] -> IO [Section]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ([Section] -> IO [Section]) -> [Section] -> IO [Section]
forall a b. (a -> b) -> a -> b
$ ((Section, [FilePath]) -> Section)
-> [(Section, [FilePath])] -> [Section]
forall a b. (a -> b) -> [a] -> [b]
map (Section, [FilePath]) -> Section
forall a b. (a, b) -> a
fst [(Section, [FilePath])]
sections

   where
      fittingSection :: FilePath -> FilePath -> (a, [FilePath]) -> Bool
fittingSection FilePath
srcFile FilePath
cabalDir (a
_, []) =
         Maybe FilePath -> Bool
forall a. Maybe a -> Bool
isJust (Maybe FilePath -> Bool) -> Maybe FilePath -> Bool
forall a b. (a -> b) -> a -> b
$ FilePath -> FilePath -> Maybe FilePath
FP.stripPrefix (FilePath
cabalDir FilePath -> FilePath -> FilePath
</> FilePath
FP.empty) FilePath
srcFile

      fittingSection FilePath
srcFile FilePath
cabalDir (a
_, [FilePath]
srcDirs) = (FilePath -> Bool) -> [FilePath] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any FilePath -> Bool
samePrefix [FilePath]
srcDirs
         where samePrefix :: FilePath -> Bool
samePrefix FilePath
srcDir = Maybe FilePath -> Bool
forall a. Maybe a -> Bool
isJust (Maybe FilePath -> Bool) -> Maybe FilePath -> Bool
forall a b. (a -> b) -> a -> b
$ FilePath -> FilePath -> Maybe FilePath
FP.stripPrefix (FilePath
cabalDir FilePath -> FilePath -> FilePath
</> FilePath
srcDir FilePath -> FilePath -> FilePath
</> FilePath
FP.empty) FilePath
srcFile


type HsSourceDirs = [FP.FilePath]
-- | Returns the hs-source-dirs of all sections present in the given package description.
allHsSourceDirs :: GenericPackageDescription -> [(CL.Section, HsSourceDirs)]
allHsSourceDirs :: GenericPackageDescription -> [(Section, [FilePath])]
allHsSourceDirs GenericPackageDescription
pkgDescrp = [Section] -> [[FilePath]] -> [(Section, [FilePath])]
forall a b. [a] -> [b] -> [(a, b)]
zip [Section]
sections [[FilePath]]
hsSourceDirs
   where
      sections :: [Section]
sections     = GenericPackageDescription -> [Section]
CL.allSections GenericPackageDescription
pkgDescrp
      hsSourceDirs :: [[FilePath]]
hsSourceDirs = (Section -> [FilePath]) -> [Section] -> [[FilePath]]
forall a b. (a -> b) -> [a] -> [b]
map (\Section
section -> [Error] -> [FilePath]
toFPs ([Error] -> [FilePath]) -> [Error] -> [FilePath]
forall a b. (a -> b) -> a -> b
$ GenericPackageDescription
pkgDescrp GenericPackageDescription
-> Getting [Error] GenericPackageDescription [Error] -> [Error]
forall s a. s -> Getting a s a -> a
^. CondVars
-> Section -> Traversal' GenericPackageDescription BuildInfo
CL.buildInfoIf CondVars
condVars Section
section ((BuildInfo -> Const [Error] BuildInfo)
 -> GenericPackageDescription
 -> Const [Error] GenericPackageDescription)
-> (([Error] -> Const [Error] [Error])
    -> BuildInfo -> Const [Error] BuildInfo)
-> Getting [Error] GenericPackageDescription [Error]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([SymbolicPath Pkg ('Dir Source)]
 -> Const [Error] [SymbolicPath Pkg ('Dir Source)])
-> BuildInfo -> Const [Error] BuildInfo
Lens' BuildInfo [SymbolicPath Pkg ('Dir Source)]
CL.hsSourceDirsL (([SymbolicPath Pkg ('Dir Source)]
  -> Const [Error] [SymbolicPath Pkg ('Dir Source)])
 -> BuildInfo -> Const [Error] BuildInfo)
-> (([Error] -> Const [Error] [Error])
    -> [SymbolicPath Pkg ('Dir Source)]
    -> Const [Error] [SymbolicPath Pkg ('Dir Source)])
-> ([Error] -> Const [Error] [Error])
-> BuildInfo
-> Const [Error] BuildInfo
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Error] -> Const [Error] [Error])
-> [SymbolicPath Pkg ('Dir Source)]
-> Const [Error] [SymbolicPath Pkg ('Dir Source)]
forall from (to :: FileOrDir) (p :: * -> * -> *) (f :: * -> *).
(Profunctor p, Functor f) =>
p [Error] (f [Error])
-> p [SymbolicPath from to] (f [SymbolicPath from to])
CL.symPathsToFilePaths) [Section]
sections
         where
            toFPs :: [Error] -> [FilePath]
toFPs    = (Error -> FilePath) -> [Error] -> [FilePath]
forall a b. (a -> b) -> [a] -> [b]
map Error -> FilePath
FP.decodeString
            condVars :: CondVars
condVars = GenericPackageDescription -> CondVars
CL.fromDefaults GenericPackageDescription
pkgDescrp


absoluteDirectory :: FilePath -> IO FP.FilePath
absoluteDirectory :: Error -> IO FilePath
absoluteDirectory Error
file = do
   FilePath
absFile <- Error -> IO FilePath
absoluteFile Error
file
   Bool
isDir   <- FilePath -> IO Bool
FS.isDirectory FilePath
absFile
   if Bool
isDir
      then FilePath -> IO FilePath
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return FilePath
absFile
      else FilePath -> IO FilePath
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (FilePath -> IO FilePath)
-> (FilePath -> FilePath) -> FilePath -> IO FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> FilePath
FP.directory (FilePath -> IO FilePath) -> FilePath -> IO FilePath
forall a b. (a -> b) -> a -> b
$ FilePath
absFile


absoluteFile :: FilePath -> IO FP.FilePath
absoluteFile :: Error -> IO FilePath
absoluteFile = FilePath -> IO FilePath
FS.canonicalizePath (FilePath -> IO FilePath)
-> (Error -> FilePath) -> Error -> IO FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Error -> FilePath
FP.decodeString


combineSections :: (Args, GenericPackageDescription) -> [CL.Section] -> [CL.Section]
combineSections :: (Args, GenericPackageDescription) -> [Section] -> [Section]
combineSections (Args
args, GenericPackageDescription
pkgDescrp) [Section]
sections
   | Args -> Bool
A.allSections Args
args
   = GenericPackageDescription -> [Section]
CL.allSections GenericPackageDescription
pkgDescrp

   | [] <- Args -> [Section]
explicitSections Args
args
   , [Section] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Section]
sections
   = GenericPackageDescription -> [Section]
CL.allSections GenericPackageDescription
pkgDescrp

   | Bool
otherwise
   = [Section] -> [Section]
forall a. Eq a => [a] -> [a]
L.nub ([Section] -> [Section]) -> [Section] -> [Section]
forall a b. (a -> b) -> a -> b
$ Args -> [Section]
explicitSections Args
args [Section] -> [Section] -> [Section]
forall a. [a] -> [a] -> [a]
++ [Section]
sections


-- | Convert the command line arguments into 'Fields'.
fields_ :: Args -> F.Fields
fields_ :: Args -> Fields
fields_ Args
args
   | fs :: Fields
fs@(Field
_:Fields
_) <- Args -> Fields
A.only Args
args
   = Fields
fs

   | fs :: Fields
fs@(Field
_:Fields
_) <- Args -> Fields
A.ignore Args
args
   = Fields
F.allFields Fields -> Fields -> Fields
forall a. Eq a => [a] -> [a] -> [a]
\\ Fields
fs

   | Bool
otherwise
   = Fields
F.allFields


-- | Convert the command line arguments into 'Sections'.
sections_ :: Args -> GenericPackageDescription -> [CL.Section]
sections_ :: Args -> GenericPackageDescription -> [Section]
sections_ Args
args GenericPackageDescription
pkgDescrp
   | Args -> Bool
A.allSections Args
args
   = GenericPackageDescription -> [Section]
CL.allSections GenericPackageDescription
pkgDescrp

   | ss :: [Section]
ss@(Section
_:[Section]
_) <- Args -> [Section]
explicitSections Args
args
   = [Section]
ss

   | Bool
otherwise
   = GenericPackageDescription -> [Section]
CL.allSections GenericPackageDescription
pkgDescrp


explicitSections :: Args -> [CL.Section]
explicitSections :: Args -> [Section]
explicitSections Args
args =
   [[Section]] -> [Section]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [ [Section
CL.Library | Args -> Bool
A.library Args
args]
          , (Error -> Section) -> [Error] -> [Section]
forall a b. (a -> b) -> [a] -> [b]
map Error -> Section
CL.Executable (Args -> [Error]
A.executable Args
args)
          , (Error -> Section) -> [Error] -> [Section]
forall a b. (a -> b) -> [a] -> [b]
map Error -> Section
CL.TestSuite (Args -> [Error]
A.testSuite Args
args)
          , (Error -> Section) -> [Error] -> [Section]
forall a b. (a -> b) -> [a] -> [b]
map Error -> Section
CL.Benchmark (Args -> [Error]
A.benchmark Args
args)
          ]