{-# LANGUAGE CPP #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE OverloadedStrings #-}

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

import Distribution.Compiler (AbiTag (NoAbiTag), unknownCompilerInfo)
import Distribution.ModuleName (ModuleName, toFilePath)
import Distribution.Package (Dependency (Dependency))
import qualified Distribution.Package as C
import Distribution.PackageDescription (
    BuildInfo,
    Executable,
    PackageDescription,
    TestSuite,
    TestSuiteInterface (..),
 )
import qualified Distribution.PackageDescription as P
import Distribution.PackageDescription.Configuration (finalizePD)
import Distribution.Simple.Compiler (CompilerFlavor (..), CompilerId (..))
import Distribution.Simple.Program (ghcProgram)
import Distribution.Simple.Program.Types (programFindVersion, programName)
import Distribution.System (buildPlatform)
import Distribution.Text (display)
import Distribution.Verbosity (silent)
import Distribution.Version (Version)
#if MIN_VERSION_Cabal(3,8,0)
import Distribution.Simple.PackageDescription (readGenericPackageDescription)
#else
import Distribution.PackageDescription.Parsec (readGenericPackageDescription)
#endif
import Distribution.Types.ComponentRequestedSpec (defaultComponentRequestedSpec)
import Distribution.Types.Flag (mkFlagAssignment, mkFlagName)
import Distribution.Types.PackageName (unPackageName)
#if MIN_VERSION_Cabal(3,6,0)
import Distribution.Utils.Path (getSymbolicPath, SymbolicPath)
#endif
#if MIN_VERSION_Cabal(3,14,0)
import qualified Distribution.Utils.Path as Path
#endif

import GHC.Utils.Monad (liftIO)

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

import Hhp.GhcPkg
import Hhp.Types

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

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

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

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

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

attachPackageIds :: [Package] -> [PackageBaseName] -> [Package]
attachPackageIds :: [Package] -> [String] -> [Package]
attachPackageIds [Package]
pkgs = (String -> Maybe Package) -> [String] -> [Package]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (String -> [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 :: forall a b c. Eq a => 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 :: [String]
cabalBuildDirs = [String
"dist/build", String
"dist/build/autogen"]

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

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

-- | Parsing a cabal file and returns 'PackageDescription'.
--   'IOException' is thrown if parsing fails.
parseCabalFile :: FilePath -> IO PackageDescription
parseCabalFile :: String -> IO PackageDescription
parseCabalFile String
file = do
    CompilerId
cid <- IO CompilerId
getGHCId
    let cid' :: CompilerInfo
cid' = CompilerId -> AbiTag -> CompilerInfo
unknownCompilerInfo CompilerId
cid AbiTag
NoAbiTag
    GenericPackageDescription
epgd <- String -> IO GenericPackageDescription
readPackageDescription String
file
    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
$ String -> IOError
userError (String -> IOError) -> String -> IOError
forall a b. (a -> b) -> a -> b
$ [Dependency] -> String
forall a. Show a => a -> String
show [Dependency]
deps String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" 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
$ String -> IOError
userError (String -> IOError) -> String -> IOError
forall a b. (a -> b) -> a -> b
$ String
file String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" is broken"
                else PackageDescription -> IO PackageDescription
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return PackageDescription
pd
  where
    envFlags :: IO [(FlagName, Bool)]
envFlags = do
        let parseF :: String -> [(FlagName, Bool)]
parseF [] = []
            parseF ccs :: String
ccs@(Char
c : String
cs)
                | Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'-' = [(String -> FlagName
mkFlagName String
cs, Bool
False)]
                | Bool
otherwise = [(String -> FlagName
mkFlagName String
ccs, Bool
True)]
        [(FlagName, Bool)]
-> (String -> [(FlagName, Bool)])
-> Maybe String
-> [(FlagName, Bool)]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] ((String -> [(FlagName, Bool)]) -> [String] -> [(FlagName, Bool)]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap String -> [(FlagName, Bool)]
parseF ([String] -> [(FlagName, Bool)])
-> (String -> [String]) -> String -> [(FlagName, Bool)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [String]
words) (Maybe String -> [(FlagName, Bool)])
-> IO (Maybe String) -> IO [(FlagName, Bool)]
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` String -> IO (Maybe String)
lookupEnv String
"HHP_CABAL_FLAGS"
    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
<$> IO [(FlagName, Bool)]
envFlags
    nullPkg :: PackageDescription -> Bool
nullPkg PackageDescription
pd = PackageName -> String
unPackageName (PackageIdentifier -> PackageName
C.pkgName (PackageDescription -> PackageIdentifier
P.package PackageDescription
pd)) String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
""
    toPkgDesc :: CompilerInfo
-> FlagAssignment
-> GenericPackageDescription
-> Either [Dependency] (PackageDescription, FlagAssignment)
toPkgDesc CompilerInfo
cid FlagAssignment
flags =
        FlagAssignment
-> ComponentRequestedSpec
-> (Dependency -> Bool)
-> Platform
-> CompilerInfo
-> [PackageVersionConstraint]
-> 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 []

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

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

cabalCppOptions :: FilePath -> IO [String]
cabalCppOptions :: String -> IO [String]
cabalCppOptions String
dir = do
    Bool
exist <- String -> IO Bool
doesFileExist String
cabalMacro
    [String] -> IO [String]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ([String] -> IO [String]) -> [String] -> IO [String]
forall a b. (a -> b) -> a -> b
$
        if Bool
exist
            then [String
"-include", String
cabalMacro]
            else []
  where
    cabalMacro :: String
cabalMacro = String
dir String -> String -> String
</> String
"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
    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
    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
    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

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

-- | Extracting package names of dependency.
cabalDependPackages :: [BuildInfo] -> [PackageBaseName]
cabalDependPackages :: [BuildInfo] -> [String]
cabalDependPackages [BuildInfo]
bis = [String] -> [String]
uniqueAndSort [String]
pkgs
  where
    pkgs :: [String]
pkgs = (Dependency -> String) -> [Dependency] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map Dependency -> String
getDependencyPackageName ([Dependency] -> [String]) -> [Dependency] -> [String]
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
    getDependencyPackageName :: Dependency -> String
getDependencyPackageName (Dependency PackageName
pkg VersionRange
_ NonEmptySet LibraryName
_) = PackageName -> String
unPackageName PackageName
pkg

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

-- | Extracting include directories for modules.
cabalSourceDirs :: [BuildInfo] -> [IncludeDir]
cabalSourceDirs :: [BuildInfo] -> [String]
cabalSourceDirs [BuildInfo]
bis = [String] -> [String]
uniqueAndSort ([String] -> [String]) -> [String] -> [String]
forall a b. (a -> b) -> a -> b
$ (BuildInfo -> [String]) -> [BuildInfo] -> [String]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap ((SymbolicPath PackageDir SourceDir -> String)
-> [SymbolicPath PackageDir SourceDir] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map SymbolicPath PackageDir SourceDir -> String
forall from to. SymbolicPath from to -> String
toPath ([SymbolicPath PackageDir SourceDir] -> [String])
-> (BuildInfo -> [SymbolicPath PackageDir SourceDir])
-> BuildInfo
-> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BuildInfo -> [SymbolicPath PackageDir SourceDir]
P.hsSourceDirs) [BuildInfo]
bis

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

uniqueAndSort :: [String] -> [String]
uniqueAndSort :: [String] -> [String]
uniqueAndSort = Set String -> [String]
forall a. Set a -> [a]
toList (Set String -> [String])
-> ([String] -> Set String) -> [String] -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> Set String
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 -> String -> IO (Maybe Version)
programFindVersion Program
ghcProgram Verbosity
silent (Program -> String
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
$ String -> IOError
userError String
"ghc not found"
        Just Version
v -> Version -> IO Version
forall a. a -> IO a
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 ([String], [String], [String], [String])
cabalAllTargets PackageDescription
pd = do
    [[String]]
exeTargets <- (Executable -> IO [String]) -> [Executable] -> IO [[String]]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM Executable -> IO [String]
getExecutableTarget ([Executable] -> IO [[String]]) -> [Executable] -> IO [[String]]
forall a b. (a -> b) -> a -> b
$ PackageDescription -> [Executable]
P.executables PackageDescription
pd
    [[String]]
testTargets <- (TestSuite -> IO [String]) -> [TestSuite] -> IO [[String]]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM TestSuite -> IO [String]
getTestTarget ([TestSuite] -> IO [[String]]) -> [TestSuite] -> IO [[String]]
forall a b. (a -> b) -> a -> b
$ PackageDescription -> [TestSuite]
P.testSuites PackageDescription
pd
    ([String], [String], [String], [String])
-> IO ([String], [String], [String], [String])
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ([String]
libTargets, [[String]] -> [String]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[String]]
exeTargets, [[String]] -> [String]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[String]]
testTargets, [String]
benchTargets)
  where
    lib :: [ModuleName]
lib = [ModuleName]
-> (Library -> [ModuleName]) -> Maybe Library -> [ModuleName]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] Library -> [ModuleName]
P.explicitLibModules (Maybe Library -> [ModuleName]) -> Maybe Library -> [ModuleName]
forall a b. (a -> b) -> a -> b
$ PackageDescription -> Maybe Library
P.library PackageDescription
pd

    libTargets :: [String]
libTargets = (ModuleName -> String) -> [ModuleName] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map ModuleName -> String
toModuleString [ModuleName]
lib
    benchTargets :: [String]
benchTargets = (ModuleName -> String) -> [ModuleName] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map ModuleName -> String
toModuleString ([ModuleName] -> [String]) -> [ModuleName] -> [String]
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
    toModuleString :: ModuleName -> String
    toModuleString :: ModuleName -> String
toModuleString ModuleName
mn = String -> String
fromFilePath (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ ModuleName -> String
toFilePath ModuleName
mn

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

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

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

#if MIN_VERSION_Cabal(3,14,0)
(<//>) :: SymbolicPath Path.Pkg (Path.Dir Path.Source)
       -> Path.RelativePath Path.Source Path.File
       -> FilePath
dir <//> file = toPath (dir Path.</> file)
#else
(<//>) :: SymbolicPath from to -> FilePath -> FilePath
SymbolicPath from to
dir <//> :: forall from to. SymbolicPath from to -> String -> String
<//> String
file = SymbolicPath from to -> String
forall from to. SymbolicPath from to -> String
toPath SymbolicPath from to
dir String -> String -> String
</> String
file
#endif

extLibDirs :: BuildInfo -> [FilePath]
#if MIN_VERSION_Cabal(3,14,0)
extLibDirs = map getSymbolicPath . P.extraLibDirs
#else
extLibDirs :: BuildInfo -> [String]
extLibDirs = BuildInfo -> [String]
P.extraLibDirs
#endif

#if MIN_VERSION_Cabal(3,6,0)
toPath :: SymbolicPath from to -> FilePath
toPath :: forall from to. SymbolicPath from to -> String
toPath = SymbolicPath from to -> String
forall from to. SymbolicPath from to -> String
getSymbolicPath
#else
toPath :: String -> String
toPath = id
#endif

readPackageDescription :: FilePath -> IO P.GenericPackageDescription
#if MIN_VERSION_Cabal(3,14,0)
readPackageDescription = readGenericPackageDescription silent Nothing . Path.makeSymbolicPath
#else
readPackageDescription :: String -> IO GenericPackageDescription
readPackageDescription = Verbosity -> String -> IO GenericPackageDescription
readGenericPackageDescription Verbosity
silent
#endif