{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards   #-}
{-# LANGUAGE TupleSections     #-}

-- | This module holds various functions for turning a package into a set of rules
-- or an 'IO ()'.
module Language.ATS.Package.Build ( mkPkg
                                  , build
                                  , buildAll
                                  , check
                                  ) where

import qualified Data.ByteString                 as BS
import qualified Data.ByteString.Lazy            as BSL
import           Data.List                       (intercalate)
import qualified Data.Text                       as T
import           Development.Shake               (alwaysRerun, getVerbosity)
import           Development.Shake.ATS
import           Development.Shake.C             (ccFromString)
import           Development.Shake.Check
import           Development.Shake.Clean
import           Development.Shake.Man
import           Distribution.ATS.Version
import           GHC.Conc
import           Language.ATS.Package.Build.C
import           Language.ATS.Package.Compiler
import           Language.ATS.Package.Config
import           Language.ATS.Package.Debian     hiding (libraries, target)
import           Language.ATS.Package.Dependency
import           Language.ATS.Package.Type
import           Quaalude
import           System.Info                     (os)

check :: Maybe String -> Maybe FilePath -> IO Bool
check :: Maybe String -> Maybe String -> IO Bool
check Maybe String
mStr Maybe String
p = do
    Version
v <- Maybe String -> Maybe String -> IO Version
wants Maybe String
mStr Maybe String
p
    let vs :: String
vs = Version -> String
forall a. Show a => a -> String
show Version
v
    String -> IO Bool
doesFileExist (String -> IO Bool) -> IO String -> IO Bool
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< String -> IO String
getAppUserDataDirectory (String
"atspkg" String -> String -> String
</> String
vs String -> String -> String
</> String
"ATS2-Postiats-gmp-" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
vs String -> String -> String
</> String
"bin" String -> String -> String
</> String
"patscc")

wants :: Maybe String -> Maybe FilePath -> IO Version
wants :: Maybe String -> Maybe String -> IO Version
wants Maybe String
mStr Maybe String
p = Pkg -> Version
compiler (Pkg -> Version) -> IO Pkg -> IO Version
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe String -> Maybe String -> IO Pkg
forall (m :: * -> *).
MonadIO m =>
Maybe String -> Maybe String -> m Pkg
getConfig Maybe String
mStr Maybe String
p

-- | Build in current directory or indicated directory
buildAll :: Int
         -> Maybe String
         -> Maybe String
         -> Maybe FilePath
         -> IO ()
buildAll :: Int -> Maybe String -> Maybe String -> Maybe String -> IO ()
buildAll Int
v Maybe String
mStr Maybe String
tgt' Maybe String
p = (IO () -> IO () -> IO ())
-> ((Version -> IO ()) -> IO ())
-> (Version -> IO ())
-> (Version -> IO ())
-> IO ()
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
on IO () -> IO () -> IO ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
(*>) ((Version -> IO ()) -> IO Version -> IO ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Maybe String -> Maybe String -> IO Version
wants Maybe String
mStr Maybe String
p) Version -> IO ()
fetchDef Version -> IO ()
setupDef
    where fetchDef :: Version -> IO ()
fetchDef = Version -> IO ()
fetchCompiler
          setupDef :: Version -> IO ()
setupDef = Verbosity -> SetupScript -> Maybe String -> Version -> IO ()
setupCompiler (Int -> Verbosity
toVerbosity Int
v) SetupScript
atslibSetup Maybe String
tgt'

build' :: FilePath -- ^ Directory
       -> Maybe String -- ^ Target triple
       -> Bool -- ^ Debug build?
       -> [String] -- ^ Targets
       -> IO ()
build' :: String -> Maybe String -> Bool -> [String] -> IO ()
build' String
dir Maybe String
tgt' Bool
dbg [String]
rs = String -> IO () -> IO ()
forall a. String -> IO a -> IO a
withCurrentDirectory String
dir ([IO ()] -> IO ()
mkPkgEmpty [IO ()]
forall a. Monoid a => a
mempty)
    where mkPkgEmpty :: [IO ()] -> IO ()
mkPkgEmpty [IO ()]
ts = Maybe String
-> Bool
-> Bool
-> Bool
-> [IO ()]
-> [String]
-> Maybe String
-> Bool
-> Int
-> IO ()
mkPkg Maybe String
forall a. Maybe a
Nothing Bool
False Bool
True Bool
False [IO ()]
ts [String]
rs Maybe String
tgt' Bool
dbg Int
1

-- | Build a set of targets
build :: Int
      -> Bool -- ^ Debug?
      -> [String] -- ^ Targets
      -> IO ()
build :: Int -> Bool -> [String] -> IO ()
build Int
v Bool
dbg [String]
rs = IO () -> IO () -> Bool -> IO ()
forall a. a -> a -> Bool -> a
bool ([IO ()] -> IO ()
mkPkgEmpty [Int -> Maybe String -> Maybe String -> Maybe String -> IO ()
buildAll Int
v Maybe String
forall a. Maybe a
Nothing Maybe String
forall a. Maybe a
Nothing Maybe String
forall a. Maybe a
Nothing]) ([IO ()] -> IO ()
mkPkgEmpty [IO ()]
forall a. Monoid a => a
mempty) (Bool -> IO ()) -> IO Bool -> IO ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Maybe String -> Maybe String -> IO Bool
check Maybe String
forall a. Maybe a
Nothing Maybe String
forall a. Maybe a
Nothing
    where mkPkgEmpty :: [IO ()] -> IO ()
mkPkgEmpty [IO ()]
ts = Maybe String
-> Bool
-> Bool
-> Bool
-> [IO ()]
-> [String]
-> Maybe String
-> Bool
-> Int
-> IO ()
mkPkg Maybe String
forall a. Maybe a
Nothing Bool
False Bool
True Bool
False [IO ()]
ts [String]
rs Maybe String
forall a. Maybe a
Nothing Bool
dbg Int
1

-- TODO clean generated ATS
mkClean :: Rules ()
mkClean :: Rules ()
mkClean = String
"clean" Located => String -> Action () -> Rules ()
String -> Action () -> Rules ()
~> do
    Action ()
cleanHaskell
    String -> [String] -> Action ()
removeFilesAfter String
"." [String
"//*.1", String
"//*_dats.c", String
"//*_sats.c", String
"tags", String
"//*.a"]
    String -> [String] -> Action ()
removeFilesAfter String
"target" [String
"//*"]
    String -> [String] -> Action ()
removeFilesAfter String
".atspkg" [String
"//*"]
    String -> [String] -> Action ()
removeFilesAfter String
"ats-deps" [String
"//*"]

-- TODO take more arguments, in particular, include + library dirs
mkInstall :: Maybe String -- ^ Optional target triple
          -> Maybe String -- ^ Optional argument to @atspkg.dhall@
          -> Rules ()
mkInstall :: Maybe String -> Maybe String -> Rules ()
mkInstall Maybe String
tgt Maybe String
mStr =
    String
"install" Located => String -> Action () -> Rules ()
String -> Action () -> Rules ()
~> do
        Pkg
config <- Maybe String -> Maybe String -> Action Pkg
forall (m :: * -> *).
MonadIO m =>
Maybe String -> Maybe String -> m Pkg
getConfig Maybe String
mStr Maybe String
forall a. Maybe a
Nothing
        let libs' :: [String]
libs' = (Lib -> String) -> [Lib] -> [String]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Text -> String
unpack (Text -> String) -> (Lib -> Text) -> Lib -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lib -> Text
libTarget) ([Lib] -> [String]) -> (Pkg -> [Lib]) -> Pkg -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Pkg -> [Lib]
libraries (Pkg -> [String]) -> Pkg -> [String]
forall a b. (a -> b) -> a -> b
$ Pkg
config
            bins :: [String]
bins = (Bin -> String) -> [Bin] -> [String]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Text -> String
unpack (Text -> String) -> (Bin -> Text) -> Bin -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bin -> Text
target) ([Bin] -> [String]) -> (Pkg -> [Bin]) -> Pkg -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Pkg -> [Bin]
bin (Pkg -> [String]) -> Pkg -> [String]
forall a b. (a -> b) -> a -> b
$ Pkg
config
            incs :: [String]
