module Package.C.Build ( buildCPkg
                       , getVars
                       , cPkgToDir
                       ) where

import           Control.Concurrent          (getNumCapabilities)
import           CPkgPrelude
import           Data.List                   (isInfixOf)
import           Data.Maybe                  (isJust)
import qualified Data.Text                   as T
import qualified Data.Text.IO                as TIO
import           Package.C.Build.OS
import           Package.C.Db.Register
import           Package.C.Fetch
import           Package.C.Logging
import           Package.C.Monad
import           Package.C.Type
import           System.Directory
import           System.Directory.Executable (mkExecutable)
import           System.Directory.Recursive  (getSubdirsRecursive)
import           System.FilePath             (takeDirectory, takeFileName, (</>))
import           System.FilePath.Glob
import           System.IO.Temp              (withSystemTempDirectory)
import           System.Process
import           System.Process.Ext

envVarSplit :: EnvVar -> (String, String)
envVarSplit :: EnvVar -> (String, String)
envVarSplit (EnvVar String
ev String
x) = (String
ev, String
x)

replaceSymlink :: FilePath -> FilePath -> IO ()
replaceSymlink :: String -> String -> IO ()
replaceSymlink String
actual String
link = do
    Bool
bf <- String -> IO Bool
doesFileExist String
link
    if Bool
bf
        then String -> IO ()
removeFile String
link
        else do
            Bool
bd <- String -> IO Bool
doesDirectoryExist String
link
            Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
bd (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ String -> IO ()
removeDirectoryLink String
link
    String -> String -> IO ()
createFileLink String
actual String
link

stepToProc :: FilePath -- ^ Package build directory
           -> FilePath -- ^ Package install directory
           -> Command
           -> PkgM ()
stepToProc :: String -> String -> Command -> PkgM ()
stepToProc String
fp String
_ (Call String
p [String]
as Maybe [EnvVar]
envs Maybe String
dir') = do
    let dir'' :: String
dir'' = String -> (String -> String) -> Maybe String -> String
forall b a. b -> (a -> b) -> Maybe a -> b
maybe String
fp (String
fp String -> String -> String
</>) Maybe String
dir'
        envVars :: Maybe [(String, String)]
envVars = (EnvVar -> (String, String)) -> [EnvVar] -> [(String, String)]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap EnvVar -> (String, String)
envVarSplit ([EnvVar] -> [(String, String)])
-> Maybe [EnvVar] -> Maybe [(String, String)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe [EnvVar]
envs
    String -> PkgM ()
forall (m :: * -> *).
(MonadReader Verbosity m, MonadIO m) =>
String -> m ()
putDiagnostic (String
"Running " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
p String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" with arguments " String -> String -> String
forall a. [a] -> [a] -> [a]
++ [String] -> String
unwords [String]
as String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" in directory " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
dir'' String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" with environment " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Maybe [(String, String)] -> String
forall a. Show a => a -> String
show Maybe [(String, String)]
envVars)
    CreateProcess -> PkgM ()
waitProcess (CreateProcess -> PkgM ()) -> CreateProcess -> PkgM ()
forall a b. (a -> b) -> a -> b
$ (String -> [String] -> CreateProcess
proc String
p [String]
as) { cwd = Just dir'', std_in = CreatePipe, env = envVars }
stepToProc String
dir' String
_ (MakeExecutable String
fp) = do
    String -> PkgM ()
forall (m :: * -> *).
(MonadReader Verbosity m, MonadIO m) =>
String -> m ()
putDiagnostic (String
"Marking " String -> String -> String
forall a. [a] -> [a] -> [a]
++ (String
dir' String -> String -> String
</> String
fp) String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" as executable...")
    IO () -> PkgM ()
forall a. IO a -> StateT InstallDb (ReaderT Verbosity IO) a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> PkgM ()) -> IO () -> PkgM ()
forall a b. (a -> b) -> a -> b
$ String -> IO ()
mkExecutable (String
dir' String -> String -> String
</> String
fp)
stepToProc String
dir' String
_ (CreateDirectory String
d) = do
    String -> PkgM ()
forall (m :: * -> *).
(MonadReader Verbosity m, MonadIO m) =>
String -> m ()
putDiagnostic (String
"Creating directory " String -> String -> String
forall a. [a] -> [a] -> [a]
++ (String
dir' String -> String -> String
</> String
d) String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"...")
    IO () -> PkgM ()
forall a. IO a -> StateT InstallDb (ReaderT Verbosity IO) a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> PkgM ()) -> IO () -> PkgM ()
forall a b. (a -> b) -> a -> b
$ Bool -> String -> IO ()
createDirectoryIfMissing Bool
True (String
dir' String -> String -> String
</> String
d)
stepToProc String
_ String
p (SymlinkBinary String
file') = do
    String
binDir <- (String -> String -> String
</> String
"bin") (String -> String)
-> StateT InstallDb (ReaderT Verbosity IO) String
-> StateT InstallDb (ReaderT Verbosity IO) String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> StateT InstallDb (ReaderT Verbosity IO) String
forall (m :: * -> *). MonadIO m => m String
globalPkgDir
    let actualBin :: String
actualBin = String
p String -> String -> String
</> String
file'
    IO () -> PkgM ()
forall a. IO a -> StateT InstallDb (ReaderT Verbosity IO) a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> PkgM ()) -> IO () -> PkgM ()
forall a b. (a -> b) -> a -> b
$ Bool -> String -> IO ()
createDirectoryIfMissing Bool
True String
binDir
    IO () -> PkgM ()
forall a. IO a -> StateT InstallDb (ReaderT Verbosity IO) a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> PkgM ()) -> IO () -> PkgM ()
forall a b. (a -> b) -> a -> b
$ String -> String -> IO ()
replaceSymlink String
actualBin (String
binDir String -> String -> String
</> String -> String
takeFileName String
file')
stepToProc String
_ String
p (SymlinkManpage String
file' Int
sec) = do
    String
manDir <- (String -> String -> String
</> (String
"share" String -> String -> String
</> String
"man" String -> String -> String
</> String
"man" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
sec)) (String -> String)
-> StateT InstallDb (ReaderT Verbosity IO) String
-> StateT InstallDb (ReaderT Verbosity IO) String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> StateT InstallDb (ReaderT Verbosity IO) String
forall (m :: * -> *). MonadIO m => m String
globalPkgDir
    let actualMan :: String
actualMan = String
p String -> String -> String
</> String
file'
    IO () -> PkgM ()
forall a. IO a -> StateT InstallDb (ReaderT Verbosity IO) a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> PkgM ()) -> IO () -> PkgM ()
forall a b. (a -> b) -> a -> b
$ Bool -> String -> IO ()
createDirectoryIfMissing Bool
True String
manDir
    IO () -> PkgM ()
