{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE RankNTypes #-}

module Distribution.Simple.HaskellSuite where

import Prelude ()
import Distribution.Compat.Prelude

import qualified Data.List.NonEmpty as NE

import Distribution.Simple.Program
import Distribution.Simple.Compiler
import Distribution.Simple.Utils
import Distribution.Simple.BuildPaths
import Distribution.Verbosity
import Distribution.Version
import Distribution.Pretty
import Distribution.Parsec (simpleParsec)
import Distribution.Package
import Distribution.InstalledPackageInfo hiding (includeDirs)
import Distribution.Simple.PackageIndex as PackageIndex
import Distribution.PackageDescription
import Distribution.Simple.LocalBuildInfo
import Distribution.System (Platform)
import Language.Haskell.Extension
import Distribution.Simple.Program.Builtin

configure
  :: Verbosity -> Maybe FilePath -> Maybe FilePath
  -> ProgramDb -> IO (Compiler, Maybe Platform, ProgramDb)
configure :: Verbosity
-> Maybe FilePath
-> Maybe FilePath
-> ProgramDb
-> IO (Compiler, Maybe Platform, ProgramDb)
configure Verbosity
verbosity Maybe FilePath
mbHcPath Maybe FilePath
hcPkgPath ProgramDb
progdb0 = do

  -- We have no idea how a haskell-suite tool is named, so we require at
  -- least some information from the user.
  FilePath
hcPath <-
    let msg :: FilePath
msg = FilePath
"You have to provide name or path of a haskell-suite tool (-w PATH)"
    in IO FilePath
-> (FilePath -> IO FilePath) -> Maybe FilePath -> IO FilePath
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Verbosity -> FilePath -> IO FilePath
forall a. Verbosity -> FilePath -> IO a
die' Verbosity
verbosity FilePath
msg) FilePath -> IO FilePath
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe FilePath
mbHcPath

  Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Maybe FilePath -> Bool
forall a. Maybe a -> Bool
isJust Maybe FilePath
hcPkgPath) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
    Verbosity -> FilePath -> IO ()
warn Verbosity
verbosity FilePath
"--with-hc-pkg option is ignored for haskell-suite"

  (Compiler
comp, ConfiguredProgram
confdCompiler, ProgramDb
progdb1) <- FilePath
-> ProgramDb -> IO (Compiler, ConfiguredProgram, ProgramDb)
configureCompiler FilePath
hcPath ProgramDb
progdb0

  -- Update our pkg tool. It uses the same executable as the compiler, but
  -- all command start with "pkg"
  (ConfiguredProgram
confdPkg, ProgramDb
_) <- Verbosity
-> Program -> ProgramDb -> IO (ConfiguredProgram, ProgramDb)
requireProgram Verbosity
verbosity Program
haskellSuitePkgProgram ProgramDb
progdb1
  let progdb2 :: ProgramDb
progdb2 =
        ConfiguredProgram -> ProgramDb -> ProgramDb
updateProgram
          ConfiguredProgram
confdPkg
            { programLocation :: ProgramLocation
programLocation = ConfiguredProgram -> ProgramLocation
programLocation ConfiguredProgram
confdCompiler
            , programDefaultArgs :: [FilePath]
programDefaultArgs = [FilePath
"pkg"]
            }
          ProgramDb
progdb1

  (Compiler, Maybe Platform, ProgramDb)
-> IO (Compiler, Maybe Platform, ProgramDb)
forall (m :: * -> *) a. Monad m => a -> m a
return (Compiler
comp, Maybe Platform
forall a. Maybe a
Nothing, ProgramDb
progdb2)

  where
    configureCompiler :: FilePath
-> ProgramDb -> IO (Compiler, ConfiguredProgram, ProgramDb)
configureCompiler FilePath
hcPath ProgramDb
progdb0' = do
      let
        haskellSuiteProgram' :: Program
haskellSuiteProgram' =
          Program
haskellSuiteProgram
            { programFindLocation :: Verbosity -> ProgramSearchPath -> IO (Maybe (FilePath, [FilePath]))
programFindLocation = \Verbosity
v ProgramSearchPath
p -> Verbosity
-> ProgramSearchPath
-> FilePath
-> IO (Maybe (FilePath, [FilePath]))
findProgramOnSearchPath Verbosity
v ProgramSearchPath
p FilePath
hcPath }

      -- NB: cannot call requireProgram right away — it'd think that
      -- the program is already configured and won't reconfigure it again.
      -- Instead, call configureProgram directly first.
      ProgramDb