incs = (((Text -> String) -> [Text] -> [String]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Text -> String
unpack ([Text] -> [String]) -> (Lib -> [Text]) -> Lib -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lib -> [Text]
includes) (Lib -> [String]) -> [Lib] -> [String]
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<<) ([Lib] -> [String]) -> (Pkg -> [Lib]) -> Pkg -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Pkg -> [Lib]
libraries (Pkg -> [String]) -> Pkg -> [String]
forall a b. (a -> b) -> a -> b
$ Pkg
config
            libDir :: String
libDir = String -> (String -> String) -> Maybe String -> String
forall b a. b -> (a -> b) -> Maybe a -> b
maybe String
forall a. Monoid a => a
mempty (String -> String -> String
forall a. Semigroup a => a -> a -> a
<> [Char
pathSeparator]) Maybe String
tgt
        Located => [String] -> Action ()
[String] -> Action ()
need ([String]
bins [String] -> [String] -> [String]
forall a. Semigroup a => a -> a -> a
<> [String]
libs')
        String
home <- IO String -> Action String
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO String -> Action String) -> IO String -> Action String
forall a b. (a -> b) -> a -> b
$ String -> IO String
getEnv String
"HOME"
        String
atspkgDir <- IO String -> Action String
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO String -> Action String) -> IO String -> Action String
forall a b. (a -> b) -> a -> b
$ String -> IO String
getAppUserDataDirectory String
"atspkg"
        let g :: String -> f String -> f String