forall a. IO a -> StateT InstallDb (ReaderT Verbosity IO) a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> PkgM ()) -> IO () -> PkgM ()
forall a b. (a -> b) -> a -> b
$ String -> String -> IO ()
replaceSymlink String
actualMan (String
manDir String -> String -> String
</> String -> String
takeFileName String
file')
stepToProc String
_ String
p (Symlink String
tgt' String
lnk) = do
    let linkAbs :: String
linkAbs = String
p String -> String -> String
</> String
lnk
    String -> PkgM ()
forall (m :: * -> *).
(MonadReader Verbosity m, MonadIO m) =>
String -> m ()
putDiagnostic (String
"Creating directory" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> String
takeDirectory String
linkAbs String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"...")
    IO () -> PkgM ()
forall a. IO a -> StateT InstallDb (ReaderT Verbosity IO) a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> PkgM ()) -> IO () -> PkgM ()
forall a b. (a -> b) -> a -> b
$ Bool -> String -> IO ()
createDirectoryIfMissing Bool
True (String -> String
takeDirectory String
linkAbs)
    -- TODO: diagnostics for symlinks
    IO () -> PkgM ()
forall a. IO a -> StateT InstallDb (ReaderT Verbosity IO) a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> PkgM ()) -> IO () -> PkgM ()
forall a b. (a -> b) -> a -> b
$ String -> String -> IO ()
replaceSymlink (String
p String -> String -> String
</> String
tgt') String
linkAbs
stepToProc String
dir' String
_ (Write Text
out String
fp) = do
    let fpAbs :: String
fpAbs = String
dir' String -> String -> String
</> String
fp
    String -> PkgM ()
forall (m :: * -> *).
(MonadReader Verbosity m, MonadIO m) =>
String -> m ()
putDiagnostic (String
"Writing\n" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Text -> String
T.unpack Text
out String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"\n in file" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
fpAbs)
    IO () -> PkgM ()
forall a. IO a -> StateT InstallDb (ReaderT Verbosity IO) a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (String -> Text -> IO ()
TIO.writeFile String
fpAbs Text
out)
stepToProc String
dir' String
p (CopyFile String
src' String
dest') = do
    let absSrc :: String
absSrc = String
dir' String -> String -> String
</> String
src'
        absDest :: String
absDest = String
p String -> String -> String
</> String
dest'
    String -> PkgM ()
forall (m :: * -> *).
(MonadReader Verbosity m, MonadIO m) =>
String -> m ()
putDiagnostic (String
"Copying file " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
absSrc String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" to " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
absDest String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"...")
    IO () -> PkgM ()
forall a. IO a -> StateT InstallDb (ReaderT Verbosity IO) a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> PkgM ()) -> IO () -> PkgM ()
forall a b. (a -> b) -> a -> b
$ Bool -> String -> IO ()
createDirectoryIfMissing Bool
True (String -> String
takeDirectory String
absDest)
    IO () -> PkgM ()
forall a. IO a -> StateT InstallDb (ReaderT Verbosity IO) a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> PkgM ()) -> IO () -> PkgM ()
forall a b. (a -> b) -> a -> b
$ String -> String -> IO ()
copyFileWithMetadata String
absSrc String
absDest
stepToProc String
dir' String
_ (Patch Text
contents') = do
    IO () -> PkgM ()
forall a. IO a -> StateT InstallDb (ReaderT Verbosity IO) a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> PkgM ()) -> IO () -> PkgM ()
forall a b. (a -> b) -> a -> b
$ String -> Text -> IO ()
TIO.writeFile (String
dir' String -> String -> String
</> String
"step.patch") Text
contents'
    CreateProcess -> PkgM ()
