-- | Integration with @Cabal@.
module Distribution.ATS.Build ( cabalHooks
                              , atsPolyglotBuild
                              ) where

-- TODO use confHook to set extra-libraries and extra-lib-dirs ourselves?
import           Control.Concurrent.ParallelIO.Global
import           Distribution.PackageDescription
import           Distribution.Simple
import           Distribution.Simple.LocalBuildInfo
import           Language.ATS.Package.Build
import           Quaalude

-- | Use this in place of 'defaultMain' for a simple build.
atsPolyglotBuild :: IO ()
atsPolyglotBuild :: IO ()
atsPolyglotBuild =
    UserHooks -> IO ()
defaultMainWithHooks UserHooks
cabalHooks IO () -> IO () -> IO ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*>
    IO ()
stopGlobalPool

configureCabal :: IO LocalBuildInfo -> IO LocalBuildInfo
configureCabal :: IO LocalBuildInfo -> IO LocalBuildInfo
configureCabal = IO (LocalBuildInfo -> LocalBuildInfo)
-> IO LocalBuildInfo -> IO LocalBuildInfo
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
(<*>) (IO (LocalBuildInfo -> LocalBuildInfo)
 -> IO LocalBuildInfo -> IO LocalBuildInfo)
-> IO (LocalBuildInfo -> LocalBuildInfo)
-> IO LocalBuildInfo
-> IO LocalBuildInfo
forall a b. (a -> b) -> a -> b
$ do
    -- TODO get host triple from Platform of LocalBuildInfo
    Int -> Bool -> [String] -> IO ()
build Int
1 Bool
False [String]
forall a. Monoid a => a
mempty
    String
libDir <- (String -> String -> String
forall a. Semigroup a => a -> a -> a
<> [Char
pathSeparator]) (String -> String) -> IO String -> IO String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO String
getCurrentDirectory
    (LocalBuildInfo -> LocalBuildInfo)
-> IO (LocalBuildInfo -> LocalBuildInfo)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (String -> LocalBuildInfo -> LocalBuildInfo
modifyConf String
libDir)

modifyBuildInfo :: String -> BuildInfo -> BuildInfo
modifyBuildInfo :: String -> BuildInfo -> BuildInfo
modifyBuildInfo String
libDir BuildInfo
bi = let olds :: [String]
olds = BuildInfo -> [String]
extraLibDirs BuildInfo
bi
    in BuildInfo
bi { extraLibDirs :: [String]
extraLibDirs = (String
libDir 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]
olds }

modifyConf :: FilePath -- ^ New library directory (absolute)
           -> LocalBuildInfo
           -> LocalBuildInfo
modifyConf :: String -> LocalBuildInfo -> LocalBuildInfo
modifyConf String
libDir LocalBuildInfo
bi = let old :: PackageDescription
old = LocalBuildInfo -> PackageDescription
localPkgDescr LocalBuildInfo
bi
    in LocalBuildInfo
bi { localPkgDescr :: PackageDescription
localPkgDescr = String -> PackageDescription -> PackageDescription
modifyPkgDescr String
libDir PackageDescription
old }

modifyPkgDescr :: String -> PackageDescription -> PackageDescription
modifyPkgDescr :: String -> PackageDescription -> PackageDescription
modifyPkgDescr String
libDir PackageDescription
pd = let old :: Maybe Library
old = PackageDescription -> Maybe Library
library PackageDescription
pd
    in PackageDescription
pd { library :: Maybe Library
library = (Library -> Library) -> Maybe Library -> Maybe Library
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (String -> Library -> Library
modifyLibrary String
libDir) Maybe Library
old }

modifyLibrary :: String -> Library -> Library
modifyLibrary :: String -> Library -> Library
modifyLibrary String
libDir Library
lib = let old :: BuildInfo
old = Library -> BuildInfo
libBuildInfo Library
lib
    in Library
lib { libBuildInfo :: BuildInfo
libBuildInfo = String -> BuildInfo -> BuildInfo
modifyBuildInfo String
libDir BuildInfo
old }

-- | Write a dummy file that will allow packaging to work.
writeDummyFile :: IO ()
writeDummyFile :: IO ()
writeDummyFile =
    Bool -> String -> IO ()
createDirectoryIfMissing Bool
True (String
"dist-newstyle" String -> String -> String
</> String
"lib") IO () -> IO () -> IO ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*>
    String -> String -> IO ()
writeFile (String
"dist-newstyle" String -> String -> String
</> String
"lib" String -> String -> String
</> String
"empty") String
""

-- | This uses the users hooks as is @simpleUserHooks@, modified to build the
-- ATS library.
cabalHooks :: UserHooks
cabalHooks :: UserHooks
cabalHooks = let defConf :: (GenericPackageDescription, HookedBuildInfo)
-> ConfigFlags -> IO LocalBuildInfo
defConf = UserHooks
-> (GenericPackageDescription, HookedBuildInfo)
-> ConfigFlags
-> IO LocalBuildInfo
confHook UserHooks
simpleUserHooks
    in UserHooks
simpleUserHooks { preConf :: [String] -> ConfigFlags -> IO HookedBuildInfo
preConf = (IO ()
writeDummyFile IO () -> IO HookedBuildInfo -> IO HookedBuildInfo
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*>) (IO HookedBuildInfo -> IO HookedBuildInfo)
-> ([String] -> ConfigFlags -> IO HookedBuildInfo)
-> [String]
-> ConfigFlags
-> IO HookedBuildInfo
forall c d a b. (c -> d) -> (a -> b -> c) -> a -> b -> d
.* UserHooks -> [String] -> ConfigFlags -> IO HookedBuildInfo
preConf UserHooks
simpleUserHooks
                       , confHook :: (GenericPackageDescription, HookedBuildInfo)
-> ConfigFlags -> IO LocalBuildInfo
confHook = IO LocalBuildInfo -> IO LocalBuildInfo
configureCabal (IO LocalBuildInfo -> IO LocalBuildInfo)
-> ((GenericPackageDescription, HookedBuildInfo)
    -> ConfigFlags -> IO LocalBuildInfo)
-> (GenericPackageDescription, HookedBuildInfo)
-> ConfigFlags
-> IO LocalBuildInfo
forall c d a b. (c -> d) -> (a -> b -> c) -> a -> b -> d
.* (GenericPackageDescription, HookedBuildInfo)
-> ConfigFlags -> IO LocalBuildInfo
defConf }
                       -- FIXME registration + installation/copy hooks
                       -- ideally in a library of its own for C builds