g String
str = (String -> String) -> f String -> f String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (((String
home String -> String -> String
</> String
str) String -> String -> String
</>) (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String
takeFileName)
            binDest :: [String]
binDest =  String -> [String] -> [String]
forall (f :: * -> *). Functor f => String -> f String -> f String
g (String
".local" String -> String -> String
</> String
"bin") [String]
bins
            libDest :: [String]
libDest = ((String
atspkgDir String -> String -> String
</> String
libDir String -> String -> String
</> String
"lib") String -> String -> String
</>) (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String
takeFileName (String -> String) -> [String] -> [String]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [String]
libs'
            inclDest :: [String]
inclDest = ((String
atspkgDir String -> String -> String
</> String
"include") String -> String -> String
</>) (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String
takeFileName (String -> String) -> [String] -> [String]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [String]
incs
        (String -> String -> Action ())
-> [String] -> [String] -> Action ()
forall (m :: * -> *) a b c.
Applicative m =>
(a -> b -> m c) -> [a] -> [b] -> m ()
zipWithM_ Located => String -> String -> Action ()
String -> String -> Action ()
copyFile' ([String]
bins [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String]
libs' [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String]
incs) ([String]
binDest [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String]
libDest [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String]
inclDest)
        Bool
pa <- Action Bool
forall (m :: * -> *). MonadIO m => m Bool
pandoc
        case Pkg -> Maybe Text
man Pkg
config of
            Just Text
mt -> Bool -> Action () -> Action ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
pa (Action () -> Action ()) -> Action () -> Action ()
forall a b. (a -> b) -> a -> b
$ do
                let mt' :: String
mt' = Text -> String
manTarget Text
mt
                    manDestActual :: String
manDestActual = String -> String -> String
manDest String
home String
mt'
                Located => [String] -> Action ()
[String] -> Action ()
need [String
mt']
                Located => String -> String -> Action ()
String -> String -> Action ()
copyFile' String
mt' String
manDestActual
            Maybe Text
Nothing -> () -> Action ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
        Bool
co <- Action Bool
forall (m :: * -> *). MonadIO m => m Bool
compleat
        case Pkg -> Maybe Text
completions Pkg
config of
            Just Text
com -> Bool -> Action () -> Action ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
co (Action () -> Action ()) -> Action () -> Action ()
forall a b. (a -> b) -> a -> b
$ do
                let com' :: String
com' = Text -> String
unpack Text
com
                    comDest :: String
comDest = String
home String -> String -> String
</> String
".compleat" String -> String -> String
</> String -> String
takeFileName String
com'
                Located => [String] -> Action ()
[String] -> Action ()
need [String
com'] -- FIXME do this all in one step
                Located => String -> String -> Action ()
String -> String -> Action ()
copyFile' String
com' String
comDest
            Maybe Text
Nothing -> () -> Action ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()

manDest :: FilePath -> FilePath -> FilePath
manDest :: String -> String -> String
manDest String
home String
mt' =
    case String
os of
        String
"darwin" -> String
"/usr/local/share/man/man1" String -> String -> String
</> String -> String
takeFileName String
mt'
        String
"linux"  -> String
home String -> String -> String
</> String
".local" String -> String -> String
</> String
"share" String -> String -> String
</> String
"man" String -> String -> String
</> String
"man1" String -> String -> String
</> String -> String
takeFileName String
mt'
        String
_        -> String -> String
forall a. Located => String -> a
error String
"Don't know where to install manpages for your OS"

mkManpage :: Maybe String -> Rules ()
mkManpage :: Maybe String -> Rules ()
mkManpage Maybe String
mStr = do
    Pkg
c <- Maybe String -> Maybe String -> Rules Pkg
forall (m :: * -> *).
MonadIO m =>
Maybe String -> Maybe String -> m Pkg
getConfig Maybe String
mStr Maybe String
forall a. Maybe a
Nothing
    Bool
b <- Rules Bool
forall (m :: * -> *). MonadIO m => m Bool
pandoc
    case Pkg -> Maybe Text
man Pkg
c of
        Just Text
_ -> Bool -> Rules () -> Rules ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
b Rules ()
manpages
        Maybe Text
_      -> () -> Rules ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()

parens :: String -> String
parens :: String -> String
parens String
s = [String] -> String
forall (t :: * -> *) m. (Foldable t, Monoid m) => t m -> m
fold [ String
"(", String
s, String
")" ]

cfgFile :: FilePath
cfgFile :: String
cfgFile = String
".atspkg" String -> String -> String
</> String
"config"

cfgArgs :: FilePath
cfgArgs :: String
cfgArgs = String
".atspkg" String -> String -> String
</> String
"args"

dhallFile :: FilePath
dhallFile :: String
dhallFile = String
"atspkg.dhall"

-- FIXME this doesn't rebuild when it should; it should rebuild when
-- @atspkg.dhall@ changes.
getConfig :: MonadIO m => Maybe String -> Maybe FilePath -> m Pkg
getConfig :: Maybe String -> Maybe String -> m Pkg
getConfig Maybe String
mStr Maybe String
dir' = IO Pkg -> m Pkg
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Pkg -> m Pkg) -> IO Pkg -> m Pkg
forall a b. (a -> b) -> a -> b
$ do
    String
d <- String -> Maybe String -> String
forall a. a -> Maybe a -> a
fromMaybe (String -> Maybe String -> String)
-> IO String -> IO (Maybe String -> String)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (String -> String) -> IO String -> IO String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (String -> String -> String
</> String
dhallFile) IO String
getCurrentDirectory IO (Maybe String -> String) -> IO (Maybe String) -> IO String
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Maybe String -> IO (Maybe String)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe String
dir'
    let go :: String -> String
go = case Maybe String
mStr of { Just String
x -> (String -> String -> String
forall a. Semigroup a => a -> a -> a
<> (String
" " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String -> String
parens String
x)) ; Maybe String
Nothing -> String -> String
forall a. a -> a
id }
    Decoder Pkg -> Text -> IO Pkg
forall a. Decoder a -> Text -> IO a
input Decoder Pkg
forall a. FromDhall a => Decoder a
auto (String -> Text
T.pack (String -> String
go String
d))

manTarget :: Text -> FilePath
manTarget :: Text -> String
manTarget Text
m = Text -> String
unpack Text
m String -> String -> String
-<.> String
"1"

mkPhony :: Maybe String -> String -> (String -> String) -> (Pkg -> [Bin]) -> [String] -> Rules ()
mkPhony :: Maybe String
-> String
-> (String -> String)
-> (Pkg -> [Bin])
-> [String]
-> Rules ()
mkPhony Maybe String
mStr String
cmdStr String -> String
f Pkg -> [Bin]
select [String]
rs =
    String
cmdStr Located => String -> Action () -> Rules ()
String -> Action () -> Rules ()
~> do
        Pkg
config <- Maybe String -> Maybe String -> Action Pkg
forall (m :: * -> *).
MonadIO m =>
Maybe String -> Maybe String -> m Pkg
getConfig Maybe String
mStr Maybe String
forall a. Maybe a
Nothing
        let runs :: [String]
runs = [String] -> [String] -> Bool -> [String]
forall a. a -> a -> Bool -> a
bool ((String -> Bool) -> [String] -> [String]
forall a. (a -> Bool) -> [a] -> [a]
filter (String -> String -> Bool
forall a. Eq a => a -> a -> Bool
/= String
cmdStr) [String]
rs) ((Bin -> String) -> [Bin] -> [String]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Text -> String
unpack (Text -> String) -> (Bin -> Text) -> Bin -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bin -> Text
target) ([Bin] -> [String]) -> (Pkg -> [Bin]) -> Pkg -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Pkg -> [Bin]
select (Pkg -> [String]) -> Pkg -> [String]
forall a b. (a -> b) -> a -> b
$ Pkg
config) ([String]
rs [String] -> [String] -> Bool
forall a. Eq a => a -> a -> Bool
== [String
cmdStr])
        Located => [String] -> Action ()
[String] -> Action ()
need [String]
runs
        (String -> Action ()) -> [String] -> Action ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ String -> Action ()
forall args. (Located, CmdArguments args, Unit args) => args
cmd_ (String -> String
f (String -> String) -> [String] -> [String]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [String]
runs)

mkValgrind :: Maybe String -> [String] -> Rules ()
mkValgrind :: Maybe String -> [String] -> Rules ()
mkValgrind Maybe String
mStr = Maybe String
-> String
-> (String -> String)
-> (Pkg -> [Bin])
-> [String]
-> Rules ()
mkPhony Maybe String
mStr String
"valgrind" (String
"valgrind " String -> String -> String
forall a. Semigroup a => a -> a -> a
<>) Pkg -> [Bin]
bin

mkBench :: Maybe String -> [String] -> Rules ()
mkBench :: Maybe String -> [String] -> Rules ()
mkBench Maybe String
mStr = Maybe String
-> String
-> (String -> String)
-> (Pkg -> [Bin])
-> [String]
-> Rules ()
mkPhony Maybe String
mStr String
"bench" String -> String
forall a. a -> a
id Pkg -> [Bin]
bench

mkTest :: Maybe String -> [String] -> Rules ()
mkTest :: Maybe String -> [String] -> Rules ()
mkTest Maybe String
mStr = Maybe String
-> String
-> (String -> String)
-> (Pkg -> [Bin])
-> [String]
-> Rules ()
mkPhony Maybe String
mStr String
"test" String -> String
forall a. a -> a
id Pkg -> [Bin]
test

mkRun :: Maybe String -> [String] -> Rules ()
mkRun :: Maybe String -> [String] -> Rules ()
mkRun Maybe String
mStr = Maybe String
-> String
-> (String -> String)
-> (Pkg -> [Bin])
-> [String]
-> Rules ()
mkPhony Maybe String
mStr String
"run" String -> String
forall a. a -> a
id Pkg -> [Bin]
bin

toVerbosity :: Int -> Verbosity
toVerbosity :: Int -> Verbosity
toVerbosity Int
0 = Verbosity
Info
toVerbosity Int
1 = Verbosity
Info
toVerbosity Int
2 = Verbosity
Info
toVerbosity Int
3 = Verbosity
Verbose
toVerbosity Int
4 = Verbosity
Diagnostic
toVerbosity Int
_ = Verbosity
Diagnostic -- should be a warning

options :: Bool -- ^ Whether to rebuild all targets
        -> Bool -- ^ Whether to run the linter
        -> Bool -- ^ Whether to display profiling information for the build
        -> Int -- ^ Number of CPUs
        -> Int -- ^ Verbosity level
        -> [String] -- ^ A list of targets
        -> ShakeOptions
options :: Bool -> Bool -> Bool -> Int -> Int -> [String] -> ShakeOptions
options Bool
rba Bool
lint Bool
tim Int
cpus Int
v [String]
rs = ShakeOptions
shakeOptions { shakeFiles :: String
shakeFiles = String
".atspkg"
                                              , shakeThreads :: Int
shakeThreads = Int
cpus
                                              , shakeLint :: Maybe Lint
shakeLint = Maybe Lint -> Maybe Lint -> Bool -> Maybe Lint
forall a. a -> a -> Bool -> a
bool Maybe Lint
forall a. Maybe a
Nothing (Lint -> Maybe Lint
forall a. a -> Maybe a
Just Lint
LintBasic) Bool
lint
                                              , shakeVersion :: String
shakeVersion = Version -> String
showVersion Version
atspkgVersion
                                              , shakeRebuild :: [(Rebuild, String)]
shakeRebuild = Bool -> [String] -> [(Rebuild, String)]
rebuildTargets Bool
rba [String]
rs
                                              , shakeChange :: Change
shakeChange = Change
ChangeModtimeAndDigestInput
                                              , shakeVerbosity :: Verbosity
shakeVerbosity = Int -> Verbosity
toVerbosity Int
v
                                              , shakeTimings :: Bool
shakeTimings = Bool
tim
                                              }

rebuildTargets :: Bool -- ^ Force rebuild of all targets
               -> [String] -- ^ Targets
               -> [(Rebuild, String)]
rebuildTargets :: Bool -> [String] -> [(Rebuild, String)]
rebuildTargets Bool
rba [String]
rs = ((Bool, [(Rebuild, String)]) -> [(Rebuild, String)])
-> [(Bool, [(Rebuild, String)])] -> [(Rebuild, String)]
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (Bool, [(Rebuild, String)]) -> [(Rebuild, String)]
forall a. Monoid a => (Bool, a) -> a
g [ (Bool
rba, (Rebuild
RebuildNow ,) (String -> (Rebuild, String)) -> [String] -> [(Rebuild, String)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [String] -> [String]
patterns [String]
rs) ]
    where g :: (Bool, a) -> a
g (Bool
b, a
ts) = a -> a -> Bool -> a
forall a. a -> a -> Bool -> a
bool a
forall a. Monoid a => a
mempty a
ts Bool
b
          patterns :: [String] -> [String]
patterns = [[String] -> [String]] -> [String] -> [String]
forall (t :: * -> *) a. Foldable t => t (a -> a) -> a -> a
thread (String -> [String] -> [String]
forall a. (Semigroup a, IsString a) => a -> [a] -> [a]
mkPattern (String -> [String] -> [String])
-> [String] -> [[String] -> [String]]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [String
"c", String
"o", String
"so", String
"a", String
"deb"])
          mkPattern :: a -> [a] -> [a]
mkPattern a
ext = (a
"//*." a -> a -> a
forall a. Semigroup a => a -> a -> a
<> a
ext a -> [a] -> [a]
forall a. a -> [a] -> [a]
:)

cleanConfig :: (MonadIO m) => Maybe String -> [String] -> m Pkg
cleanConfig :: Maybe String -> [String] -> m Pkg
cleanConfig Maybe String
_ [String
"clean"] = Pkg -> m Pkg
forall (f :: * -> *) a. Applicative f => a -> f a
pure Pkg
forall a. Located => a
undefined
cleanConfig Maybe String
mStr [String]
_      = Maybe String -> Maybe String -> m Pkg
forall (m :: * -> *).
MonadIO m =>
Maybe String -> Maybe String -> m Pkg
getConfig Maybe String
mStr Maybe String
forall a. Maybe a
Nothing

mkPkg :: Maybe String -- ^ Optional argument to @atspkg.dhall@
      -> Bool -- ^ Force rebuild
      -> Bool -- ^ Run linter
      -> Bool -- ^ Print build profiling information
      -> [IO ()] -- ^ Setup
      -> [String] -- ^ Targets
      -> Maybe String -- ^ Target triple
      -> Bool -- ^ Debug build?
      -> Int -- ^ Verbosity
      -> IO ()
mkPkg :: Maybe String
-> Bool
-> Bool
-> Bool
-> [IO ()]
-> [String]
-> Maybe String
-> Bool
-> Int
-> IO ()
mkPkg Maybe String
mStr Bool
rba Bool
lint Bool
tim [IO ()]
setup [String]
rs Maybe String
tgt Bool
dbg Int
v = do
    Pkg
cfg <- Maybe String -> [String] -> IO Pkg
forall (m :: * -> *).
MonadIO m =>
Maybe String -> [String] -> m Pkg
cleanConfig Maybe String
mStr [String]
rs
    Int -> IO ()
setNumCapabilities (Int -> IO ()) -> IO Int -> IO ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< IO Int
getNumProcessors
    Int
cpus <- IO Int
getNumCapabilities
    let opt :: ShakeOptions
opt = Bool -> Bool -> Bool -> Int -> Int -> [String] -> ShakeOptions
options Bool
rba Bool
lint Bool
tim Int
cpus Int
v ([String] -> ShakeOptions) -> [String] -> ShakeOptions
forall a b. (a -> b) -> a -> b
$ Pkg -> Maybe String -> [String] -> [String]
pkgToTargets Pkg
cfg Maybe String
tgt [String]
rs
    ShakeOptions -> Rules () -> IO ()
shake ShakeOptions
opt (Rules () -> IO ()) -> Rules () -> IO ()
forall a b. (a -> b) -> a -> b
$
        [Rules ()] -> Rules ()
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, Monad m) =>
t (m a) -> m ()
sequence_
            [ Located => [String] -> Rules ()
[String] -> Rules ()
want (Pkg -> Maybe String -> [String] -> [String]
pkgToTargets Pkg
cfg Maybe String
tgt [String]
rs)
            , Rules ()
mkClean
            , Maybe String
-> [IO ()] -> [String] -> Maybe String -> Bool -> Pkg -> Rules ()
pkgToAction Maybe String
mStr [IO ()]
setup [String]
rs Maybe String
tgt Bool
dbg Pkg
cfg
            ]

mkConfig :: Maybe String -> Rules ()
mkConfig :: Maybe String -> Rules ()
mkConfig Maybe String
mStr = do

    Bool
shouldWrite' <- Maybe String -> String -> Rules Bool
forall (m :: * -> *) a.
(MonadIO m, Binary a) =>
a -> String -> m Bool
shouldWrite Maybe String
mStr String
cfgArgs

    String
cfgArgs Located => String -> (String -> Action ()) -> Rules ()
String -> (String -> Action ()) -> Rules ()
%> \String
out -> do
        Action ()
alwaysRerun
        Bool
exists <- IO Bool -> Action Bool
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (String -> IO Bool
doesFileExist String
out)
        if Bool -> Bool
not Bool
exists Bool -> Bool -> Bool
|| Bool
shouldWrite'
            then IO () -> Action ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (String -> ByteString -> IO ()
BSL.writeFile String
out (Maybe String -> ByteString
forall a. Binary a => a -> ByteString
encode Maybe String
mStr))
            else Action ()
forall a. Monoid a => a
mempty

    String
cfgFile Located => String -> (String -> Action ()) -> Rules ()
String -> (String -> Action ()) -> Rules ()
%> \String
out -> do
        Located => [String] -> Action ()
[String] -> Action ()
need [String
dhallFile, String
cfgArgs]
        let go :: String -> String
go = case Maybe String
mStr of { Just String
x -> (String -> String -> String
forall a. Semigroup a => a -> a -> a
<> (String
" " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String -> String
parens String
x)) ; Maybe String
Nothing -> String -> String
forall a. a -> a
id }
        Pkg
x <- IO Pkg -> Action Pkg
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Pkg -> Action Pkg) -> IO Pkg -> Action Pkg
forall a b. (a -> b) -> a -> b
$ Decoder Pkg -> Text -> IO Pkg
forall a. Decoder a -> Text -> IO a
input Decoder Pkg
forall a. FromDhall a => Decoder a
auto (String -> Text
T.pack (String -> String
go String
"./atspkg.dhall"))
        IO () -> Action ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> Action ()) -> IO () -> Action ()
