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

module Distribution.Simple.HaskellSuite where

import Distribution.Compat.Prelude
import Prelude ()

import qualified Data.List.NonEmpty as NE

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

configure
  :: Verbosity
  -> Maybe FilePath
  -> Maybe FilePath
  -> ProgramDb
  -> IO (Compiler, Maybe Platform, ProgramDb)
configure :: Verbosity
-> Maybe String
-> Maybe String
-> ProgramDb
-> IO (Compiler, Maybe Platform, ProgramDb)
configure Verbosity
verbosity Maybe String
mbHcPath Maybe String
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.
  String
hcPath <-
    let msg :: String
msg = String
"You have to provide name or path of a haskell-suite tool (-w PATH)"
     in IO String -> (String -> IO String) -> Maybe String -> IO String
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Verbosity -> CabalException -> IO String
forall a1 a.
(HasCallStack, Show a1, Typeable a1,
 Exception (VerboseException a1)) =>
Verbosity -> a1 -> IO a
dieWithException Verbosity
verbosity (CabalException -> IO String) -> CabalException -> IO String
forall a b. (a -> b) -> a -> b
$ String -> CabalException
ProvideHaskellSuiteTool String
msg) String -> IO String
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe String
mbHcPath

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

  (Compiler
comp, ConfiguredProgram
confdCompiler, ProgramDb
progdb1) <- String -> ProgramDb -> IO (Compiler, ConfiguredProgram, ProgramDb)
configureCompiler String
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 confdCompiler
            , programDefaultArgs = ["pkg"]
            }
          ProgramDb
progdb1

  (Compiler, Maybe Platform, ProgramDb)
-> IO (Compiler, Maybe Platform, ProgramDb)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Compiler
comp, Maybe Platform
forall a. Maybe a
Nothing, ProgramDb
progdb2)
  where
    configureCompiler :: String -> ProgramDb -> IO (Compiler, ConfiguredProgram, ProgramDb)
configureCompiler String
hcPath ProgramDb
progdb0' = do
      let
        haskellSuiteProgram' :: Program
haskellSuiteProgram' =
          Program
haskellSuiteProgram
            { programFindLocation = \Verbosity
v ProgramSearchPath
p -> Verbosity
-> ProgramSearchPath -> String -> IO (Maybe (String, [String]))
findProgramOnSearchPath Verbosity
v ProgramSearchPath
p String
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 String)]
extensions <- Verbosity -> ConfiguredProgram -> IO [(Extension, Maybe String)]
getExtensions Verbosity
verbosity ConfiguredProgram
confdCompiler
      [(Language, String)]
languages <- Verbosity -> ConfiguredProgram -> IO [(Language, String)]
getLanguages Verbosity
verbosity ConfiguredProgram
confdCompiler
      (String
compName, Version
compVersion) <-
        Verbosity -> ConfiguredProgram -> IO (String, Version)
getCompilerVersion Verbosity
verbosity ConfiguredProgram
confdCompiler

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

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

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

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

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

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

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

-- Other compilers do some kind of a packagedb stack check here. Not sure
-- if we need something like that as well.
getInstalledPackages
  :: Verbosity
  -- Not migrated to work with --working-dir but this is legacy dead code
  -> PackageDBStackX (SymbolicPath from (Dir PkgDB))
  -> ProgramDb
  -> IO InstalledPackageIndex
