{-# LANGUAGE OverloadedStrings, CPP #-}

module Hhp.CabalApi (
    getCompilerOptions
  , parseCabalFile
  , cabalAllBuildInfo
  , cabalDependPackages
  , cabalSourceDirs
  , cabalAllTargets
  ) where

import Distribution.Compiler (unknownCompilerInfo, AbiTag(NoAbiTag))
import Distribution.ModuleName (ModuleName,toFilePath)
import Distribution.Package (Dependency(Dependency))
import qualified Distribution.Package as C
import Distribution.PackageDescription (PackageDescription, BuildInfo, TestSuite, TestSuiteInterface(..), Executable)
import qualified Distribution.PackageDescription as P
import Distribution.Simple.Compiler (CompilerId(..), CompilerFlavor(..))
import Distribution.Simple.Program (ghcProgram)
import Distribution.Simple.Program.Types (programName, programFindVersion)
import Distribution.System (buildPlatform)
import Distribution.Text (display)
import Distribution.Verbosity (silent)
import Distribution.Version (Version)

#if MIN_VERSION_Cabal(3,2,0)
import Distribution.PackageDescription.Configuration (finalizePD)
import Distribution.PackageDescription.Parsec (readGenericPackageDescription)
import Distribution.Types.ComponentRequestedSpec (defaultComponentRequestedSpec)
import Distribution.Types.Flag (mkFlagAssignment, mkFlagName)
import Distribution.Types.PackageName (unPackageName)
#elif MIN_VERSION_Cabal(2,2,0)
import Distribution.PackageDescription.Configuration (finalizePD)
import Distribution.PackageDescription.Parsec (readGenericPackageDescription)
import Distribution.Types.ComponentRequestedSpec (defaultComponentRequestedSpec)
import Distribution.Types.GenericPackageDescription (mkFlagAssignment, mkFlagName)
import Distribution.Types.PackageName (unPackageName)
#elif MIN_VERSION_Cabal(2,0,0)
import Distribution.PackageDescription.Configuration (finalizePD)
import Distribution.PackageDescription.Parse (readPackageDescription)
import Distribution.Types.ComponentRequestedSpec (defaultComponentRequestedSpec)
import Distribution.Types.GenericPackageDescription (mkFlagName)
import Distribution.Types.PackageName (unPackageName)
#else
import Distribution.Package (PackageName(PackageName))
import Distribution.PackageDescription (FlagName (FlagName))
import Distribution.PackageDescription.Configuration (finalizePackageDescription)
import Distribution.PackageDescription.Parse (readPackageDescription)
#endif

import Control.Exception (throwIO)
import Control.Monad (filterM)
import CoreMonad (liftIO)
import Data.Maybe (maybeToList, mapMaybe)
import Data.Set (fromList, toList)
import System.Directory (doesFileExist)
import System.Environment (lookupEnv)
import System.FilePath (dropExtension, takeFileName, (</>))

import Hhp.Types
import Hhp.GhcPkg

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

-- | Getting necessary 'CompilerOptions' from three information sources.
getCompilerOptions :: [GHCOption]
                   -> Cradle
                   -> PackageDescription
                   -> IO CompilerOptions
getCompilerOptions :: [GHCOption] -> Cradle -> PackageDescription -> IO CompilerOptions
getCompilerOptions [GHCOption]
ghcopts Cradle
cradle PackageDescription
pkgDesc = do
    [GHCOption]
gopts <- [GHCOption] -> Cradle -> GHCOption -> BuildInfo -> IO [GHCOption]
getGHCOptions [GHCOption]
ghcopts Cradle
cradle GHCOption
rdir (BuildInfo -> IO [GHCOption]) -> BuildInfo -> IO [GHCOption]
forall a b. (a -> b) -> a -> b
$ [BuildInfo] -> BuildInfo
forall a. [a] -> a
head [BuildInfo]
buildInfos
    [Package]
dbPkgs <- [GhcPkgDb] -> IO [Package]
ghcPkgListEx (Cradle -> [GhcPkgDb]
cradlePkgDbStack Cradle
cradle)
    CompilerOptions -> IO CompilerOptions
forall (m :: * -> *) a. Monad m => a -> m a
return (CompilerOptions -> IO CompilerOptions)
-> CompilerOptions -> IO CompilerOptions
forall a b. (a -> b) -> a -> b
$ [GHCOption] -> [GHCOption] -> [Package] -> CompilerOptions
CompilerOptions [GHCOption]
gopts [GHCOption]
idirs ([Package] -> [Package]
depPkgs [Package]
dbPkgs)
  where
    wdir :: GHCOption
wdir       = Cradle -> GHCOption
cradleCurrentDir Cradle
cradle
    rdir :: GHCOption
rdir       = Cradle -> GHCOption
cradleRootDir    Cradle
cradle
    Just GHCOption
cfile = Cradle -> Maybe GHCOption
cradleCabalFile  Cradle
cradle
    thisPkg :: GHCOption
thisPkg    = GHCOption -> GHCOption
dropExtension (GHCOption -> GHCOption) -> GHCOption -> GHCOption
forall a b. (a -> b) -> a -> b
$ GHCOption -> GHCOption
takeFileName GHCOption
cfile
    buildInfos :: [BuildInfo]
buildInfos = PackageDescription -> [BuildInfo]
cabalAllBuildInfo PackageDescription
pkgDesc
    idirs :: [GHCOption]
idirs      = GHCOption -> GHCOption -> [GHCOption] -> [GHCOption]
includeDirectories GHCOption
rdir GHCOption
wdir ([GHCOption] -> [GHCOption]) -> [GHCOption] -> [GHCOption]
forall a b. (a -> b) -> a -> b
$ [BuildInfo] -> [GHCOption]
cabalSourceDirs [BuildInfo]
buildInfos
    depPkgs :: [Package] -> [Package]
depPkgs [Package]
ps = [Package] -> [GHCOption] -> [Package]
attachPackageIds [Package]
ps
                   ([GHCOption] -> [Package]) -> [GHCOption] -> [Package]
forall a b. (a -> b) -> a -> b
$ [GHCOption] -> [GHCOption] -> [GHCOption]
removeThem ([GHCOption]
problematicPackages [GHCOption] -> [GHCOption] -> [GHCOption]
forall a. [a] -> [a] -> [a]
++ [GHCOption
thisPkg])
                   ([GHCOption] -> [GHCOption]) -> [GHCOption] -> [GHCOption]
forall a b. (a -> b) -> a -> b
$ [BuildInfo] -> [GHCOption]
cabalDependPackages [BuildInfo]
buildInfos

----------------------------------------------------------------
-- Dependent packages

removeThem :: [PackageBaseName] -> [PackageBaseName] -> [PackageBaseName]
removeThem :: [GHCOption] -> [GHCOption] -> [GHCOption]
removeThem [GHCOption]
badpkgs = (GHCOption -> Bool) -> [GHCOption] -> [GHCOption]
forall a. (a -> Bool) -> [a] -> [a]
filter (GHCOption -> [GHCOption] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [GHCOption]
badpkgs)

problematicPackages :: [PackageBaseName]
problematicPackages :: [GHCOption]
problematicPackages = [
    GHCOption
"base-compat" -- providing "Prelude"
  ]

attachPackageIds :: [Package] -> [PackageBaseName] -> [Package]
attachPackageIds :: [Package] -> [GHCOption] -> [Package]
attachPackageIds [Package]
pkgs = (GHCOption -> Maybe Package) -> [GHCOption] -> [Package]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (GHCOption -> [Package] -> Maybe Package
forall a b c. Eq a => a -> [(a, b, c)] -> Maybe (a, b, c)
`lookup3` [Package]
pkgs)

lookup3 :: Eq a => a -> [(a,b,c)] -> Maybe (a,b,c)
lookup3 :: a -> [(a, b, c)] -> Maybe (a, b, c)
lookup3 a
_ [] = Maybe (a, b, c)
forall a. Maybe a
Nothing
lookup3 a
k (t :: (a, b, c)
t@(a
a,b
_,c
_):[(a, b, c)]
ls)
    | a
k a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
a = (a, b, c) -> Maybe (a, b, c)
forall a. a -> Maybe a
Just (a, b, c)
t
    | Bool
otherwise = a -> [(a, b, c)] -> Maybe (a, b, c)
forall a b c. Eq a => a -> [(a, b, c)] -> Maybe (a, b, c)
lookup3 a
k [(a, b, c)]
ls

----------------------------------------------------------------
-- Include directories for modules

cabalBuildDirs :: [FilePath]
cabalBuildDirs :: [GHCOption]
cabalBuildDirs = [GHCOption
"dist/build", GHCOption
"dist/build/autogen"]

includeDirectories :: FilePath -> FilePath -> [FilePath] -> [FilePath]
includeDirectories :: GHCOption -> GHCOption -> [GHCOption] -> [GHCOption]
includeDirectories GHCOption
cdir GHCOption
wdir [GHCOption]
dirs = [GHCOption] -> [GHCOption]
uniqueAndSort ([GHCOption]
extdirs [GHCOption] -> [GHCOption] -> [GHCOption]
forall a. [a] -> [a] -> [a]
++ [GHCOption
cdir,GHCOption
wdir])
  where
    extdirs :: [GHCOption]
extdirs = (GHCOption -> GHCOption) -> [GHCOption] -> [GHCOption]
forall a b. (a -> b) -> [a] -> [b]
map GHCOption -> GHCOption
expand ([GHCOption] -> [GHCOption]) -> [GHCOption] -> [GHCOption]
forall a b. (a -> b) -> a -> b
$ [GHCOption]
dirs [GHCOption] -> [GHCOption] -> [GHCOption]
forall a. [a] -> [a] -> [a]
++ [GHCOption]
cabalBuildDirs
    expand :: GHCOption -> GHCOption
expand GHCOption
"."    = GHCOption
cdir
    expand GHCOption
subdir = GHCOption
cdir GHCOption -> GHCOption -> GHCOption
</> GHCOption
subdir

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

-- | Parsing a cabal file and returns 'PackageDescription'.
--   'IOException' is thrown if parsing fails.
parseCabalFile :: FilePath -> IO PackageDescription
parseCabalFile :: GHCOption -> IO PackageDescription
parseCabalFile GHCOption
file = do
    CompilerId
cid <- IO CompilerId
getGHCId
    let cid' :: CompilerInfo
cid' = CompilerId -> AbiTag -> CompilerInfo
unknownCompilerInfo CompilerId
cid AbiTag
NoAbiTag
#if MIN_VERSION_Cabal(2,2,0)
    GenericPackageDescription
epgd <- Verbosity -> GHCOption -> IO GenericPackageDescription
readGenericPackageDescription Verbosity
silent GHCOption
file
#else
    epgd <- readPackageDescription silent file
#endif
    FlagAssignment
flags <- IO FlagAssignment
getFlags
    case CompilerInfo
-> FlagAssignment
-> GenericPackageDescription
-> Either [Dependency] (PackageDescription, FlagAssignment)
toPkgDesc CompilerInfo
cid' FlagAssignment
flags GenericPackageDescription
epgd of
        Left [Dependency]
deps    -> IOError -> IO PackageDescription
forall e a. Exception e => e -> IO a
throwIO (IOError -> IO PackageDescription)
-> IOError -> IO PackageDescription
forall a b. (a -> b) -> a -> b
$ GHCOption -> IOError
userError (GHCOption -> IOError) -> GHCOption -> IOError
forall a b. (a -> b) -> a -> b
$ [Dependency] -> GHCOption
forall a. Show a => a -> GHCOption
show [Dependency]
deps GHCOption -> GHCOption -> GHCOption
forall a. [a] -> [a] -> [a]
++ GHCOption
" are not installed"
        Right (PackageDescription
pd,FlagAssignment
_) -> if PackageDescription -> Bool
nullPkg PackageDescription
pd
                        then IOError -> IO PackageDescription
forall e a. Exception e => e -> IO a
throwIO (IOError -> IO PackageDescription)
-> IOError -> IO PackageDescription
forall a b. (a -> b) -> a -> b
$ GHCOption -> IOError
userError (GHCOption -> IOError) -> GHCOption -> IOError
forall a b. (a -> b) -> a -> b
$ GHCOption
file GHCOption -> GHCOption -> GHCOption
forall a. [a] -> [a] -> [a]
++ GHCOption
" is broken"
                        else PackageDescription -> IO PackageDescription
forall (m :: * -> *) a. Monad m => a -> m a
return PackageDescription
pd
  where
    envFlags :: IO [(FlagName, Bool)]
envFlags = do
      let parseF :: GHCOption -> [(FlagName, Bool)]
parseF []      = []
          parseF ccs :: GHCOption
ccs@(Char
c:GHCOption
cs)
            | Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'-'   = [(GHCOption -> FlagName
mkFlagName GHCOption
cs, Bool
False)]
            | Bool
otherwise  = [(GHCOption -> FlagName
mkFlagName GHCOption
ccs, Bool
True)]
      [(FlagName, Bool)]
-> (GHCOption -> [(FlagName, Bool)])
-> Maybe GHCOption
-> [(FlagName, Bool)]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] ((GHCOption -> [(FlagName, Bool)])
-> [GHCOption] -> [(FlagName, Bool)]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap GHCOption -> [(FlagName, Bool)]
parseF ([GHCOption] -> [(FlagName, Bool)])
-> (GHCOption -> [GHCOption]) -> GHCOption -> [(FlagName, Bool)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GHCOption -> [GHCOption]
words) (Maybe GHCOption -> [(FlagName, Bool)])
-> IO (Maybe GHCOption) -> IO [(FlagName, Bool)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` GHCOption -> IO (Maybe GHCOption)
lookupEnv GHCOption
"HHP_CABAL_FLAGS"
#if MIN_VERSION_Cabal(2,2,0)
    getFlags :: IO FlagAssignment
getFlags = [(FlagName, Bool)] -> FlagAssignment
mkFlagAssignment ([(FlagName, Bool)] -> FlagAssignment)
-> IO [(FlagName, Bool)] -> IO FlagAssignment
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` IO [(FlagName, Bool)]
envFlags
#else
    getFlags = envFlags
#endif
#if MIN_VERSION_Cabal(2,0,0)
    nullPkg :: PackageDescription -> Bool
nullPkg PackageDescription
pd = PackageName -> GHCOption
unPackageName (PackageIdentifier -> PackageName
C.pkgName (PackageDescription -> PackageIdentifier
P.package PackageDescription
pd)) GHCOption -> GHCOption -> Bool
forall a. Eq a => a -> a -> Bool
== GHCOption
""
    toPkgDesc :: CompilerInfo
-> FlagAssignment
-> GenericPackageDescription
-> Either [Dependency] (PackageDescription, FlagAssignment)
toPkgDesc CompilerInfo
cid FlagAssignment
flags = FlagAssignment
-> ComponentRequestedSpec
-> (Dependency -> Bool)
-> Platform
-> CompilerInfo
-> [Dependency]
-> GenericPackageDescription
-> Either [Dependency] (PackageDescription, FlagAssignment)
finalizePD FlagAssignment
flags ComponentRequestedSpec
defaultComponentRequestedSpec (Bool -> Dependency -> Bool
forall a b. a -> b -> a
const Bool
True) Platform
buildPlatform CompilerInfo
cid []
#else
    mkFlagName = FlagName
    nullPkg pd = name == ""
      where
        PackageName name = C.pkgName (P.package pd)
    toPkgDesc cid flags = finalizePackageDescription flags (const True) buildPlatform cid []
#endif

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

getGHCOptions :: [GHCOption] -> Cradle -> FilePath -> BuildInfo -> IO [GHCOption]
getGHCOptions :: [GHCOption] -> Cradle -> GHCOption -> BuildInfo -> IO [GHCOption]
getGHCOptions [GHCOption]
ghcopts Cradle
cradle GHCOption
rdir BuildInfo
binfo = do
    [GHCOption]
cabalCpp <- GHCOption -> IO [GHCOption]
cabalCppOptions GHCOption
rdir
    let cpps :: [GHCOption]
cpps = (GHCOption -> GHCOption) -> [GHCOption] -> [GHCOption]
forall a b. (a -> b) -> [a] -> [b]
map (GHCOption
"-optP" GHCOption -> GHCOption -> GHCOption
forall a. [a] -> [a] -> [a]
++) ([GHCOption] -> [GHCOption]) -> [GHCOption] -> [GHCOption]
forall a b. (a -> b) -> a -> b
$ BuildInfo -> [GHCOption]
P.cppOptions BuildInfo
binfo [GHCOption] -> [GHCOption] -> [GHCOption]
forall a. [a] -> [a] -> [a]
++ [GHCOption]
cabalCpp
    [GHCOption] -> IO [GHCOption]
forall (m :: * -> *) a. Monad m => a -> m a
return ([GHCOption] -> IO [GHCOption]) -> [GHCOption] -> IO [GHCOption]
forall a b. (a -> b) -> a -> b
$ [GHCOption]
ghcopts [GHCOption] -> [GHCOption] -> [GHCOption]
forall a. [a] -> [a] -> [a]
++ [GHCOption]
pkgDb [GHCOption] -> [GHCOption] -> [GHCOption]
forall a. [a] -> [a] -> [a]
++ [GHCOption]
exts [GHCOption] -> [GHCOption] -> [GHCOption]
forall a. [a] -> [a] -> [a]
++ [GHCOption
lang] [GHCOption] -> [GHCOption] -> [GHCOption]
forall a. [a] -> [a] -> [a]
++ [GHCOption]
libs [GHCOption] -> [GHCOption] -> [GHCOption]
forall a. [a] -> [a] -> [a]
++ [GHCOption]
libDirs [GHCOption] -> [GHCOption] -> [GHCOption]
forall a. [a] -> [a] -> [a]
++ [GHCOption]
cpps
  where
    pkgDb :: [GHCOption]
pkgDb = [GhcPkgDb] -> [GHCOption]
ghcDbStackOpts ([GhcPkgDb] -> [GHCOption]) -> [GhcPkgDb] -> [GHCOption]
forall a b. (a -> b) -> a -> b
$ Cradle -> [GhcPkgDb]
cradlePkgDbStack Cradle
cradle
    lang :: GHCOption
lang = GHCOption -> (Language -> GHCOption) -> Maybe Language -> GHCOption
forall b a. b -> (a -> b) -> Maybe a -> b
maybe GHCOption
"-XHaskell98" ((GHCOption
"-X" GHCOption -> GHCOption -> GHCOption
forall a. [a] -> [a] -> [a]
++) (GHCOption -> GHCOption)
-> (Language -> GHCOption) -> Language -> GHCOption
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Language -> GHCOption
forall a. Pretty a => a -> GHCOption
display) (Maybe Language -> GHCOption) -> Maybe Language -> GHCOption
forall a b. (a -> b) -> a -> b
$ BuildInfo -> Maybe Language
P.defaultLanguage BuildInfo
binfo
    libDirs :: [GHCOption]
libDirs = (GHCOption -> GHCOption) -> [GHCOption] -> [GHCOption]
forall a b. (a -> b) -> [a] -> [b]
map (GHCOption
"-L" GHCOption -> GHCOption -> GHCOption
forall a. [a] -> [a] -> [a]
++) ([GHCOption] -> [GHCOption]) -> [GHCOption] -> [GHCOption]
forall a b. (a -> b) -> a -> b
$ BuildInfo -> [GHCOption]
P.extraLibDirs BuildInfo
binfo
    exts :: [GHCOption]
exts = (Extension -> GHCOption) -> [Extension] -> [GHCOption]
forall a b. (a -> b) -> [a] -> [b]
map ((GHCOption
"-X" GHCOption -> GHCOption -> GHCOption
forall a. [a] -> [a] -> [a]
++) (GHCOption -> GHCOption)
-> (Extension -> GHCOption) -> Extension -> GHCOption
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Extension -> GHCOption
forall a. Pretty a => a -> GHCOption
display) ([Extension] -> [GHCOption]) -> [Extension] -> [GHCOption]
forall a b. (a -> b) -> a -> b
$ BuildInfo -> [Extension]
P.usedExtensions BuildInfo
binfo
    libs :: [GHCOption]
libs = (GHCOption -> GHCOption) -> [GHCOption] -> [GHCOption]
forall a b. (a -> b) -> [a] -> [b]
map (GHCOption
"-l" GHCOption -> GHCOption -> GHCOption
forall a. [a] -> [a] -> [a]
++) ([GHCOption] -> [GHCOption]) -> [GHCOption] -> [GHCOption]
forall a b. (a -> b) -> a -> b
$ BuildInfo -> [GHCOption]
P.extraLibs BuildInfo
binfo

cabalCppOptions :: FilePath -> IO [String]
cabalCppOptions :: GHCOption -> IO [GHCOption]
cabalCppOptions GHCOption
dir = do
    Bool
exist <- GHCOption -> IO Bool
doesFileExist GHCOption
cabalMacro
    [GHCOption] -> IO [GHCOption]
forall (m :: * -> *) a. Monad m => a -> m a
return ([GHCOption] -> IO [GHCOption]) -> [GHCOption] -> IO [GHCOption]
forall a b. (a -> b) -> a -> b
$ if Bool
exist then
        [GHCOption
"-include", GHCOption
cabalMacro]
      else
        []
  where
    cabalMacro :: GHCOption
cabalMacro = GHCOption
dir GHCOption -> GHCOption -> GHCOption
</> GHCOption
"dist/build/autogen/cabal_macros.h"

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

-- | Extracting all 'BuildInfo' for libraries, executables, and tests.
cabalAllBuildInfo :: PackageDescription -> [BuildInfo]
cabalAllBuildInfo :: PackageDescription -> [BuildInfo]
cabalAllBuildInfo PackageDescription
pd = [BuildInfo]
libBI [BuildInfo] -> [BuildInfo] -> [BuildInfo]
forall a. [a] -> [a] -> [a]
++ [BuildInfo]
subBI [BuildInfo] -> [BuildInfo] -> [BuildInfo]
forall a. [a] -> [a] -> [a]
++ [BuildInfo]
execBI [BuildInfo] -> [BuildInfo] -> [BuildInfo]
forall a. [a] -> [a] -> [a]
++ [BuildInfo]
testBI [BuildInfo] -> [BuildInfo] -> [BuildInfo]
forall a. [a] -> [a] -> [a]
++ [BuildInfo]
benchBI
  where
    libBI :: [BuildInfo]
libBI   = (Library -> BuildInfo) -> [Library] -> [BuildInfo]
forall a b. (a -> b) -> [a] -> [b]
map Library -> BuildInfo
P.libBuildInfo       ([Library] -> [BuildInfo]) -> [Library] -> [BuildInfo]
forall a b. (a -> b) -> a -> b
$ Maybe Library -> [Library]
forall a. Maybe a -> [a]
maybeToList (Maybe Library -> [Library]) -> Maybe Library -> [Library]
forall a b. (a -> b) -> a -> b
$ PackageDescription -> Maybe Library
P.library PackageDescription
pd
#if MIN_VERSION_Cabal(2,0,0)
    subBI :: [BuildInfo]
subBI   = (Library -> BuildInfo) -> [Library] -> [BuildInfo]
forall a b. (a -> b) -> [a] -> [b]
map Library -> BuildInfo
P.libBuildInfo       ([Library] -> [BuildInfo]) -> [Library] -> [BuildInfo]
forall a b. (a -> b) -> a -> b
$ PackageDescription -> [Library]
P.subLibraries PackageDescription
pd
#else
    subBI   = []
#endif
    execBI :: [BuildInfo]
execBI  = (Executable -> BuildInfo) -> [Executable] -> [BuildInfo]
forall a b. (a -> b) -> [a] -> [b]
map Executable -> BuildInfo
P.buildInfo          ([Executable] -> [BuildInfo]) -> [Executable] -> [BuildInfo]
forall a b. (a -> b) -> a -> b
$ PackageDescription -> [Executable]
P.executables PackageDescription
pd
    testBI :: [BuildInfo]
testBI  = (TestSuite -> BuildInfo) -> [TestSuite] -> [BuildInfo]
forall a b. (a -> b) -> [a] -> [b]
map TestSuite -> BuildInfo
P.testBuildInfo      ([TestSuite] -> [BuildInfo]) -> [TestSuite] -> [BuildInfo]
forall a b. (a -> b) -> a -> b
$ PackageDescription -> [TestSuite]
P.testSuites PackageDescription
pd
#if __GLASGOW_HASKELL__ >= 704
    benchBI :: [BuildInfo]
benchBI = (Benchmark -> BuildInfo) -> [Benchmark] -> [BuildInfo]
forall a b. (a -> b) -> [a] -> [b]
map Benchmark -> BuildInfo
P.benchmarkBuildInfo ([Benchmark] -> [BuildInfo]) -> [Benchmark] -> [BuildInfo]
forall a b. (a -> b) -> a -> b
$ PackageDescription -> [Benchmark]
P.benchmarks PackageDescription
pd
#else
    benchBI = []
#endif

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

-- | Extracting package names of dependency.
cabalDependPackages :: [BuildInfo] -> [PackageBaseName]
cabalDependPackages :: [BuildInfo] -> [GHCOption]
cabalDependPackages [BuildInfo]
bis = [GHCOption] -> [GHCOption]
uniqueAndSort [GHCOption]
pkgs
  where
    pkgs :: [GHCOption]
pkgs = (Dependency -> GHCOption) -> [Dependency] -> [GHCOption]
forall a b. (a -> b) -> [a] -> [b]
map Dependency -> GHCOption
getDependencyPackageName ([Dependency] -> [GHCOption]) -> [Dependency] -> [GHCOption]
forall a b. (a -> b) -> a -> b
$ (BuildInfo -> [Dependency]) -> [BuildInfo] -> [Dependency]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap BuildInfo -> [Dependency]
P.targetBuildDepends [BuildInfo]
bis
#if MIN_VERSION_Cabal(3,0,0)
    getDependencyPackageName :: Dependency -> GHCOption
getDependencyPackageName (Dependency PackageName
pkg VersionRange
_ Set LibraryName
_) = PackageName -> GHCOption
unPackageName PackageName
pkg
#elif MIN_VERSION_Cabal(2,0,0)
    getDependencyPackageName (Dependency pkg _) = unPackageName pkg
#else
    getDependencyPackageName (Dependency (PackageName nm) _) = nm
#endif

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

-- | Extracting include directories for modules.
cabalSourceDirs :: [BuildInfo] -> [IncludeDir]
cabalSourceDirs :: [BuildInfo] -> [GHCOption]
cabalSourceDirs [BuildInfo]
bis = [GHCOption] -> [GHCOption]
uniqueAndSort ([GHCOption] -> [GHCOption]) -> [GHCOption] -> [GHCOption]
forall a b. (a -> b) -> a -> b
$ (BuildInfo -> [GHCOption]) -> [BuildInfo] -> [GHCOption]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap BuildInfo -> [GHCOption]
P.hsSourceDirs [BuildInfo]
bis

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

uniqueAndSort :: [String] -> [String]
uniqueAndSort :: [GHCOption] -> [GHCOption]
uniqueAndSort = Set GHCOption -> [GHCOption]
forall a. Set a -> [a]
toList (Set GHCOption -> [GHCOption])
-> ([GHCOption] -> Set GHCOption) -> [GHCOption] -> [GHCOption]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [GHCOption] -> Set GHCOption
forall a. Ord a => [a] -> Set a
fromList

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

getGHCId :: IO CompilerId
getGHCId :: IO CompilerId
getGHCId = CompilerFlavor -> Version -> CompilerId
CompilerId CompilerFlavor
GHC (Version -> CompilerId) -> IO Version -> IO CompilerId
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO Version
getGHC

getGHC :: IO Version
getGHC :: IO Version
getGHC = do
    Maybe Version
mv <- Program -> Verbosity -> GHCOption -> IO (Maybe Version)
programFindVersion Program
ghcProgram Verbosity
silent (Program -> GHCOption
programName Program
ghcProgram)
    case Maybe Version
mv of
        Maybe Version
Nothing -> IOError -> IO Version
forall e a. Exception e => e -> IO a
throwIO (IOError -> IO Version) -> IOError -> IO Version
forall a b. (a -> b) -> a -> b
$ GHCOption -> IOError
userError GHCOption
"ghc not found"
        Just Version
v  -> Version -> IO Version
forall (m :: * -> *) a. Monad m => a -> m a
return Version
v

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

-- | Extracting all 'Module' 'FilePath's for libraries, executables,
-- tests and benchmarks.
cabalAllTargets :: PackageDescription -> IO ([String],[String],[String],[String])
cabalAllTargets :: PackageDescription
-> IO ([GHCOption], [GHCOption], [GHCOption], [GHCOption])
cabalAllTargets PackageDescription
pd = do
    [[GHCOption]]
exeTargets  <- (Executable -> IO [GHCOption]) -> [Executable] -> IO [[GHCOption]]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Executable -> IO [GHCOption]
getExecutableTarget ([Executable] -> IO [[GHCOption]])
-> [Executable] -> IO [[GHCOption]]
forall a b. (a -> b) -> a -> b
$ PackageDescription -> [Executable]
P.executables PackageDescription
pd
    [[GHCOption]]
testTargets <- (TestSuite -> IO [GHCOption]) -> [TestSuite] -> IO [[GHCOption]]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM TestSuite -> IO [GHCOption]
getTestTarget ([TestSuite] -> IO [[GHCOption]])
-> [TestSuite] -> IO [[GHCOption]]
forall a b. (a -> b) -> a -> b
$ PackageDescription -> [TestSuite]
P.testSuites PackageDescription
pd
    ([GHCOption], [GHCOption], [GHCOption], [GHCOption])
-> IO ([GHCOption], [GHCOption], [GHCOption], [GHCOption])
forall (m :: * -> *) a. Monad m => a -> m a
return ([GHCOption]
libTargets,[[GHCOption]] -> [GHCOption]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[GHCOption]]
exeTargets,[[GHCOption]] -> [GHCOption]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[GHCOption]]
testTargets,[GHCOption]
benchTargets)
  where
    lib :: [ModuleName]
