module Package.C.Build.Tree ( buildByName
                            ) where

import           Control.Recursion
import           CPkgPrelude
import           Data.Containers.ListUtils (nubOrd)
import           Data.List                 (isInfixOf)
import           Package.C.Build
import           Package.C.Monad
import           Package.C.PackageSet
import           Package.C.Type
import           Package.C.Type.Tree
import           System.Directory          (doesDirectoryExist)
import           System.FilePath           ((</>))

data BuildDirs = BuildDirs { BuildDirs -> [FilePath]
libraries :: [FilePath]
                           , BuildDirs -> [FilePath]
share     :: [FilePath]
                           , BuildDirs -> [FilePath]
include   :: [FilePath]
                           , BuildDirs -> [FilePath]
binaries  :: [FilePath]
                           }

getAll :: [BuildDirs] -> BuildDirs
getAll :: [BuildDirs] -> BuildDirs
getAll [BuildDirs]
bds =
    let go :: (BuildDirs -> [a]) -> [a]
go BuildDirs -> [a]
f = [[a]] -> [a]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat (BuildDirs -> [a]
f (BuildDirs -> [a]) -> [BuildDirs] -> [[a]]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [BuildDirs]
bds)
    in [FilePath] -> [FilePath] -> [FilePath] -> [FilePath] -> BuildDirs
BuildDirs ((BuildDirs -> [FilePath]) -> [FilePath]
forall {a}. (BuildDirs -> [a]) -> [a]
go BuildDirs -> [FilePath]
libraries) ((BuildDirs -> [FilePath]) -> [FilePath]
forall {a}. (BuildDirs -> [a]) -> [a]
go BuildDirs -> [FilePath]
share) ((BuildDirs -> [FilePath]) -> [FilePath]
forall {a}. (BuildDirs -> [a]) -> [a]
go BuildDirs -> [FilePath]
include) ((BuildDirs -> [FilePath]) -> [FilePath]
forall {a}. (BuildDirs -> [a]) -> [a]
go BuildDirs -> [FilePath]
binaries)