progdb1 <- Verbosity -> Program -> ProgramDb -> IO ProgramDb
configureProgram Verbosity
verbosity Program
haskellSuiteProgram' ProgramDb
progdb0'
      (ConfiguredProgram
confdCompiler, ProgramDb
progdb2) <- Verbosity
-> Program -> ProgramDb -> IO (ConfiguredProgram, ProgramDb)
requireProgram Verbosity
verbosity Program
haskellSuiteProgram' ProgramDb
progdb1

      [(Extension, Maybe FilePath)]
extensions <- Verbosity -> ConfiguredProgram -> IO [(Extension, Maybe FilePath)]
getExtensions Verbosity
verbosity ConfiguredProgram
confdCompiler
      [(Language, FilePath)]
languages  <- Verbosity -> ConfiguredProgram -> IO [(Language, FilePath)]
getLanguages  Verbosity
verbosity ConfiguredProgram
confdCompiler
      (FilePath
compName, Version
compVersion) <-
        Verbosity -> ConfiguredProgram -> IO (FilePath, Version)
getCompilerVersion Verbosity
verbosity ConfiguredProgram
confdCompiler

      let
        comp :: Compiler
comp = Compiler :: CompilerId
-> AbiTag
-> [CompilerId]
-> [(Language, FilePath)]
-> [(Extension, Maybe FilePath)]
-> Map FilePath FilePath
-> Compiler
Compiler {
          compilerId :: CompilerId
compilerId             = CompilerFlavor -> Version -> CompilerId
CompilerId (FilePath -> CompilerFlavor
HaskellSuite FilePath
compName) Version
compVersion,
          compilerAbiTag :: AbiTag
compilerAbiTag         = AbiTag
NoAbiTag,
          compilerCompat :: [CompilerId]
compilerCompat         = [],
          compilerLanguages :: [(Language, FilePath)]
compilerLanguages      = [(Language, FilePath)]
languages,
          compilerExtensions :: [(Extension, Maybe FilePath)]
compilerExtensions     = [(Extension, Maybe FilePath)]
extensions,
          compilerProperties :: Map FilePath FilePath
compilerProperties     = Map FilePath FilePath
forall a. Monoid a => a
mempty
        }

      (Compiler, ConfiguredProgram, ProgramDb)
-> IO (Compiler, ConfiguredProgram, ProgramDb)
forall (m :: * -> *) a. Monad m => a -> m a
return (Compiler
comp, ConfiguredProgram
confdCompiler, ProgramDb
progdb2)

hstoolVersion :: Verbosity -> FilePath -> IO (Maybe Version)
hstoolVersion :: Verbosity -> FilePath -> IO (Maybe Version)
hstoolVersion = FilePath
-> (FilePath -> FilePath)
-> Verbosity
-> FilePath
-> IO (Maybe Version)
findProgramVersion FilePath
"--hspkg-version" FilePath -> FilePath
forall a. a -> a
id

numericVersion :: Verbosity -> FilePath -> IO (Maybe Version)
numericVersion :: Verbosity -> FilePath -> IO (Maybe Version)
numericVersion = FilePath
-> (FilePath -> FilePath)
-> Verbosity
-> FilePath
-> IO (Maybe Version)
findProgramVersion FilePath
"--compiler-version" (FilePath -> Maybe FilePath -> FilePath
forall a. a -> Maybe a -> a
fromMaybe FilePath
"" (Maybe FilePath -> FilePath)
-> (FilePath -> Maybe FilePath) -> FilePath -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [FilePath] -> Maybe FilePath
forall a. [a] -> Maybe a
safeLast ([FilePath] -> Maybe FilePath)
-> (FilePath -> [FilePath]) -> FilePath -> Maybe FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> [FilePath]
words)

getCompilerVersion :: Verbosity -> ConfiguredProgram -> IO (String, Version)
getCompilerVersion :: Verbosity -> ConfiguredProgram -> IO (FilePath, Version)
getCompilerVersion Verbosity
verbosity ConfiguredProgram
prog = do
  FilePath