lib = case PackageDescription -> Maybe Library
P.library PackageDescription
pd of
            Maybe Library
Nothing -> []
#if MIN_VERSION_Cabal(2,0,0)
            Just Library
l -> Library -> [ModuleName]
P.explicitLibModules Library
l
#else
            Just l -> P.libModules l
#endif

    libTargets :: [GHCOption]
libTargets = (ModuleName -> GHCOption) -> [ModuleName] -> [GHCOption]
forall a b. (a -> b) -> [a] -> [b]
map ModuleName -> GHCOption
toModuleString [ModuleName]
lib
#if __GLASGOW_HASKELL__ >= 704
    benchTargets :: [GHCOption]
benchTargets = (ModuleName -> GHCOption) -> [ModuleName] -> [GHCOption]
forall a b. (a -> b) -> [a] -> [b]
map ModuleName -> GHCOption
toModuleString ([ModuleName] -> [GHCOption]) -> [ModuleName] -> [GHCOption]
forall a b. (a -> b) -> a -> b
$ (Benchmark -> [ModuleName]) -> [Benchmark] -> [ModuleName]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Benchmark -> [ModuleName]
P.benchmarkModules ([Benchmark] -> [ModuleName]) -> [Benchmark] -> [ModuleName]
forall a b. (a -> b) -> a -> b
$ PackageDescription -> [Benchmark]
P.benchmarks  PackageDescription
pd
#else
    benchTargets = []