waitProcess (CreateProcess -> PkgM ()) -> CreateProcess -> PkgM ()
forall a b. (a -> b) -> a -> b
$ (String -> [String] -> CreateProcess
proc String
"patch" [String
"-p0", String
"-i", String
"step.patch"]) { cwd = Just dir' }

processSteps :: (Traversable t)
             => FilePath -- ^ Build directory
             -> FilePath -- ^ Install directory
             -> t Command
             -> PkgM ()
processSteps :: forall (t :: * -> *).
Traversable t =>
String -> String -> t Command -> PkgM ()
processSteps String
pkgDir String
instDir = (Command -> PkgM ()) -> t Command -> PkgM ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ (String -> String -> Command -> PkgM ()
stepToProc String
pkgDir String
instDir)

configureInDir :: CPkg
               -> BuildVars
               -> FilePath -- ^ Build directory
               -> PkgM ()
configureInDir :: CPkg -> BuildVars -> String -> PkgM ()
configureInDir CPkg
cpkg BuildVars
cfg String
p =

    let steps :: [Command]
steps = CPkg -> BuildVars -> [Command]
configureCommand CPkg
cpkg BuildVars
cfg
    in
        String -> PkgM ()
forall (m :: * -> *).
(MonadReader Verbosity m, MonadIO m) =>
String -> m ()
putNormal (String
"Configuring " String -> String -> String
forall a. [a] -> [a] -> [a]
++ CPkg -> String
pkgName CPkg
cpkg) PkgM () -> PkgM () -> PkgM ()
forall a b.
StateT InstallDb (ReaderT Verbosity IO) a
-> StateT InstallDb (ReaderT Verbosity IO) b
-> StateT InstallDb (ReaderT Verbosity IO) b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*>
        String -> String -> [Command] -> PkgM ()
forall (t :: * -> *).
Traversable t =>
String -> String -> t Command -> PkgM ()
processSteps String
p (BuildVars -> String
installDir BuildVars
cfg) [Command]
steps

buildInDir :: CPkg
           -> BuildVars
           -> FilePath -- ^ Build directory
           -> FilePath -- ^ Install directory
           -> PkgM ()
buildInDir :: CPkg -> BuildVars -> String -> String -> PkgM ()
buildInDir CPkg
cpkg BuildVars
cfg String
p String
p' = do
    String -> PkgM ()
forall (m :: * -> *).
(MonadReader Verbosity m, MonadIO m) =>
String -> m ()
putNormal (String
"Building " String -> String -> String
forall a. [a] -> [a] -> [a]
++ CPkg -> String
pkgName CPkg
cpkg)
    String -> String -> [Command] -> PkgM ()
forall (t :: * -> *).
Traversable t =>
String -> String -> t Command -> PkgM ()
processSteps String
p String
p' (CPkg -> BuildVars -> [Command]
buildCommand CPkg
cpkg BuildVars
cfg)