output <- Verbosity -> FilePath -> [FilePath] -> IO FilePath
forall mode.
KnownIODataMode mode =>
Verbosity -> FilePath -> [FilePath] -> IO mode
rawSystemStdout Verbosity
verbosity (ConfiguredProgram -> FilePath
programPath ConfiguredProgram
prog) [FilePath
"--compiler-version"]
  let
    parts :: [FilePath]
parts = FilePath -> [FilePath]
words FilePath
output
    name :: FilePath
name = [FilePath] -> FilePath
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([FilePath] -> FilePath) -> [FilePath] -> FilePath
forall a b. (a -> b) -> a -> b
$ [FilePath] -> [FilePath]
forall a. [a] -> [a]
safeInit [FilePath]
parts -- there shouldn't be any spaces in the name anyway
    versionStr :: FilePath
versionStr = FilePath -> Maybe FilePath -> FilePath
forall a. a -> Maybe a -> a
fromMaybe FilePath
"" (Maybe FilePath -> FilePath) -> Maybe FilePath -> FilePath
forall a b. (a -> b) -> a -> b
$ [FilePath] -> Maybe FilePath
forall a. [a] -> Maybe a
safeLast [FilePath]
parts
  Version
version <-
    IO Version
-> (Version -> IO Version) -> Maybe Version -> IO Version
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Verbosity -> FilePath -> IO Version
forall a. Verbosity -> FilePath -> IO a
die' Verbosity
verbosity FilePath
"haskell-suite: couldn't determine compiler version") Version -> IO Version
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe Version -> IO Version) -> Maybe Version -> IO Version
forall a b. (a -> b) -> a -> b
$
      FilePath -> Maybe Version
forall a. Parsec a => FilePath -> Maybe a
simpleParsec FilePath
versionStr
  (FilePath, Version) -> IO (FilePath, Version)
forall (m :: * -> *) a. Monad m => a -> m a
return (FilePath
name, Version
version)

getExtensions :: Verbosity -> ConfiguredProgram -> IO [(Extension, Maybe CompilerFlag)]
getExtensions :: Verbosity -> ConfiguredProgram -> IO [(Extension, Maybe FilePath)]
getExtensions Verbosity
verbosity ConfiguredProgram
prog = do
  [FilePath]
extStrs <-
    FilePath -> [FilePath]
lines (FilePath -> [FilePath]) -> IO FilePath -> IO [FilePath]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap`
    Verbosity -> FilePath -> [FilePath] -> IO FilePath
forall mode.
KnownIODataMode mode =>
Verbosity -> FilePath -> [FilePath] -> IO mode
rawSystemStdout Verbosity
verbosity (ConfiguredProgram -> FilePath
programPath ConfiguredProgram
prog) [FilePath
"--supported-extensions"]
  [(Extension, Maybe FilePath)] -> IO [(Extension, Maybe FilePath)]
forall (m :: * -> *) a. Monad m => a -> m a
return
    [ (Extension
ext, FilePath -> Maybe FilePath
forall a. a -> Maybe a
Just (FilePath -> Maybe FilePath) -> FilePath -> Maybe FilePath
forall a b. (a -> b) -> a -> b
$ FilePath
"-X" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ Extension -> FilePath
forall a. Pretty a => a -> FilePath
prettyShow Extension
ext) | Just Extension
ext <- (FilePath -> Maybe Extension) -> [FilePath] -> [Maybe Extension]
forall a b. (a -> b) -> [a] -> [b]
map FilePath -> Maybe Extension
forall a. Parsec a => FilePath -> Maybe a
simpleParsec [FilePath]
extStrs ]

getLanguages :: Verbosity -> ConfiguredProgram -> IO [(Language, CompilerFlag)]
getLanguages :: Verbosity -> ConfiguredProgram -> IO [(Language, FilePath)]
getLanguages Verbosity
verbosity ConfiguredProgram
prog = do
  [FilePath]
langStrs <-
    FilePath -> [FilePath]
lines (FilePath -> [FilePath]) -> IO FilePath -> IO [FilePath]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap`
    Verbosity -> FilePath -> [FilePath] -> IO FilePath
forall mode.
KnownIODataMode mode =>
Verbosity -> FilePath -> [FilePath] -> IO mode
rawSystemStdout Verbosity
verbosity (ConfiguredProgram -> FilePath
programPath ConfiguredProgram
prog) [FilePath
"--supported-languages"]
  [(Language, FilePath)] -> IO [(Language, FilePath)]