forall a b. (a -> b) -> a -> b
$ String -> ByteString -> IO ()
BSL.writeFile String
out (Pkg -> ByteString
forall a. Binary a => a -> ByteString
encode (Pkg
x :: Pkg))

setTargets :: [String] -> [FilePath] -> Maybe Text -> Rules ()
setTargets :: [String] -> [String] -> Maybe Text -> Rules ()
setTargets [String]
rs [String]
bins Maybe Text
mt = Bool -> Rules () -> Rules ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when ([String] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [String]
rs) (Rules () -> Rules ()) -> Rules () -> Rules ()
forall a b. (a -> b) -> a -> b
$
    case Maybe Text
mt of
        (Just Text
m) -> Located => [String] -> Rules ()
[String] -> Rules ()
want ([String] -> Rules ()) -> (Bool -> [String]) -> Bool -> Rules ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> [String] -> Bool -> [String]
forall a. a -> a -> Bool -> a
bool [String]
bins (Text -> String
manTarget Text
m String -> [String] -> [String]
forall a. a -> [a] -> [a]
: [String]
bins) (Bool -> Rules ()) -> Rules Bool -> Rules ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Rules Bool
forall (m :: * -> *). MonadIO m => m Bool
pandoc
        Maybe Text
Nothing  -> Located => [String] -> Rules ()
[String] -> Rules ()
want [String]
bins

