module Distribution.ATS ( cleanATSCabal
, atsUserHooks
, atsLibUserHooks
, fetchDependencies
, ATSVersion
, ATSDependency (..)
, libgmp
, intinf
, atsPrelude
, atsContrib
, fetchCompiler
, setupCompiler
, packageCompiler
) where
import qualified Codec.Archive.Tar as Tar
import Codec.Compression.GZip (decompress)
import Control.Concurrent.ParallelIO.Global
import Control.Monad
import Data.Bool
import qualified Data.Dependency as Dep
import Data.List (intercalate)
import Distribution.ATS.Compiler
import Distribution.PackageDescription
import Distribution.Simple
import Distribution.Simple.LocalBuildInfo
import Distribution.Simple.Setup
import Network.HTTP.Client hiding (decompress)
import Network.HTTP.Client.TLS (tlsManagerSettings)
import System.Directory
type ATSVersion = [Integer]
data ATSDependency = ATSDependency { _libName :: String
, _filepath :: FilePath
, _url :: String
}
maybeCleanBuild :: LocalBuildInfo -> IO ()
maybeCleanBuild li =
let cf = configConfigurationsFlags (configFlags li) in
unless ((mkFlagName "development", True) `elem` cf) $
putStrLn "Cleaning up ATS dependencies..." >>
cleanATSCabal
defV :: Dep.Version
defV = Dep.Version [0,3,9]
fetchCompiler' :: IO ()
fetchCompiler' = fetchCompiler (Just "ats-deps") defV
setupCompiler' :: IO ()
setupCompiler' = setupCompiler (Just "ats-deps") defV
atsUserHooks :: [ATSDependency] -> UserHooks
atsUserHooks deps = simpleUserHooks { preConf = \_ _ -> fetchDependencies deps >> pure emptyHookedBuildInfo
, postBuild = \_ _ _ -> maybeCleanBuild
}
installCompiler :: IO ()
installCompiler = do
b <- doesFileExist "ats-deps/0.3.9/done"
unless b $
fetchCompiler' >>
setupCompiler'
atsLibUserHooks :: [ATSDependency] -> UserHooks
atsLibUserHooks deps = simpleUserHooks { preConf = \_ _ -> mconcat [ installCompiler, fetchDependencies deps ] >> pure emptyHookedBuildInfo
, postBuild = \_ _ _ -> maybeCleanBuild
}
cleanATSCabal :: IO ()
cleanATSCabal = do
b <- doesDirectoryExist "ats-deps"
bool (pure ()) (removeDirectoryRecursive "ats-deps") b
vString :: ATSVersion -> String
vString = intercalate "." . fmap show
atsContrib :: ATSVersion -> ATSDependency
atsContrib v = ATSDependency ("ats2-postiats-" ++ vs ++ "-contrib") "ats-deps/contrib" ("https://downloads.sourceforge.net/project/ats2-lang/ats2-lang/ats2-postiats-" ++ vs ++ "/ATS2-Postiats-contrib-" ++ vs ++ ".tgz")
where vs = vString v
libgmp :: ATSDependency
libgmp = ATSDependency "atscntrb-libgmp-1.0.4" "ats-deps/contrib/atscntrb-libgmp" "https://registry.npmjs.org/atscntrb-libgmp/-/atscntrb-libgmp-1.0.4.tgz"
intinf :: ATSDependency
intinf = ATSDependency "atscntrb-hs-intinf-1.0.6" "ats-deps/contrib/atscntrb-hx-intinf" "https://registry.npmjs.org/atscntrb-hx-intinf/-/atscntrb-hx-intinf-1.0.6.tgz"
atsPrelude :: ATSVersion -> ATSDependency
atsPrelude v = ATSDependency ("ats2-postiats-" ++ vs ++ "-prelude") "ats-deps/prelude" ("https://downloads.sourceforge.net/project/ats2-lang/ats2-lang/ats2-postiats-" ++ vs ++ "/ATS2-Postiats-include-" ++ vs ++ ".tgz")
where vs = vString v
fetchDependencies :: [ATSDependency] -> IO ()
fetchDependencies = (>> stopGlobalPool) . parallel_ . fmap fetchDependency
fetchDependency :: ATSDependency -> IO ()
fetchDependency (ATSDependency libNameATS dirName url) = do
needsSetup <- not <$> doesFileExist (dirName ++ "/unpacked")
when needsSetup $ do
let doing str = putStrLn (str ++ " library " ++ libNameATS ++ "...")
doing "Fetching"
manager <- newManager tlsManagerSettings
initialRequest <- parseRequest url
response <- responseBody <$> httpLbs (initialRequest { method = "GET" }) manager
doing "Unpacking"
Tar.unpack dirName . Tar.read . decompress $ response
doing "Setting up"
writeFile (dirName ++ "/unpacked") ""
needsMove <- doesDirectoryExist (dirName ++ "/package")
when needsMove $ do
renameDirectory (dirName ++ "/package") "tempdir"
removeDirectoryRecursive dirName
renameDirectory "tempdir" dirName