installInDir :: CPkg
             -> BuildVars
             -> FilePath -- ^ Build directory
             -> FilePath -- ^ Install directory
             -> PkgM ()
installInDir :: CPkg -> BuildVars -> String -> String -> PkgM ()
installInDir CPkg
cpkg BuildVars
cfg String
p String
p' =
    String -> PkgM ()
forall (m :: * -> *).
(MonadReader Verbosity m, MonadIO m) =>
String -> m ()
putNormal (String
"Installing " String -> String -> String
forall a. [a] -> [a] -> [a]
++ CPkg -> String
pkgName CPkg
cpkg) PkgM () -> PkgM () -> PkgM ()
forall a b.
StateT InstallDb (ReaderT Verbosity IO) a
-> StateT InstallDb (ReaderT Verbosity IO) b
-> StateT InstallDb (ReaderT Verbosity IO) b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*>
    String -> String -> [Command] -> PkgM ()
forall (t :: * -> *).
Traversable t =>
String -> String -> t Command -> PkgM ()
processSteps String
p String
p' (CPkg -> BuildVars -> [Command]
installCommand CPkg
cpkg BuildVars
cfg)

fetchCPkg :: CPkg
          -> FilePath -- ^ Directory for intermediate build files
          -> PkgM ()
fetchCPkg :: CPkg -> String -> PkgM ()
fetchCPkg CPkg
cpkg = String -> String -> String -> PkgM ()
fetchUrl (CPkg -> String
pkgUrl CPkg
cpkg) (CPkg -> String
pkgName CPkg
cpkg)

buildCPkg :: CPkg
          -> Maybe TargetTriple
          -> Bool -- ^ Should we build static libraries?
          -> Bool -- ^ Should we install globally?
          -> Bool -- ^ Was this package installed manually?
          -> [FilePath] -- ^ Shared data directories
          -> [FilePath] -- ^ Library directories
          -> [FilePath] -- ^ Include directories
          -> [FilePath] -- ^ Directories to add to @PATH@
          -> PkgM ()
buildCPkg :: CPkg
-> Maybe TargetTriple
-> Bool
-> Bool
-> Bool
-> [String]
-> [String]
-> [String]
-> [String]
-> PkgM ()
buildCPkg CPkg
cpkg Maybe TargetTriple
host Bool
sta Bool
glob Bool
usr [String]
shr [String]
libs [String]
incls [String]
bins = do

    BuildVars
buildVars <- Maybe TargetTriple
-> Bool
-> [String]
-> [String]
-> [String]
-> [String]
-> PkgM BuildVars
getVars Maybe TargetTriple
host Bool
sta [String]
shr [String]
libs [String]
incls [String]
bins

    -- TODO: use a real database
    Bool
installed <- CPkg
-> Maybe TargetTriple
-> Bool
-> BuildVars
-> StateT InstallDb (ReaderT Verbosity IO) Bool
forall (m :: * -> *).
(MonadIO m, MonadDb m) =>
CPkg -> Maybe TargetTriple -> Bool -> BuildVars -> m Bool
packageInstalled CPkg
cpkg Maybe TargetTriple
host Bool
glob BuildVars
buildVars

    Bool -> PkgM () -> PkgM ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
installed (PkgM () -> PkgM ()) -> PkgM () -> PkgM ()
forall a b. (a -> b) -> a -> b
$
        String -> PkgM ()