-- in order to prevent the "vanilla" libffi from preceding the *cross* libffi,
-- we filter out any directory that doesn't contain the target triple. this
-- causes further bugs and it's slow
--
-- Really we should allow *all* libdirs for Python/Perl here, since they won't
-- (hopefully) pollute the pkg-config path...
immoralFilter :: Maybe TargetTriple -> [FilePath] -> [FilePath]
immoralFilter :: Maybe TargetTriple -> [FilePath] -> [FilePath]
immoralFilter Maybe TargetTriple
Nothing [FilePath]
fps = [FilePath]
fps
immoralFilter (Just TargetTriple
tgt') [FilePath]
fps =
    let infixDir :: FilePath
infixDir = TargetTriple -> FilePath
forall a. Show a => a -> FilePath
show TargetTriple
tgt'
    in (FilePath -> Bool) -> [FilePath] -> [FilePath]
forall a. (a -> Bool) -> [a] -> [a]
filter (\FilePath
fp -> FilePath
infixDir FilePath -> FilePath -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isInfixOf` FilePath
fp Bool -> Bool -> Bool
|| FilePath
"meson" FilePath -> FilePath -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isInfixOf` FilePath
fp Bool -> Bool -> Bool
|| FilePath
"XML-Parser" FilePath -> FilePath -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isInfixOf` FilePath
fp Bool -> Bool -> Bool
|| FilePath
"python3" FilePath -> FilePath -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isInfixOf` FilePath
fp) [FilePath]
fps -- FIXME: more principled approach

-- filter out stuff from the path
filterCross :: Maybe TargetTriple -> [FilePath] -> [FilePath]
filterCross :: Maybe TargetTriple -> [FilePath] -> [FilePath]
filterCross Maybe TargetTriple
Nothing = [FilePath] -> [FilePath]
forall a. a -> a
id
filterCross (Just TargetTriple
tgt') =
    let infixDir :: FilePath
infixDir = TargetTriple -> FilePath
forall a. Show a => a -> FilePath
show TargetTriple
tgt'
    in (FilePath -> Bool) -> [FilePath] -> [FilePath]
forall a. (a -> Bool) -> [a] -> [a]
filter (\FilePath
fp -> Bool -> Bool
not (FilePath
infixDir FilePath -> FilePath -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isInfixOf` FilePath
fp) Bool -> Bool -> Bool
|| FilePath
"ncurses" FilePath -> FilePath -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isInfixOf` FilePath
fp)

buildWithContext :: DepTree CPkg
                 -> Maybe TargetTriple
                 -> Bool -- ^ Should we build static libraries?
                 -> Bool -- ^ Install globally
                 -> PkgM ()
buildWithContext :: DepTree CPkg -> Maybe TargetTriple -> Bool -> Bool -> PkgM ()
buildWithContext DepTree CPkg
cTree Maybe TargetTriple
host Bool
sta Bool
glob = (Base (DepTree CPkg) BuildDirs
 -> StateT InstallDb (ReaderT Verbosity IO) BuildDirs)
-> (Base (DepTree CPkg) (BuildDirs, ()) -> PkgM ())
-> DepTree CPkg
-> PkgM ()
forall t (m :: * -> *) b a.
(Recursive t, Traversable (Base t), Monad m) =>
(Base t b -> m b) -> (Base t (b, a) -> m a) -> t -> m a
zygoM' Base (DepTree CPkg) BuildDirs
-> StateT InstallDb (ReaderT Verbosity IO) BuildDirs
DepTreeF CPkg BuildDirs
-> StateT InstallDb (ReaderT Verbosity IO) BuildDirs
dirAlg Base (DepTree CPkg) (BuildDirs, ()) -> PkgM ()
DepTreeF CPkg (BuildDirs, ()) -> PkgM ()
buildAlg DepTree CPkg
cTree

    where buildAlg :: DepTreeF CPkg (BuildDirs, ()) -> PkgM ()
          buildAlg :: DepTreeF CPkg (BuildDirs, ()) -> PkgM ()
buildAlg (DepNodeF CPkg
c Bool
usr [(BuildDirs, ())]
preBds) =
            CPkg
-> Maybe TargetTriple
-> Bool
-> Bool
-> Bool
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> PkgM ()
buildCPkg CPkg
c Maybe TargetTriple
host Bool
sta Bool
glob Bool
usr [FilePath]
ds (Maybe TargetTriple -> [FilePath] -> [FilePath]
immoralFilter Maybe TargetTriple
host [FilePath]
ls) [FilePath]
is (Maybe TargetTriple -> [FilePath] -> [FilePath]
filterCross Maybe TargetTriple
host [FilePath]
bs)
                where (BuildDirs [FilePath]
ls [FilePath]
ds [FilePath]
is [FilePath]
bs) = [BuildDirs] -> BuildDirs
getAll ((BuildDirs, ()) -> BuildDirs
forall a b. (a, b) -> a
fst ((BuildDirs, ()) -> BuildDirs) -> [(BuildDirs, ())] -> [BuildDirs]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(BuildDirs, ())]
preBds)
          buildAlg (BldDepNodeF CPkg
c [(BuildDirs, ())]
preBds) =
            CPkg
-> Maybe TargetTriple
-> Bool
-> Bool
-> Bool
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> PkgM ()
buildCPkg CPkg
c Maybe TargetTriple
forall a. Maybe a
Nothing Bool
False Bool
False Bool
False [FilePath]
ds [FilePath]
ls [FilePath]
is [FilePath]
bs -- don't use static libraries for build dependencies
            -- also don't install them globally
            -- build dependencies are not manual!
                where (BuildDirs [FilePath]
ls [FilePath]
ds [FilePath]
is [FilePath]
bs) = [BuildDirs] -> BuildDirs
getAll ((BuildDirs, ()) -> BuildDirs
forall a b. (a, b) -> a
fst ((BuildDirs, ()) -> BuildDirs) -> [(BuildDirs, ())] -> [BuildDirs]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(BuildDirs, ())]
preBds)

          mkBuildDirs :: MonadIO m => FilePath -> BuildDirs -> m BuildDirs
          mkBuildDirs :: forall (m :: * -> *).
MonadIO m =>
FilePath -> BuildDirs -> m BuildDirs
mkBuildDirs FilePath
pkgDir (BuildDirs [FilePath]
ls [FilePath]
ds [FilePath]
is [FilePath]
bs) = do
            let linkDir :: FilePath
linkDir = FilePath
pkgDir FilePath -> FilePath -> FilePath
</> FilePath
"lib"
                linkDir64 :: FilePath
linkDir64 = FilePath
pkgDir FilePath -> FilePath -> FilePath
</> FilePath
"lib64"
                includeDir :: FilePath
includeDir = FilePath
pkgDir FilePath -> FilePath -> FilePath
</> FilePath
"include"
                dataDir :: FilePath
dataDir = FilePath
pkgDir FilePath -> FilePath -> FilePath
</> FilePath
"share"
                binDir :: FilePath
binDir = FilePath
pkgDir FilePath -> FilePath -> FilePath
</> FilePath
"bin"

            Bool
binExists <- IO Bool -> m Bool
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (FilePath -> IO Bool
doesDirectoryExist FilePath
binDir)
            let bins :: [FilePath]
bins = if Bool
binExists
                then FilePath
binDir FilePath -> [FilePath] -> [FilePath]
forall a. a -> [a] -> [a]
: [FilePath]
bs
                else [FilePath]
bs

            Bool
shareExists <- IO Bool -> m Bool
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (FilePath -> IO Bool
doesDirectoryExist FilePath
dataDir)
            let shares :: [FilePath]
shares = if Bool
shareExists
                then FilePath
dataDir FilePath -> [FilePath] -> [FilePath]
forall a. a -> [a] -> [a]
: [FilePath]
ds
                else [FilePath]
ds

            Bool
linkExists <- IO Bool -> m Bool
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (FilePath -> IO Bool
doesDirectoryExist FilePath
linkDir)
            Bool
link64Exists <- IO Bool -> m Bool
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (FilePath -> IO Bool
doesDirectoryExist FilePath
linkDir64)

            let linkAppend :: [FilePath] -> [FilePath]
linkAppend = if Bool
linkExists
                then (FilePath
linkDir FilePath -> [FilePath] -> [FilePath]
forall a. a -> [a] -> [a]
:)
                else [FilePath] -> [FilePath]
forall a. a -> a
id
            let link64Append :: [FilePath] -> [FilePath]
link64Append = if Bool
link64Exists
                then (FilePath
linkDir64 FilePath -> [FilePath] -> [FilePath]
forall a. a -> [a] -> [a]
:)
                else [FilePath] -> [FilePath]
forall a. a -> a
id

            let links :: [FilePath]
links = [FilePath] -> [FilePath]
link64Append ([FilePath] -> [FilePath]
linkAppend [FilePath]
ls)

            Bool
includeExists <- IO Bool -> m Bool
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (FilePath -> IO Bool
doesDirectoryExist FilePath
includeDir)
            let includes :: [FilePath]
includes = if Bool
includeExists
                then FilePath
includeDir FilePath -> [FilePath] -> [FilePath]
forall a. a -> [a] -> [a]
: [FilePath]
is
                else [FilePath]
is

            BuildDirs -> m BuildDirs
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([FilePath] -> [FilePath] -> [FilePath] -> [FilePath] -> BuildDirs
BuildDirs ([FilePath] -> [FilePath]
forall a. Ord a => [a] -> [a]
nubOrd [FilePath]
links) ([FilePath] -> [FilePath]
forall a. Ord a => [a] -> [a]
nubOrd [FilePath]
shares) ([FilePath] -> [FilePath]
forall a. Ord a => [a] -> [a]
nubOrd [FilePath]
includes) ([FilePath] -> [FilePath]
forall a. Ord a => [a] -> [a]
nubOrd [FilePath]
bins))

          dirAlg :: DepTreeF CPkg BuildDirs -> PkgM BuildDirs
          dirAlg :: DepTreeF CPkg BuildDirs
-> StateT InstallDb (ReaderT Verbosity IO) BuildDirs
dirAlg (DepNodeF CPkg
c Bool
_ [BuildDirs]
bds) = do

            let bldDirs :: BuildDirs
bldDirs@(BuildDirs [FilePath]
ls [FilePath]
ds [FilePath]
is [FilePath]
bs) = [BuildDirs] -> BuildDirs
getAll [BuildDirs]
bds

            BuildVars
buildVars <- Maybe TargetTriple
-> Bool
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> PkgM BuildVars
getVars Maybe TargetTriple
host Bool
sta [FilePath]
ds (Maybe TargetTriple -> [FilePath] -> [FilePath]
immoralFilter Maybe TargetTriple
host [FilePath]
ls) [FilePath]
is (Maybe TargetTriple -> [FilePath] -> [FilePath]
filterCross Maybe TargetTriple
host [FilePath]
bs)

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

            FilePath
-> BuildDirs -> StateT InstallDb (ReaderT Verbosity IO) BuildDirs
forall (m :: * -> *).
MonadIO m =>
FilePath -> BuildDirs -> m BuildDirs
mkBuildDirs FilePath
pkgDir BuildDirs
bldDirs

          dirAlg (BldDepNodeF CPkg
c [BuildDirs]
bds) = do

            let bldDirs :: BuildDirs
bldDirs@(BuildDirs [FilePath]
ls [FilePath]
ds [FilePath]
is [FilePath]
bs) = [BuildDirs] -> BuildDirs
getAll [BuildDirs]
bds

            BuildVars
buildVars <- Maybe TargetTriple
-> Bool
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> [FilePath]
-> PkgM BuildVars
getVars Maybe TargetTriple
forall a. Maybe a
Nothing Bool
False [FilePath]
ds [FilePath]
ls [FilePath]
is [FilePath]
bs

            FilePath
pkgDir <- CPkg
-> Maybe TargetTriple
-> Bool
-> BuildVars
-> StateT InstallDb (ReaderT Verbosity IO) FilePath
forall (m :: * -> *).
MonadIO m =>
CPkg -> Maybe TargetTriple -> Bool -> BuildVars -> m FilePath
cPkgToDir CPkg
c Maybe TargetTriple
forall a. Maybe a
Nothing Bool
False BuildVars
buildVars

            FilePath
-> BuildDirs -> StateT InstallDb (ReaderT Verbosity IO) BuildDirs
forall (m :: * -> *).
MonadIO m =>
FilePath -> BuildDirs -> m BuildDirs
mkBuildDirs FilePath
pkgDir BuildDirs
bldDirs

-- TODO: should this parse a string into a TargetTriple instead?
-- | Manually install a package
buildByName :: PackId -> Maybe TargetTriple -> Maybe String -> Bool -> Bool -> PkgM ()
buildByName :: PackId
-> Maybe TargetTriple -> Maybe FilePath -> Bool -> Bool -> PkgM ()
buildByName PackId
pkId Maybe TargetTriple
host Maybe FilePath
pkSet Bool
sta Bool
glob = do
    DepTree CPkg
allPkgs <- IO (DepTree CPkg)
-> StateT InstallDb (ReaderT Verbosity IO) (DepTree CPkg)
forall a. IO a -> StateT InstallDb (ReaderT Verbosity IO) a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (PackId -> Maybe FilePath -> IO (DepTree CPkg)
pkgsM PackId
pkId Maybe FilePath
pkSet)
    DepTree CPkg -> Maybe TargetTriple -> Bool -> Bool -> PkgM ()
buildWithContext DepTree CPkg
allPkgs Maybe TargetTriple
host Bool
sta Bool
glob