bits :: Maybe String -> Maybe String -> [String] -> Rules ()
bits :: Maybe String -> Maybe String -> [String] -> Rules ()
bits Maybe String
mStr Maybe String
tgt [String]
rs = [Rules ()] -> Rules ()
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, Monad m) =>
t (m a) -> m ()
sequence_ ([Maybe String -> Rules ()] -> Maybe String -> [Rules ()]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence [ Maybe String -> Rules ()
mkManpage, Maybe String -> Maybe String -> Rules ()
mkInstall Maybe String
tgt, Maybe String -> Rules ()
mkConfig ] Maybe String
mStr) Rules () -> Rules () -> Rules ()
forall a. Semigroup a => a -> a -> a
<>
    [Maybe String -> [String] -> Rules ()]
-> Maybe String -> [String] -> Rules ()
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
t (a -> b -> f ()) -> a -> b -> f ()
biaxe [ Maybe String -> [String] -> Rules ()
mkRun, Maybe String -> [String] -> Rules ()
mkTest, Maybe String -> [String] -> Rules ()
mkBench, Maybe String -> [String] -> Rules ()
mkValgrind ] Maybe String
mStr [String]
rs

pkgToTargets :: Pkg -> Maybe String -> [FilePath] -> [FilePath]
pkgToTargets :: Pkg -> Maybe String -> [String] -> [String]
pkgToTargets ~Pkg{Bool
[LibDep]
[Text]
[Lib]
[Bin]
[Src]
Maybe Text
Maybe Debian
Text
Solver
Version
$sel:atsLib:Pkg :: Pkg -> Bool
$sel:debPkg:Pkg :: Pkg -> Maybe Debian
$sel:extSolve:Pkg :: Pkg -> Solver
$sel:dynLink:Pkg :: Pkg -> Bool
$sel:atsSource:Pkg :: Pkg -> [Src]
$sel:atsFlags:Pkg :: Pkg -> [Text]
$sel:cflags:Pkg :: Pkg -> [Text]
$sel:ccompiler:Pkg :: Pkg -> Text
$sel:buildDeps:Pkg :: Pkg -> [LibDep]
$sel:clib:Pkg :: Pkg -> [LibDep]
$sel:dependencies:Pkg :: Pkg -> [LibDep]
$sel:version:Pkg :: Pkg -> Version
atsLib :: Bool
debPkg :: Maybe Debian
extSolve :: Solver
dynLink :: Bool
atsSource :: [Src]
atsFlags :: [Text]
cflags :: [Text]
ccompiler :: Text
buildDeps :: [LibDep]
clib :: [LibDep]
dependencies :: [LibDep]
compiler :: Version
version :: Version
completions :: Maybe Text
man :: Maybe Text
libraries :: [Lib]
bench :: [Bin]
test :: [Bin]
bin :: [Bin]
$sel:test:Pkg :: Pkg -> [Bin]
$sel:bench:Pkg :: Pkg -> [Bin]
$sel:completions:Pkg :: Pkg -> Maybe Text
$sel:man:Pkg :: Pkg -> Maybe Text
$sel:bin:Pkg :: Pkg -> [Bin]
$sel:libraries:Pkg :: Pkg -> [Lib]
$sel:compiler:Pkg :: Pkg -> Version
..} Maybe String
tgt [] = (Maybe String -> Text -> String
toTgt Maybe String
tgt (Text -> String) -> (Bin -> Text) -> Bin -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bin -> Text
target (Bin -> String) -> [Bin] -> [String]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Bin]
bin) [String] -> [String] -> [String]
forall a. Semigroup a => a -> a -> a
<> (Text -> String
unpack (Text -> String) -> (Lib -> Text) -> Lib -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lib -> Text
libTarget (Lib -> String) -> [Lib] -> [String]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Lib]
libraries) [String] -> [String] -> [String]
forall a. Semigroup a => a -> a -> a
<> (Text -> String
unpack (Text -> String) -> (Src -> Text) -> Src -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Src -> Text
cTarget (Src -> String) -> [Src] -> [String]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Src]
atsSource)
pkgToTargets Pkg
_  Maybe String
_ [String]
ts         = [String]
ts