forall (m :: * -> *).
(MonadReader Verbosity m, MonadIO m) =>
String -> m ()
putDiagnostic (String
"Package " String -> String -> String
forall a. [a] -> [a] -> [a]
++ CPkg -> String
pkgName CPkg
cpkg String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" already installed, skipping.")

    Bool -> PkgM () -> PkgM ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
installed (PkgM () -> PkgM ()) -> PkgM () -> PkgM ()
forall a b. (a -> b) -> a -> b
$
        CPkg -> Maybe TargetTriple -> Bool -> Bool -> BuildVars -> PkgM ()
forceBuildCPkg CPkg
cpkg Maybe TargetTriple
host Bool
glob Bool
usr BuildVars
buildVars

getPreloads :: [ FilePath ] -> IO [ FilePath ]
getPreloads :: [String] -> IO [String]
getPreloads =
    ([[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 [[String]] -> [String]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat (IO [[String]] -> IO [String])
-> ([String] -> IO [[String]]) -> [String] -> IO [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> IO [String]) -> [String] -> IO [[String]]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse (\String
fp -> String -> IO [String]
namesMatching (String
fp String -> String -> String
</> String
"*.so"))

-- only really suitable for hashing at this point, since we use @""@ as the
-- install directory. we use this to get a hash which we then use to get the
-- *real* install directory, which we then use with @configureVars@ to set
-- things up correctly - otherwise we would have a circularity
getVars :: Maybe TargetTriple
        -> Bool -- ^ Should we build static libraries?
        -> [FilePath] -- ^ Shared data directories
        -> [FilePath] -- ^ Library directories
        -> [FilePath] -- ^ Include directories
        -> [FilePath] -- ^ Directories to add to @PATH@
        -> PkgM BuildVars
getVars :: Maybe TargetTriple
-> Bool
-> [String]
-> [String]
-> [String]
-> [String]
-> PkgM BuildVars
getVars Maybe TargetTriple
host Bool
sta [String]
shr [String]
links [String]
incls [String]
bins = do
    Int
nproc <- IO Int -> StateT InstallDb (ReaderT Verbosity IO) Int
forall a. IO a -> StateT InstallDb (ReaderT Verbosity IO) a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO Int
getNumCapabilities
    BuildVars -> PkgM BuildVars
forall a. a -> StateT InstallDb (ReaderT Verbosity IO) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (String
-> String
-> Maybe TargetTriple
-> Bool
-> [String]
-> [String]
-> [String]
-> [String]
-> [String]
-> OS
-> Arch
-> Bool
-> Int
-> BuildVars
BuildVars String
"" String
"" Maybe TargetTriple
host (Maybe TargetTriple -> Bool
forall a. Maybe a -> Bool
isJust Maybe TargetTriple
host) [String]
incls [] [String]
shr [String]
links [String]
bins OS
dhallOS Arch
dhallArch Bool
sta Int
nproc)
    -- we don't run getPreloads until later because that might be slow

-- diagnosticDirectory :: String -> (FilePath -> m a) -> m a
-- diagnosticDirectory s f = f (s ++ "-diagnostic")

getSubdirsWrap :: FilePath -> IO [FilePath]
getSubdirsWrap :: String -> IO [String]
getSubdirsWrap String
fp = do
    Bool
b <- String -> IO Bool
doesDirectoryExist String
fp
    if Bool
b
        then (String
fpString -> [String] -> [String]
forall a. a -> [a] -> [a]
:) ([String] -> [String]) -> IO [String] -> IO [String]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> IO [String]
getSubdirsRecursive String
fp
        else [String] -> IO [String]
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure []

-- TODO: more complicated solver, garbage collector, and all that.
-- Basically nix-style builds for C libraries
forceBuildCPkg :: CPkg
               -> Maybe TargetTriple
               -> Bool
               -> Bool -- ^ Manually installed?
               -> BuildVars
               -> PkgM ()
forceBuildCPkg :: CPkg -> Maybe TargetTriple -> Bool -> Bool -> BuildVars -> PkgM ()
forceBuildCPkg CPkg
cpkg Maybe TargetTriple
host Bool
glob Bool
usr BuildVars
buildVars = do

    String
pkgDir <- CPkg
-> Maybe TargetTriple
-> Bool
-> BuildVars
-> StateT InstallDb (ReaderT Verbosity IO) String
forall (m :: * -> *).
MonadIO m =>
CPkg -> Maybe TargetTriple -> Bool -> BuildVars -> m String
cPkgToDir CPkg
cpkg Maybe TargetTriple
host Bool
glob BuildVars
buildVars

    IO () -> PkgM ()
forall a. IO a -> StateT InstallDb (ReaderT Verbosity IO) a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> PkgM ()) -> IO () -> PkgM ()
forall a b. (a -> b) -> a -> b
$ Bool -> String -> IO ()
createDirectoryIfMissing Bool
True String
pkgDir

    String -> (String -> PkgM ()) -> PkgM ()
forall (m :: * -> *) a.
(MonadIO m, MonadMask m) =>
String -> (String -> m a) -> m a
withSystemTempDirectory String
"cpkg" ((String -> PkgM ()) -> PkgM ()) -> (String -> PkgM ()) -> PkgM ()
forall a b. (a -> b) -> a -> b
$ \String
p -> do
    -- diagnosticDirectory "cpkg" $ \p -> do

        String -> PkgM ()
forall (m :: * -> *).
(MonadReader Verbosity m, MonadIO m) =>
String -> m ()
putDiagnostic (String
"Setting up temporary directory in " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
p)

        CPkg -> String -> PkgM ()
fetchCPkg CPkg
cpkg String
p

        String
pAbs <- IO String -> StateT InstallDb (ReaderT Verbosity IO) String
forall a. IO a -> StateT InstallDb (ReaderT Verbosity IO) a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (String -> IO String
makeAbsolute String
p)

        let p' :: String
p' = String
pAbs String -> String -> String
</> CPkg -> String
pkgSubdir CPkg
cpkg

        [String]
lds <- IO [String] -> StateT InstallDb (ReaderT Verbosity IO) [String]
forall a. IO a -> StateT InstallDb (ReaderT Verbosity IO) a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [String] -> StateT InstallDb (ReaderT Verbosity IO) [String])
-> IO [String] -> StateT InstallDb (ReaderT Verbosity IO) [String]
forall a b. (a -> b) -> a -> b
$ do
            [String]
linkSubdirs <- [[String]] -> [String]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[String]] -> [String]) -> IO [[String]] -> IO [String]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (String -> IO [String]) -> [String] -> IO [[String]]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse String -> IO [String]
getSubdirsWrap (BuildVars -> [String]
linkDirs BuildVars
buildVars)
            -- FIXME: this seems stupid
            let curses :: String -> Bool