forall (m :: * -> *) a. Monad m => a -> m a
return
    [ (Language
ext, FilePath
"-G" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ Language -> FilePath
forall a. Pretty a => a -> FilePath
prettyShow Language
ext) | Just Language
ext <- (FilePath -> Maybe Language) -> [FilePath] -> [Maybe Language]
forall a b. (a -> b) -> [a] -> [b]
map FilePath -> Maybe Language
forall a. Parsec a => FilePath -> Maybe a
simpleParsec [FilePath]
langStrs ]

-- Other compilers do some kind of a packagedb stack check here. Not sure
-- if we need something like that as well.
getInstalledPackages :: Verbosity -> PackageDBStack -> ProgramDb
                     -> IO InstalledPackageIndex
getInstalledPackages :: Verbosity
-> PackageDBStack -> ProgramDb -> IO InstalledPackageIndex
getInstalledPackages Verbosity
verbosity PackageDBStack
packagedbs ProgramDb
progdb =
  ([[InstalledPackageInfo]] -> InstalledPackageIndex)
-> IO [[InstalledPackageInfo]] -> IO InstalledPackageIndex
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM ([InstalledPackageInfo] -> InstalledPackageIndex
PackageIndex.fromList ([InstalledPackageInfo] -> InstalledPackageIndex)
-> ([[InstalledPackageInfo]] -> [InstalledPackageInfo])
-> [[InstalledPackageInfo]]
-> InstalledPackageIndex
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[InstalledPackageInfo]] -> [InstalledPackageInfo]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat) (IO [[InstalledPackageInfo]] -> IO InstalledPackageIndex)
-> IO [[InstalledPackageInfo]] -> IO InstalledPackageIndex
forall a b. (a -> b) -> a -> b
$ PackageDBStack
-> (PackageDB -> IO [InstalledPackageInfo])
-> IO [[InstalledPackageInfo]]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
t a -> (a -> f b) -> f (t b)
for PackageDBStack
packagedbs ((PackageDB -> IO [InstalledPackageInfo])
 -> IO [[InstalledPackageInfo]])
-> (PackageDB -> IO [InstalledPackageInfo])
-> IO [[InstalledPackageInfo]]
forall a b. (a -> b) -> a -> b
$ \PackageDB
packagedb ->
    do FilePath
str <-
        Verbosity -> Program -> ProgramDb -> [FilePath] -> IO FilePath
getDbProgramOutput Verbosity
verbosity Program
haskellSuitePkgProgram ProgramDb
progdb
                [FilePath
"dump", PackageDB -> FilePath
packageDbOpt PackageDB
packagedb]
         IO FilePath -> (ExitCode -> IO FilePath) -> IO FilePath
forall a. IO a -> (ExitCode -> IO a) -> IO a
`catchExit` \ExitCode
_ -> Verbosity -> FilePath -> IO FilePath
forall a. Verbosity -> FilePath -> IO a
die' Verbosity
verbosity (FilePath -> IO FilePath) -> FilePath -> IO FilePath
forall a b. (a -> b) -> a -> b
$ FilePath
"pkg dump failed"
       case FilePath -> Either [FilePath] [InstalledPackageInfo]
parsePackages FilePath
str of
         Right [InstalledPackageInfo]
ok -> [InstalledPackageInfo] -> IO [InstalledPackageInfo]
forall (m :: * -> *) a. Monad m => a -> m a
return [InstalledPackageInfo]
ok
         Either [FilePath] [InstalledPackageInfo]
_       -> Verbosity -> FilePath -> IO [InstalledPackageInfo]
forall a. Verbosity -> FilePath -> IO a
die' Verbosity
verbosity FilePath
"failed to parse output of 'pkg dump'"

  where
    parsePackages :: FilePath -> Either [FilePath] [InstalledPackageInfo]
parsePackages FilePath
str =
        case [Either (NonEmpty FilePath) ([FilePath], InstalledPackageInfo)]
-> ([NonEmpty FilePath], [([FilePath], InstalledPackageInfo)])
forall a b. [Either a b] -> ([a], [b])
partitionEithers ([Either (NonEmpty FilePath) ([FilePath], InstalledPackageInfo)]
 -> ([NonEmpty FilePath], [([FilePath], InstalledPackageInfo)]))