noConstr :: ATSConstraint
noConstr :: ATSConstraint
noConstr = Maybe Version -> Maybe Version -> ATSConstraint
ATSConstraint Maybe Version
forall a. Maybe a
Nothing Maybe Version
forall a. Maybe a
Nothing

atslibSetup :: Maybe String -- ^ Optional target triple
            -> String -- ^ Library name
            -> FilePath -- ^ Filepath
            -> IO ()
atslibSetup :: SetupScript
atslibSetup Maybe String
tgt' String
lib' String
p = do

    String -> IO ()
putStrLn (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
"installing " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
lib' String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"..."
    [String]
subdirs <- (String
pString -> [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]
allSubdirs String
p
    String
pkgPath <- String -> Maybe String -> String
forall a. a -> Maybe a -> a
fromMaybe String
p (Maybe String -> String) -> IO (Maybe String) -> IO String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [String] -> String -> IO (Maybe String)
findFile [String]
subdirs String
dhallFile

    let installDir :: String
installDir = String -> String
takeDirectory String
pkgPath

    String -> Maybe String -> Bool -> [String] -> IO ()
build' String
installDir Maybe String
tgt' Bool
False [String
"install"]

-- | The directory @~/.atspkg@
pkgHome :: MonadIO m => CCompiler -> m String
pkgHome :: CCompiler -> m String
pkgHome CCompiler
cc' = IO String -> m String
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO String -> m String) -> IO String -> m String
forall a b. (a -> b) -> a -> b
$ String -> IO String
getAppUserDataDirectory (String
"atspkg" String -> String -> String
</> CCompiler -> String
ccToDir CCompiler
cc')

-- | The directory that will be @PATSHOME@.
patsHomeAtsPkg :: MonadIO m => Version -> m String
patsHomeAtsPkg :: Version -> m String
patsHomeAtsPkg Version
v = (String -> String) -> m String -> m String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (String -> String -> String
</> String
vs String -> String -> String
</> String
"ATS2-Postiats-gmp-" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
vs) (CCompiler -> m String
forall (m :: * -> *). MonadIO m => CCompiler -> m String
pkgHome (Maybe String -> Maybe String -> CCompiler
GCC Maybe String
forall a. Maybe a
Nothing Maybe String
forall a. Maybe a
Nothing))
    where vs :: String
vs = Version -> String
forall a. Show a => a -> String
show Version
v

home' :: MonadIO m => Version -- ^ Compiler version
                   -> Version -- ^ Library version
                   -> m String
home' :: Version -> Version -> m String
home' Version
compV Version
libV = do
    String
h <- Version -> m String
forall (m :: * -> *). MonadIO m => Version -> m String
patsHomeAtsPkg Version
compV
    String -> m String
forall (f :: * -> *) a. Applicative f => a -> f a
pure (String -> m String) -> String -> m String
forall a b. (a -> b) -> a -> b
$ String
h String -> String -> String
</> String
"lib" String -> String -> String
</> String
"ats2-postiats-" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Version -> String
forall a. Show a => a -> String
show Version
libV

-- | This is the @$PATSHOMELOCS@ variable to be passed to the shell.
patsHomeLocsAtsPkg :: Int -- ^ Depth to recurse
                   -> String
patsHomeLocsAtsPkg :: Int -> String
patsHomeLocsAtsPkg Int
n = String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
":" ((String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
".atspkg/contrib") (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String
"./" String -> String -> String
forall a. Semigroup a => a -> a -> a
<>) (String -> String) -> [String] -> [String]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [String]
g)
    where g :: [String]
g = [ [String] -> String
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$ Int -> String -> [String]
forall a. Int -> a -> [a]
replicate Int
i String
"../" | Int
i <- [Int
0..Int
n] ]

toTgt :: Maybe String -> Text -> String
toTgt :: Maybe String -> Text -> String
toTgt Maybe String
tgt = Maybe String -> String -> String
maybeTgt Maybe String
tgt (String -> String) -> (Text -> String) -> Text -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
unpack
    where maybeTgt :: Maybe String -> String -> String
maybeTgt (Just String
t) = (String -> String -> String
forall a. Semigroup a => a -> a -> a
<> (Char
'-' Char -> String -> String
forall a. a -> [a] -> [a]
: String
t))
          maybeTgt Maybe String
Nothing  = String -> String
forall a. a -> a
id

pkgToAction :: Maybe String -- ^ Optional extra expression to which we should apply @atspkg.dhall@
            -> [IO ()] -- ^ Setup actions to be performed
            -> [String] -- ^ Targets
            -> Maybe String -- ^ Optional compiler triple (overrides 'ccompiler')
            -> Bool -- ^ Debug build?
            -> Pkg -- ^ Package data type
            -> Rules ()
pkgToAction :: Maybe String
-> [IO ()] -> [String] -> Maybe String -> Bool -> Pkg -> Rules ()
pkgToAction Maybe String
mStr [IO ()]
setup [String]
rs Maybe String
tgt Bool
dbg ~(Pkg [Bin]
bs [Bin]
ts [Bin]
bnchs [Lib]
lbs Maybe Text
mt Maybe Text
_ Version
v Version
v' [LibDep]
ds [LibDep]
cds [LibDep]
bdeps Text
ccLocal [Text]
cf [Text]
af [Src]
as Bool
dl Solver
slv Maybe Debian
deb Bool
al) =

    Bool -> Rules () -> Rules ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless ([String]
rs [String] -> [String] -> Bool
forall a. Eq a => a -> a -> Bool
== [String
"clean"]) (Rules () -> Rules ()) -> Rules () -> Rules ()
forall a b. (a -> b) -> a -> b
$ do

        let cdps :: [LibDep]
cdps = if ([Bin] -> Bool
f [Bin]
bs Bool -> Bool -> Bool
|| [Bin] -> Bool
f [Bin]
ts Bool -> Bool -> Bool
|| [Bin] -> Bool
f [Bin]
bnchs) Bool -> Bool -> Bool
&& (Text
"gc" Text -> [Text] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` (LibDep -> Text
forall a b. (a, b) -> a
fst (LibDep -> Text) -> [LibDep] -> [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [LibDep]
cds)) then (Text
"gc", ATSConstraint
noConstr) LibDep -> [LibDep] -> [LibDep]
forall a. a -> [a] -> [a]
: [LibDep]
cds else [LibDep]
cds where f :: [Bin] -> Bool
f = (Bin -> Bool) -> [Bin] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any Bin -> Bool
gcBin

        Rules ()
mkUserConfig

        Bool
newFlag <- Maybe String -> String -> Rules Bool
forall (m :: * -> *) a.
(MonadIO m, Binary a) =>
a -> String -> m Bool
shouldWrite Maybe String
tgt String
flags

        -- this is dumb but w/e
        String
flags Located => String -> (String -> Action ()) -> Rules ()
String -> (String -> Action ()) -> Rules ()
%> \String
out -> do
            Action ()
alwaysRerun
            Bool
exists <- IO Bool -> Action Bool
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (String -> IO Bool
doesFileExist String
out)
            IO () -> Action ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> Action ()) -> IO () -> Action ()
forall a b. (a -> b) -> a -> b
$ if Bool -> Bool
not Bool
exists Bool -> Bool -> Bool
|| Bool
newFlag
                then String -> ByteString -> IO ()
BSL.writeFile String
out (Maybe String -> ByteString
forall a. Binary a => a -> ByteString
encode Maybe String
tgt)
                else IO ()
forall a. Monoid a => a
mempty

        -- TODO depend on tgt somehow?
        String
specialDeps Located => String -> (String -> Action ()) -> Rules ()
String -> (String -> Action ()) -> Rules ()
%> \String
out -> do
            String
cfgBin' <- Action String
forall (m :: * -> *). MonadIO m => m String
cfgBin
            Located => [String] -> Action ()
[String] -> Action ()
need [ String
cfgBin', String
flags, String
cfgFile ]
            Verbosity
v'' <- Action Verbosity
getVerbosity
            IO () -> Action ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> Action ()) -> IO () -> Action ()
forall a b. (a -> b) -> a -> b
$ Verbosity
-> CCompiler
-> Maybe String
-> [IO ()]
-> [(String, ATSConstraint)]
-> [(String, ATSConstraint)]
-> [(String, ATSConstraint)]
-> String
-> SetupScript
-> Bool
-> IO ()
fetchDeps Verbosity
v'' (String -> CCompiler
ccFromString String
cc') Maybe String
mStr [IO ()]
setup ((Text -> String) -> LibDep -> (String, ATSConstraint)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
first Text -> String
unpack (LibDep -> (String, ATSConstraint))
-> [LibDep] -> [(String, ATSConstraint)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [LibDep]
ds) ((Text -> String) -> LibDep -> (String, ATSConstraint)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
first Text -> String
unpack (LibDep -> (String, ATSConstraint))
-> [LibDep] -> [(String, ATSConstraint)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [LibDep]
cdps) ((Text -> String) -> LibDep -> (String, ATSConstraint)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
first Text -> String
unpack (LibDep -> (String, ATSConstraint))
-> [LibDep] -> [(String, ATSConstraint)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [LibDep]
bdeps) String
cfgBin' SetupScript
atslibSetup Bool
False IO () -> IO () -> IO ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> String -> String -> IO ()
writeFile String
out String
""

        let bins :: [String]
bins = Maybe String -> Text -> String
toTgt Maybe String
tgt (Text -> String) -> (Bin -> Text) -> Bin -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bin -> Text
target (Bin -> String) -> [Bin] -> [String]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Bin]
bs
        [String] -> [String] -> Maybe Text -> Rules ()
setTargets [String]
rs [String]
bins Maybe Text
mt

        String
ph <- Version -> Version -> Rules String
forall (m :: * -> *). MonadIO m => Version -> Version -> m String
home' Version
v' Version
v

        String -> Rules ()
cDepsRules String
ph Rules () -> Rules () -> Rules ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Maybe String -> Maybe String -> [String] -> Rules ()
bits Maybe String
mStr Maybe String
tgt [String]
rs

        (Lib -> Rules ()) -> [Lib] -> Rules ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ (String -> Lib -> Rules ()
h String
ph) [Lib]
lbs

        (Bin -> Rules ()) -> [Bin] -> Rules ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ (String -> Bin -> Rules ()
g String
ph) ([Bin]
bs [Bin] -> [Bin] -> [Bin]
forall a. [a] -> [a] -> [a]
++ [Bin]
ts [Bin] -> [Bin] -> [Bin]
forall a. [a] -> [a] -> [a]
++ [Bin]
bnchs)

        Maybe (Rules ()) -> Rules ()
forall (t :: * -> *) m. (Foldable t, Monoid m) => t m -> m
fold (Debian -> Rules ()
debRules (Debian -> Rules ()) -> Maybe Debian -> Maybe (Rules ())
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Debian
deb)

    where g :: String -> Bin -> Rules ()
g String
ph (Bin Text
s Text
t [Text]
ls [ForeignCabal]
hs' [TargetPair]
atg Bool
gc' [Text]
extra) =
            ATSTarget -> Rules ()
atsBin ([String]
-> ATSToolConfig
-> Bool
-> [String]
-> [String]
-> [ForeignCabal]
-> [ATSGen]
-> [HATSGen]
-> String
-> [String]
-> ArtifactType
-> Bool
-> ATSTarget
ATSTarget ([String] -> [String]
dbgFlags (Text -> String
unpack (Text -> String) -> [Text] -> [String]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Text]
cf)) (String -> ATSToolConfig
atsToolConfig String
ph) Bool
gc' (Text -> String
unpack (Text -> String) -> [Text] -> [String]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Text]
ls) [Text -> String
unpack Text
s] [ForeignCabal]
hs' (TargetPair -> ATSGen
unpackTgt (TargetPair -> ATSGen) -> [TargetPair] -> [ATSGen]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [TargetPair]
atg) [HATSGen]
forall a. Monoid a => a
mempty (Maybe String -> Text -> String
toTgt Maybe String
tgt Text
t) ([Text] -> [String]
deps [Text]
extra) ArtifactType
Executable (Bool -> Bool
not Bool
dbg))

          h :: String -> Lib -> Rules ()
h String
ph (Lib Text
_ [Text]
s Text
t [Text]
ls [Text]
_ [ForeignCabal]
hs' [(Text, Text)]
lnk [TargetPair]
atg [Text]
extra Bool
sta) =
            ATSTarget -> Rules ()
atsBin ([String]
-> ATSToolConfig
-> Bool
-> [String]
-> [String]
-> [ForeignCabal]
-> [ATSGen]
-> [HATSGen]
-> String
-> [String]
-> ArtifactType
-> Bool
-> ATSTarget
ATSTarget ([String] -> [String]
dbgFlags (Text -> String
unpack (Text -> String) -> [Text] -> [String]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Text]
cf)) (String -> ATSToolConfig
atsToolConfig String
ph) Bool
False (Text -> String
unpack (Text -> String) -> [Text] -> [String]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Text]
ls) (Text -> String
unpack (Text -> String) -> [Text] -> [String]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Text]
s) [ForeignCabal]
hs' (TargetPair -> ATSGen
unpackTgt (TargetPair -> ATSGen) -> [TargetPair] -> [ATSGen]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [TargetPair]
atg) ((Text, Text) -> HATSGen
unpackLinks ((Text, Text) -> HATSGen) -> [(Text, Text)] -> [HATSGen]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(Text, Text)]
lnk) (Text -> String
unpack Text
t) ([Text] -> [String]
deps [Text]
extra) (Bool -> ArtifactType
k Bool
sta) Bool
False)

          dbgFlags :: [String] -> [String]
dbgFlags = if Bool
dbg then (String
"-g"String -> [String] -> [String]
forall a. a -> [a] -> [a]
:) ([String] -> [String])
-> ([String] -> [String]) -> [String] -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String
"-O0"String -> [String] -> [String]
forall a. a -> [a] -> [a]
:) ([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]
filter (String -> String -> Bool
forall a. Eq a => a -> a -> Bool
/=String
"-O2") else [String] -> [String]
forall a. a -> a
id

          k :: Bool -> ArtifactType
k Bool
False = ArtifactType
SharedLibrary
          k Bool
True  = ArtifactType
StaticLibrary

          atsToolConfig :: String -> ATSToolConfig
atsToolConfig String
ph = String
-> String
-> Bool
-> CCompiler
-> Bool
-> Solver
-> Bool
-> [String]
-> ATSToolConfig
ATSToolConfig String
ph (Int -> String
patsHomeLocsAtsPkg Int
5) Bool
False (String -> CCompiler
ccFromString String
cc') (Bool -> Bool
not Bool
dl) Solver
slv Bool
al (Text -> String
unpack (Text -> String) -> [Text] -> [String]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Text]
af)

          cDepsRules :: String -> Rules ()
cDepsRules String
ph = Bool -> Rules () -> Rules ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless ([Src] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Src]
as) (Rules () -> Rules ()) -> Rules () -> Rules ()
forall a b. (a -> b) -> a -> b
$ do
              let targets :: [String]
targets = (Src -> String) -> [Src] -> [String]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Text -> String
unpack (Text -> String) -> (Src -> Text) -> Src -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Src -> Text
cTarget) [Src]
as
                  sources :: [String]
sources = (Src -> String) -> [Src] -> [String]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Text -> String
unpack (Text -> String) -> (Src -> Text) -> Src -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Src -> Text
atsSrc) [Src]
as
              (String -> String -> Rules ()) -> [String] -> [String] -> Rules ()
forall (m :: * -> *) a b c.
Applicative m =>
(a -> b -> m c) -> [a] -> [b] -> m ()
zipWithM_ (ATSToolConfig
-> [String] -> [String] -> String -> String -> Rules ()
cgen (String -> ATSToolConfig
atsToolConfig String
ph) [String
specialDeps, String
cfgFile] ((TargetPair -> String) -> [TargetPair] -> [String]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Text -> String
unpack (Text -> String) -> (TargetPair -> Text) -> TargetPair -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TargetPair -> Text
ats) ([TargetPair] -> [String])
-> (Src -> [TargetPair]) -> Src -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Src -> [TargetPair]
atsGen (Src -> [String]) -> [Src] -> [String]
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< [Src]
as)) [String]
sources [String]
targets

          cc' :: String
cc' = String -> (String -> String) -> Maybe String -> String
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Text -> String
unpack Text
ccLocal) (String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"-gcc") Maybe String
tgt
          deps :: [Text] -> [String]
deps = (String
flagsString -> [String] -> [String]
forall a. a -> [a] -> [a]
:) ([String] -> [String])
-> ([Text] -> [String]) -> [Text] -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String
specialDepsString -> [String] -> [String]
forall a. a -> [a] -> [a]
:) ([String] -> [String])
-> ([Text] -> [String]) -> [Text] -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String
cfgFileString -> [String] -> [String]
forall a. a -> [a] -> [a]
:) ([String] -> [String])
-> ([Text] -> [String]) -> [Text] -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> String) -> [Text] -> [String]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Text -> String
unpack

          unpackLinks :: (Text, Text) -> HATSGen
          unpackLinks :: (Text, Text) -> HATSGen
unpackLinks (Text
t, Text
t') = String -> String -> HATSGen
HATSGen (Text -> String
unpack Text
t) (Text -> String
unpack Text
t')

          unpackTgt :: TargetPair -> ATSGen
          unpackTgt :: TargetPair -> ATSGen
unpackTgt (TargetPair Text
t Text
t' Bool
b) = String -> String -> Bool -> ATSGen
ATSGen (Text -> String
unpack Text
t) (Text -> String
unpack Text
t') Bool
b

          specialDeps :: String
specialDeps = String
".atspkg" String -> String -> String
</> String
"deps" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> (String -> String) -> Maybe String -> String
forall b a. b -> (a -> b) -> Maybe a -> b
maybe String
"" (String
"-" String -> String -> String
forall a. Semigroup a => a -> a -> a
<>) Maybe String
tgt
          flags :: String
flags = String
".atspkg" String -> String -> String
</> String
"flags"