curses = Bool -> Bool
not (Bool -> Bool) -> (String -> Bool) -> String -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String
"curses" String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isInfixOf`)
            [String] -> IO [String]
getPreloads ([String] -> IO [String]) -> [String] -> IO [String]
forall a b. (a -> b) -> a -> b
$ (String -> Bool) -> [String] -> [String]
forall a. (a -> Bool) -> [a] -> [a]
filter String -> Bool
curses [String]
linkSubdirs

        let buildConfigured :: BuildVars
buildConfigured = BuildVars
buildVars { installDir = pkgDir, currentDir = pAbs, preloadLibs = lds }

        CPkg -> BuildVars -> String -> PkgM ()
configureInDir CPkg
cpkg BuildVars
buildConfigured String
p'

        CPkg -> BuildVars -> String -> String -> PkgM ()
buildInDir CPkg
cpkg BuildVars
buildConfigured String
p' String
pkgDir

        CPkg -> BuildVars -> String -> String -> PkgM ()
installInDir CPkg
cpkg BuildVars
buildConfigured String
p' String
pkgDir

        CPkg -> Maybe TargetTriple -> Bool -> Bool -> BuildVars -> PkgM ()
forall (m :: * -> *).
(MonadIO m, MonadDb m, MonadReader Verbosity m) =>
CPkg -> Maybe TargetTriple -> Bool -> Bool -> BuildVars -> m ()
registerPkg CPkg
cpkg Maybe TargetTriple
host Bool
glob Bool
usr BuildVars
buildVars -- not configured