getInstalledPackages :: forall from.
Verbosity
-> PackageDBStackX (SymbolicPath from ('Dir PkgDB))
-> ProgramDb
-> IO InstalledPackageIndex
getInstalledPackages Verbosity
verbosity PackageDBStackX (SymbolicPath from ('Dir PkgDB))
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
$ PackageDBStackX (SymbolicPath from ('Dir PkgDB))
-> (PackageDBX (SymbolicPath from ('Dir PkgDB))
    -> IO [InstalledPackageInfo])
-> IO [[InstalledPackageInfo]]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
t a -> (a -> f b) -> f (t b)
for PackageDBStackX (SymbolicPath from ('Dir PkgDB))
packagedbs ((PackageDBX (SymbolicPath from ('Dir PkgDB))
  -> IO [InstalledPackageInfo])
 -> IO [[InstalledPackageInfo]])
-> (PackageDBX (SymbolicPath from ('Dir PkgDB))
    -> IO [InstalledPackageInfo])
-> IO [[InstalledPackageInfo]]
forall a b. (a -> b) -> a -> b
$ \PackageDBX (SymbolicPath from ('Dir PkgDB))
packagedb ->
    do
      String
str <-
        Verbosity -> Program -> ProgramDb -> [String] -> IO String
getDbProgramOutput
          Verbosity
verbosity
          Program
haskellSuitePkgProgram
          ProgramDb
progdb
          [String
"dump", PackageDBX (SymbolicPath from ('Dir PkgDB)) -> String
forall from. PackageDBX (SymbolicPath from ('Dir PkgDB)) -> String
packageDbOpt PackageDBX (SymbolicPath from ('Dir PkgDB))
packagedb]
          IO String -> (ExitCode -> IO String) -> IO String
forall a. IO a -> (ExitCode -> IO a) -> IO a
`catchExit` \ExitCode
_ -> Verbosity -> CabalException -> IO String
forall a1 a.
(HasCallStack, Show a1, Typeable a1,
 Exception (VerboseException a1)) =>
Verbosity -> a1 -> IO a
dieWithException Verbosity
verbosity CabalException
PkgDumpFailed

      case String -> Either [String] [InstalledPackageInfo]
parsePackages String
str of
        Right [InstalledPackageInfo]
ok -> [InstalledPackageInfo] -> IO [InstalledPackageInfo]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return [InstalledPackageInfo]
ok
        Either [String] [InstalledPackageInfo]
_ -> Verbosity -> CabalException -> IO [InstalledPackageInfo]
forall a1 a.
(HasCallStack, Show a1, Typeable a1,
 Exception (VerboseException a1)) =>
Verbosity -> a1 -> IO a
dieWithException Verbosity
verbosity CabalException
FailedToParseOutput
  where
    parsePackages :: String -> Either [String] [InstalledPackageInfo]
parsePackages String
str =
      case [Either (NonEmpty String) ([String], InstalledPackageInfo)]
-> ([NonEmpty String], [([String], InstalledPackageInfo)])
forall a b. [Either a b] -> ([a], [b])
partitionEithers ([Either (NonEmpty String) ([String], InstalledPackageInfo)]
 -> ([NonEmpty String], [([String], InstalledPackageInfo)]))
-> [Either (NonEmpty String) ([String], InstalledPackageInfo)]
-> ([NonEmpty String], [([String], InstalledPackageInfo)])
forall a b. (a -> b) -> a -> b
$ (String
 -> Either (NonEmpty String) ([String], InstalledPackageInfo))
-> [String]
-> [Either (NonEmpty String) ([String], InstalledPackageInfo)]
forall a b. (a -> b) -> [a] -> [b]
map (ByteString
-> Either (NonEmpty String) ([String], InstalledPackageInfo)
parseInstalledPackageInfo (ByteString
 -> Either (NonEmpty String) ([String], InstalledPackageInfo))
-> (String -> ByteString)
-> String
-> Either (NonEmpty String) ([String], InstalledPackageInfo)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ByteString
toUTF8BS) (String -> [String]
splitPkgs String
str) of
        ([], [([String], InstalledPackageInfo)]
ok) -> [InstalledPackageInfo] -> Either [String] [InstalledPackageInfo]
forall a b. b -> Either a b
Right [InstalledPackageInfo
pkg | ([String]
_, InstalledPackageInfo
pkg) <- [([String], InstalledPackageInfo)]
ok]
        ([NonEmpty String]
msgss, [([String], InstalledPackageInfo)]
_) -> [String] -> Either [String] [InstalledPackageInfo]
forall a b. a -> Either a b
Left ((NonEmpty String -> [String]) -> [NonEmpty String] -> [String]
forall m a. Monoid m => (a -> m) -> [a] -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap NonEmpty String -> [String]
forall a. NonEmpty a -> [a]
NE.toList [NonEmpty String]
msgss)

    splitPkgs :: String -> [String]
    splitPkgs :: String -> [String]
splitPkgs = ([String] -> String) -> [[String]] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map [String] -> String
unlines ([[String]] -> [String])
-> (String -> [[String]]) -> String -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> Bool) -> [String] -> [[String]]
forall a. (a -> Bool) -> [a] -> [[a]]
splitWith (String
"---" String -> String -> Bool
forall a. Eq a => a -> a -> Bool
==) ([String] -> [[String]])
-> (String -> [String]) -> String -> [[String]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [String]
lines
      where
        splitWith :: (a -> Bool) -> [a] -> [[a]]
        splitWith :: forall a. (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 :: SymbolicPath Pkg ('Dir Build)
odir = LocalBuildInfo -> SymbolicPath Pkg ('Dir Build)
buildDir LocalBuildInfo
lbi
      bi :: BuildInfo
bi = Library -> BuildInfo
libBuildInfo Library
lib
      srcDirs :: [String]
srcDirs = (SymbolicPathX 'AllowAbsolute Pkg ('Dir Source) -> String)
-> [SymbolicPathX 'AllowAbsolute Pkg ('Dir Source)] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map SymbolicPathX 'AllowAbsolute Pkg ('Dir Source) -> String
forall {allowAbsolute :: AllowAbsolute} {from} {to :: FileOrDir}.
SymbolicPathX allowAbsolute from to -> String
u (BuildInfo -> [SymbolicPathX 'AllowAbsolute Pkg ('Dir Source)]
hsSourceDirs BuildInfo
bi) [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [SymbolicPath Pkg ('Dir Build) -> String
forall {allowAbsolute :: AllowAbsolute} {from} {to :: FileOrDir}.
SymbolicPathX allowAbsolute from to -> String
u SymbolicPath Pkg ('Dir Build)
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
      u :: SymbolicPathX allowAbsolute from to -> String
u = SymbolicPathX allowAbsolute from to -> String
forall {allowAbsolute :: AllowAbsolute} {from} {to :: FileOrDir}.
SymbolicPathX allowAbsolute from to -> String
interpretSymbolicPathCWD -- See Note [Symbolic paths] in Distribution.Utils.Path
  Verbosity
-> Maybe (SymbolicPath CWD ('Dir Pkg))
-> Program
-> ProgramDb
-> [String]
-> IO ()
forall to.
Verbosity
-> Maybe (SymbolicPath CWD ('Dir to))
-> Program
-> ProgramDb
-> [String]
-> IO ()
runDbProgramCwd Verbosity
verbosity (LocalBuildInfo -> Maybe (SymbolicPath CWD ('Dir Pkg))
mbWorkDirLBI LocalBuildInfo
lbi) Program
haskellSuiteProgram ProgramDb
progdb ([String] -> IO ()) -> [String] -> IO ()
forall a b. (a -> b) -> a -> b
$
    [String
"compile", String
"--build-dir", SymbolicPath Pkg ('Dir Build) -> String
forall {allowAbsolute :: AllowAbsolute} {from} {to :: FileOrDir}.
SymbolicPathX allowAbsolute from to -> String
u SymbolicPath Pkg ('Dir Build)
odir]
      [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [[String]] -> [String]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[String
"-i", String
d] | String
d <- [String]
srcDirs]
      [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [[String]] -> [String]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
        [ [String
"-I", String
d]
        | String
d <-
            [ SymbolicPathX 'AllowAbsolute Pkg ('Dir Source) -> String
forall {allowAbsolute :: AllowAbsolute} {from} {to :: FileOrDir}.
SymbolicPathX allowAbsolute from to -> String
u (SymbolicPathX 'AllowAbsolute Pkg ('Dir Source) -> String)
-> SymbolicPathX 'AllowAbsolute Pkg ('Dir Source) -> String
forall a b. (a -> b) -> a -> b
$ LocalBuildInfo
-> ComponentLocalBuildInfo
-> SymbolicPathX 'AllowAbsolute Pkg ('Dir Source)
autogenComponentModulesDir LocalBuildInfo
lbi ComponentLocalBuildInfo
clbi
            , SymbolicPathX 'AllowAbsolute Pkg ('Dir Source) -> String
forall {allowAbsolute :: AllowAbsolute} {from} {to :: FileOrDir}.
SymbolicPathX allowAbsolute from to -> String
u (SymbolicPathX 'AllowAbsolute Pkg ('Dir Source) -> String)
-> SymbolicPathX 'AllowAbsolute Pkg ('Dir Source) -> String
forall a b. (a -> b) -> a -> b
$ LocalBuildInfo -> SymbolicPathX 'AllowAbsolute Pkg ('Dir Source)
autogenPackageModulesDir LocalBuildInfo
lbi
            , SymbolicPath Pkg ('Dir Build) -> String
forall {allowAbsolute :: AllowAbsolute} {from} {to :: FileOrDir}.
SymbolicPathX allowAbsolute from to -> String
u SymbolicPath Pkg ('Dir Build)
odir
            ]
              [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ (SymbolicPathX 'AllowAbsolute Pkg ('Dir Include) -> String)
-> [SymbolicPathX 'AllowAbsolute Pkg ('Dir Include)] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map SymbolicPathX 'AllowAbsolute Pkg ('Dir Include) -> String
forall {allowAbsolute :: AllowAbsolute} {from} {to :: FileOrDir}.
SymbolicPathX allowAbsolute from to -> String
u (BuildInfo -> [SymbolicPathX 'AllowAbsolute Pkg ('Dir Include)]
includeDirs BuildInfo
bi)
        ]
      [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [PackageDBX (SymbolicPath Pkg ('Dir PkgDB)) -> String
forall from. PackageDBX (SymbolicPath from ('Dir PkgDB)) -> String
packageDbOpt PackageDBX (SymbolicPath Pkg ('Dir PkgDB))
pkgDb | PackageDBX (SymbolicPath Pkg ('Dir PkgDB))
pkgDb <- PackageDBStack
dbStack]
      [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String
"--package-name", PackageIdentifier -> String
forall a. Pretty a => a -> String
prettyShow PackageIdentifier
pkgid]
      [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [[String]] -> [String]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
        [ [String
"--package-id", UnitId -> String
forall a. Pretty a => a -> String
prettyShow UnitId
ipkgid]
        | (UnitId
ipkgid, MungedPackageId
_) <- ComponentLocalBuildInfo -> [(UnitId, MungedPackageId)]
componentPackageDeps ComponentLocalBuildInfo
clbi
        ]
      [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String
"-G", Language -> String
forall a. Pretty a => a -> String
prettyShow Language
language]
      [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [[String]] -> [String]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[String
"-X", Extension -> String
forall a. Pretty a => a -> String
prettyShow Extension
ex] | Extension
ex <- BuildInfo -> [Extension]
usedExtensions BuildInfo
bi]
      [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ BuildInfo -> [String]
cppOptions (Library -> BuildInfo
libBuildInfo Library
lib)
      [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [ModuleName -> String
forall a. Pretty a => a -> String
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
-> String
-> String
-> String
-> PackageDescription
-> Library
-> ComponentLocalBuildInfo
-> IO ()
installLib Verbosity
verbosity LocalBuildInfo
lbi String
targetDir String
dynlibTargetDir String
builtDir PackageDescription
pkg Library
lib ComponentLocalBuildInfo
clbi = do
  let progdb :: ProgramDb
progdb = LocalBuildInfo -> ProgramDb
withPrograms LocalBuildInfo
lbi
      wdir :: Maybe (SymbolicPath CWD ('Dir Pkg))
wdir = LocalBuildInfo -> Maybe (SymbolicPath CWD ('Dir Pkg))
mbWorkDirLBI LocalBuildInfo
lbi
  Verbosity
-> Maybe (SymbolicPath CWD ('Dir Pkg))
-> Program
-> ProgramDb
-> [String]
-> IO ()
forall to.
Verbosity
-> Maybe (SymbolicPath CWD ('Dir to))
-> Program
-> ProgramDb
-> [String]
-> IO ()
runDbProgramCwd Verbosity
verbosity Maybe (SymbolicPath CWD ('Dir Pkg))
wdir Program
haskellSuitePkgProgram ProgramDb
progdb ([String] -> IO ()) -> [String] -> IO ()
forall a b. (a -> b) -> a -> b
$
    [ String
"install-library"
    , String
"--build-dir"
    , String
builtDir
    , String
"--target-dir"
    , String
targetDir
    , String
"--dynlib-target-dir"
    , String
dynlibTargetDir
    , String
"--package-id"
    , PackageIdentifier -> String
forall a. Pretty a => a -> String
prettyShow (PackageIdentifier -> String) -> PackageIdentifier -> String
forall a b. (a -> b) -> a -> b
$ PackageDescription -> PackageIdentifier
forall pkg. Package pkg => pkg -> PackageIdentifier
packageId PackageDescription
pkg
    ]
      [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ (ModuleName -> String) -> [ModuleName] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map ModuleName -> String
forall a. Pretty a => a -> String
prettyShow (Library -> ComponentLocalBuildInfo -> [ModuleName]
allLibModules Library
lib ComponentLocalBuildInfo
clbi)

registerPackage
  :: Verbosity
  -> ProgramDb
  -> PackageDBStackS from
  -> InstalledPackageInfo
  -> IO ()
registerPackage :: forall from.
Verbosity
-> ProgramDb
-> PackageDBStackS from
-> InstalledPackageInfo
-> IO ()
registerPackage Verbosity
verbosity ProgramDb
progdb PackageDBStackS from
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 -> [String] -> ProgramInvocation
programInvocation
        ConfiguredProgram
hspkg
        [String
"update", PackageDBX (SymbolicPath from ('Dir PkgDB)) -> String
forall from. PackageDBX (SymbolicPath from ('Dir PkgDB)) -> String
packageDbOpt (PackageDBX (SymbolicPath from ('Dir PkgDB)) -> String)
-> PackageDBX (SymbolicPath from ('Dir PkgDB)) -> String
forall a b. (a -> b) -> a -> b
$ PackageDBStackS from -> PackageDBX (SymbolicPath from ('Dir PkgDB))
forall from. PackageDBStackX from -> PackageDBX from
registrationPackageDB PackageDBStackS from
packageDbs]
    )
      { progInvokeInput = Just $ IODataText $ showInstalledPackageInfo installedPkgInfo
      }

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

packageDbOpt :: PackageDBX (SymbolicPath from (Dir PkgDB)) -> String
packageDbOpt :: forall from. PackageDBX (SymbolicPath from ('Dir PkgDB)) -> String
packageDbOpt PackageDBX (SymbolicPath from ('Dir PkgDB))
GlobalPackageDB = String
"--global"
packageDbOpt PackageDBX (SymbolicPath from ('Dir PkgDB))
UserPackageDB = String
"--user"
packageDbOpt (SpecificPackageDB SymbolicPath from ('Dir PkgDB)
db) = String
"--package-db=" String -> String -> String
forall a. [a] -> [a] -> [a]
++ SymbolicPath from ('Dir PkgDB) -> String
forall {allowAbsolute :: AllowAbsolute} {from} {to :: FileOrDir}.
SymbolicPathX allowAbsolute from to -> String
interpretSymbolicPathCWD SymbolicPath from ('Dir PkgDB)
db