-> [Either (NonEmpty FilePath) ([FilePath], InstalledPackageInfo)]
-> ([NonEmpty FilePath], [([FilePath], InstalledPackageInfo)])
forall a b. (a -> b) -> a -> b
$ (FilePath
 -> Either (NonEmpty FilePath) ([FilePath], InstalledPackageInfo))
-> [FilePath]
-> [Either (NonEmpty FilePath) ([FilePath], InstalledPackageInfo)]
forall a b. (a -> b) -> [a] -> [b]
map (ByteString
-> Either (NonEmpty FilePath) ([FilePath], InstalledPackageInfo)
parseInstalledPackageInfo (ByteString
 -> Either (NonEmpty FilePath) ([FilePath], InstalledPackageInfo))
-> (FilePath -> ByteString)
-> FilePath
-> Either (NonEmpty FilePath) ([FilePath], InstalledPackageInfo)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> ByteString
toUTF8BS) (FilePath -> [FilePath]
splitPkgs FilePath
str) of
            ([], [([FilePath], InstalledPackageInfo)]
ok)   -> [InstalledPackageInfo] -> Either [FilePath] [InstalledPackageInfo]
forall a b. b -> Either a b
Right [ InstalledPackageInfo
pkg | ([FilePath]
_, InstalledPackageInfo
pkg) <- [([FilePath], InstalledPackageInfo)]
ok ]
            ([NonEmpty FilePath]
msgss, [([FilePath], InstalledPackageInfo)]
_) -> [FilePath] -> Either [FilePath] [InstalledPackageInfo]
forall a b. a -> Either a b
Left ((NonEmpty FilePath -> [FilePath])
-> [NonEmpty FilePath] -> [FilePath]
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap NonEmpty FilePath -> [FilePath]
forall a. NonEmpty a -> [a]
NE.toList [NonEmpty FilePath]
msgss)

    splitPkgs :: String -> [String]
    splitPkgs :: FilePath -> [FilePath]