#endif
    toModuleString :: ModuleName -> String
    toModuleString :: ModuleName -> GHCOption
toModuleString ModuleName
mn = GHCOption -> GHCOption
fromFilePath (GHCOption -> GHCOption) -> GHCOption -> GHCOption
forall a b. (a -> b) -> a -> b
$ ModuleName -> GHCOption
toFilePath ModuleName
mn

    fromFilePath :: FilePath -> String
    fromFilePath :: GHCOption -> GHCOption
fromFilePath GHCOption
fp = (Char -> Char) -> GHCOption -> GHCOption
forall a b. (a -> b) -> [a] -> [b]
map (\Char
c -> if Char
cChar -> Char -> Bool
forall a. Eq a => a -> a -> Bool
==Char
'/' then Char
'.' else Char
c) GHCOption
fp

    getTestTarget :: TestSuite -> IO [String]
    getTestTarget :: TestSuite -> IO [GHCOption]
getTestTarget TestSuite
ts =
       case TestSuite -> TestSuiteInterface
P.testInterface TestSuite
ts of
        (TestSuiteExeV10 Version
_ GHCOption
filePath) -> do
          let maybeTests :: [GHCOption]
maybeTests = [GHCOption
p GHCOption -> GHCOption -> GHCOption
</> GHCOption
e | GHCOption
p <- BuildInfo -> [GHCOption]
P.hsSourceDirs (BuildInfo -> [GHCOption]) -> BuildInfo -> [GHCOption]
forall a b. (a -> b) -> a -> b
$ TestSuite -> BuildInfo
P.testBuildInfo TestSuite
ts, GHCOption
e <- [GHCOption
filePath]]
          IO [GHCOption] -> IO [GHCOption]
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [GHCOption] -> IO [GHCOption])
-> IO [GHCOption] -> IO [GHCOption]
forall a b. (a -> b) -> a -> b
$ (GHCOption -> IO Bool) -> [GHCOption] -> IO [GHCOption]
forall (m :: * -> *) a.
Applicative m =>
(a -> m Bool) -> [a] -> m [a]
filterM GHCOption -> IO Bool
doesFileExist [GHCOption]
maybeTests
        (TestSuiteLibV09 Version
_ ModuleName
moduleName) -> [GHCOption] -> IO [GHCOption]
forall (m :: * -> *) a. Monad m => a -> m a
return [ModuleName -> GHCOption
toModuleString ModuleName
moduleName]
        (TestSuiteUnsupported TestType
_)       -> [GHCOption] -> IO [GHCOption]
forall (m :: * -> *) a. Monad m => a -> m a
return []

    getExecutableTarget :: Executable -> IO [String]
    getExecutableTarget :: Executable -> IO [GHCOption]
getExecutableTarget Executable
exe = do
      let maybeExes :: [GHCOption]
maybeExes = [GHCOption
p GHCOption -> GHCOption -> GHCOption
</> GHCOption
e | GHCOption
p <- BuildInfo -> [GHCOption]
P.hsSourceDirs (BuildInfo -> [GHCOption]) -> BuildInfo -> [GHCOption]
forall a b. (a -> b) -> a -> b
$ Executable -> BuildInfo
P.buildInfo Executable
exe, GHCOption
e <- [Executable -> GHCOption
P.modulePath Executable
exe]]
      IO [GHCOption] -> IO [GHCOption]
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [GHCOption] -> IO [GHCOption])
-> IO [GHCOption] -> IO [GHCOption]
forall a b. (a -> b) -> a -> b
$ (GHCOption -> IO Bool) -> [GHCOption] -> IO [GHCOption]
forall (m :: * -> *) a.
Applicative m =>
(a -> m Bool) -> [a] -> m [a]
filterM GHCOption -> IO Bool
doesFileExist [GHCOption]
maybeExes