splitPkgs = ([FilePath] -> FilePath) -> [[FilePath]] -> [FilePath]
forall a b. (a -> b) -> [a] -> [b]
map [FilePath] -> FilePath
unlines ([[FilePath]] -> [FilePath])
-> (FilePath -> [[FilePath]]) -> FilePath -> [FilePath]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FilePath -> Bool) -> [FilePath] -> [[FilePath]]
forall a. (a -> Bool) -> [a] -> [[a]]
splitWith (FilePath
"---" FilePath -> FilePath -> Bool
forall a. Eq a => a -> a -> Bool
==) ([FilePath] -> [[FilePath]])
-> (FilePath -> [FilePath]) -> FilePath -> [[FilePath]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> [FilePath]
lines
      where
        splitWith :: (a -> Bool) -> [a] -> [[a]]
        splitWith :: (a -> Bool) -> [a] -> [[a]]
splitWith a -> Bool
p [a]
xs = [a]
ys [a] -> [[a]] -> [[a]]
forall a. a -> [a] -> [a]
: case [a]
zs of
                           []   -> []
                           a
_:[a]
ws -> (a -> Bool) -> [a] -> [[a]]
forall a. (a -> Bool) -> [a] -> [[a]]
splitWith a -> Bool
p [a]
ws
          where ([a]
ys,[a]
zs) = (a -> Bool) -> [a] -> ([a], [a])
forall a. (a -> Bool) -> [a] -> ([a], [a])
break a -> Bool
p [a]
xs

buildLib
  :: Verbosity -> PackageDescription -> LocalBuildInfo
  -> Library -> ComponentLocalBuildInfo -> IO ()
buildLib :: Verbosity
-> PackageDescription
-> LocalBuildInfo
-> Library
-> ComponentLocalBuildInfo
-> IO ()
buildLib Verbosity
verbosity PackageDescription
pkg_descr LocalBuildInfo
lbi Library
lib ComponentLocalBuildInfo
clbi = do
  -- In future, there should be a mechanism for the compiler to request any
  -- number of the above parameters (or their parts) — in particular,
  -- pieces of PackageDescription.
  --
  -- For now, we only pass those that we know are used.

  let odir :: FilePath
odir = LocalBuildInfo -> FilePath
buildDir LocalBuildInfo
lbi
      bi :: BuildInfo
bi = Library -> BuildInfo
libBuildInfo Library
lib
      srcDirs :: [FilePath]
srcDirs = BuildInfo -> [FilePath]
hsSourceDirs BuildInfo
bi [FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++ [FilePath
odir]
      dbStack :: PackageDBStack
dbStack = LocalBuildInfo -> PackageDBStack
withPackageDB LocalBuildInfo
lbi
      language :: Language
language = Language -> Maybe Language -> Language
forall a. a -> Maybe a -> a
fromMaybe Language
Haskell98 (BuildInfo -> Maybe Language
defaultLanguage BuildInfo
bi)
      progdb :: ProgramDb
progdb = LocalBuildInfo -> ProgramDb
withPrograms LocalBuildInfo
lbi
      pkgid :: PackageIdentifier
pkgid = PackageDescription -> PackageIdentifier
forall pkg. Package pkg => pkg -> PackageIdentifier
packageId PackageDescription
pkg_descr

  Verbosity -> Program -> ProgramDb -> [FilePath] -> IO ()
runDbProgram Verbosity
verbosity Program
haskellSuiteProgram ProgramDb
progdb ([FilePath] -> IO ()) -> [FilePath] -> IO ()
forall a b. (a -> b) -> a -> b
$
    [ FilePath
"compile", FilePath
"--build-dir", FilePath
odir ] [FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++
    [[FilePath]] -> [FilePath]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [ [FilePath
"-i", FilePath
d] | FilePath
d <- [FilePath]
srcDirs ] [FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++
    [[FilePath]] -> [FilePath]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [ [FilePath
"-I", FilePath
d] | FilePath
d <- [LocalBuildInfo -> ComponentLocalBuildInfo -> FilePath
autogenComponentModulesDir LocalBuildInfo
lbi ComponentLocalBuildInfo
clbi
                              ,LocalBuildInfo -> FilePath
autogenPackageModulesDir LocalBuildInfo
lbi
                              ,FilePath
odir] [FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++ BuildInfo -> [FilePath]
includeDirs BuildInfo
bi ] [FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++
    [ PackageDB -> FilePath
packageDbOpt PackageDB
pkgDb | PackageDB
pkgDb <- PackageDBStack
dbStack ] [FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++
    [ FilePath
"--package-name", PackageIdentifier -> FilePath
forall a. Pretty a => a -> FilePath
prettyShow PackageIdentifier
pkgid ] [FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++
    [[FilePath]] -> [FilePath]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [ [FilePath
"--package-id", UnitId -> FilePath
forall a. Pretty a => a -> FilePath
prettyShow UnitId
ipkgid ]
           | (UnitId
ipkgid, MungedPackageId
_) <- ComponentLocalBuildInfo -> [(UnitId, MungedPackageId)]
componentPackageDeps ComponentLocalBuildInfo
clbi ] [FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++
    [FilePath
"-G", Language -> FilePath
forall a. Pretty a => a -> FilePath
prettyShow Language
language] [FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++
    [[FilePath]] -> [FilePath]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [ [FilePath
"-X", Extension -> FilePath
forall a. Pretty a => a -> FilePath
prettyShow Extension
ex] | Extension
ex <- BuildInfo -> [Extension]
usedExtensions BuildInfo
bi ] [FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++
    BuildInfo -> [FilePath]
cppOptions (Library -> BuildInfo
libBuildInfo Library
lib) [FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++
    [ ModuleName -> FilePath
forall a. Pretty a => a -> FilePath
prettyShow ModuleName
modu | ModuleName
modu <- Library -> ComponentLocalBuildInfo -> [ModuleName]
allLibModules Library
lib ComponentLocalBuildInfo
clbi ]



installLib
  :: Verbosity
  -> LocalBuildInfo
  -> FilePath  -- ^install location
  -> FilePath  -- ^install location for dynamic libraries
  -> FilePath  -- ^Build location
  -> PackageDescription
  -> Library
  -> ComponentLocalBuildInfo
  -> IO ()
installLib :: Verbosity
-> LocalBuildInfo
-> FilePath
-> FilePath
-> FilePath
-> PackageDescription
-> Library
-> ComponentLocalBuildInfo
-> IO ()
installLib Verbosity
verbosity LocalBuildInfo
lbi FilePath
targetDir FilePath
dynlibTargetDir FilePath
builtDir PackageDescription
pkg Library
lib ComponentLocalBuildInfo
clbi = do
  let progdb :: ProgramDb
progdb = LocalBuildInfo -> ProgramDb
withPrograms LocalBuildInfo
lbi
  Verbosity -> Program -> ProgramDb -> [FilePath] -> IO ()
runDbProgram Verbosity
verbosity Program
haskellSuitePkgProgram ProgramDb
progdb ([FilePath] -> IO ()) -> [FilePath] -> IO ()
forall a b. (a -> b) -> a -> b
$
    [ FilePath
"install-library"
    , FilePath
"--build-dir", FilePath
builtDir
    , FilePath
"--target-dir", FilePath
targetDir
    , FilePath
"--dynlib-target-dir", FilePath
dynlibTargetDir
    , FilePath
"--package-id", PackageIdentifier -> FilePath
forall a. Pretty a => a -> FilePath
prettyShow (PackageIdentifier -> FilePath) -> PackageIdentifier -> FilePath
forall a b. (a -> b) -> a -> b
$ PackageDescription -> PackageIdentifier
forall pkg. Package pkg => pkg -> PackageIdentifier
packageId PackageDescription
pkg
    ] [FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++ (ModuleName -> FilePath) -> [ModuleName] -> [FilePath]
forall a b. (a -> b) -> [a] -> [b]
map ModuleName -> FilePath
forall a. Pretty a => a -> FilePath
prettyShow (Library -> ComponentLocalBuildInfo -> [ModuleName]
allLibModules Library
lib ComponentLocalBuildInfo
clbi)

registerPackage
  :: Verbosity
  -> ProgramDb
  -> PackageDBStack
  -> InstalledPackageInfo
  -> IO ()
registerPackage :: Verbosity
-> ProgramDb -> PackageDBStack -> InstalledPackageInfo -> IO ()
registerPackage Verbosity
verbosity ProgramDb
progdb PackageDBStack
packageDbs InstalledPackageInfo
installedPkgInfo = do
  (ConfiguredProgram
hspkg, ProgramDb
_) <- Verbosity
-> Program -> ProgramDb -> IO (ConfiguredProgram, ProgramDb)
requireProgram Verbosity
verbosity Program
haskellSuitePkgProgram ProgramDb
progdb

  Verbosity -> ProgramInvocation -> IO ()
runProgramInvocation Verbosity
verbosity (ProgramInvocation -> IO ()) -> ProgramInvocation -> IO ()
forall a b. (a -> b) -> a -> b
$
    (ConfiguredProgram -> [FilePath] -> ProgramInvocation
programInvocation ConfiguredProgram
hspkg
      [FilePath
"update", PackageDB -> FilePath
packageDbOpt (PackageDB -> FilePath) -> PackageDB -> FilePath
forall a b. (a -> b) -> a -> b
$ PackageDBStack -> PackageDB
registrationPackageDB PackageDBStack
packageDbs])
      { progInvokeInput :: Maybe IOData
progInvokeInput = IOData -> Maybe IOData
forall a. a -> Maybe a
Just (IOData -> Maybe IOData) -> IOData -> Maybe IOData
forall a b. (a -> b) -> a -> b
$ FilePath -> IOData
IODataText (FilePath -> IOData) -> FilePath -> IOData
forall a b. (a -> b) -> a -> b
$ InstalledPackageInfo -> FilePath
showInstalledPackageInfo InstalledPackageInfo
installedPkgInfo }

initPackageDB :: Verbosity -> ProgramDb -> FilePath -> IO ()
initPackageDB :: Verbosity -> ProgramDb -> FilePath -> IO ()
initPackageDB Verbosity
verbosity ProgramDb
progdb FilePath
dbPath =
  Verbosity -> Program -> ProgramDb -> [FilePath] -> IO ()
runDbProgram Verbosity
verbosity Program
haskellSuitePkgProgram ProgramDb
progdb
    [FilePath
"init", FilePath
dbPath]

packageDbOpt :: PackageDB -> String
packageDbOpt :: PackageDB -> FilePath
packageDbOpt PackageDB
GlobalPackageDB        = FilePath
"--global"
packageDbOpt PackageDB
UserPackageDB          = FilePath
"--user"
packageDbOpt (SpecificPackageDB FilePath
db) = FilePath
"--package-db=" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
db