module Distribution.ATS.Compiler
( packageCompiler
, fetchCompiler
, setupCompiler
) where
import qualified Codec.Archive.Tar as Tar
import Codec.Compression.GZip (compress, decompress)
import Control.Monad (void, when)
import qualified Data.ByteString.Lazy as BS
import Data.Dependency
import Data.Maybe (fromMaybe)
import Data.Semigroup
import Network.HTTP.Client hiding (decompress)
import Network.HTTP.Client.TLS (tlsManagerSettings)
import System.Directory
import System.Environment (getEnv)
import System.FilePath.Find (find)
import System.Posix.Files
import System.Process
compilerDir :: Maybe FilePath -> Version -> IO FilePath
compilerDir mp v = makeAbsolute =<< dir
where def = (++ ("/.atspkg/" ++ show v)) <$> getEnv "HOME"
dir = fromMaybe <$> def <*> pure ((<> ('/' : show v)) <$> mp)
packageCompiler :: FilePath -> IO ()
packageCompiler directory = do
files <- find (pure True) (pure True) directory
bytes <- fmap Tar.write . Tar.pack directory $ fmap (drop $ length (directory :: String) + 1) files
BS.writeFile (directory ++ ".tar.gz") (compress bytes)
pkgUrl :: Version -> String
pkgUrl v = "https://github.com/vmchale/atspkg/raw/master/pkgs/ATS2-Postiats-" ++ show v ++ ".tar.gz"
withCompiler :: String -> Version -> IO ()
withCompiler s v = putStrLn $ s ++ " compiler v" ++ show v ++ "..."
fetchCompiler :: Maybe FilePath -> Version -> IO ()
fetchCompiler mp v = do
cd <- compilerDir mp v
needsSetup <- not <$> doesDirectoryExist cd
when needsSetup $ do
withCompiler "Fetching" v
manager <- newManager tlsManagerSettings
initialRequest <- parseRequest $ pkgUrl v
response <- responseBody <$> httpLbs (initialRequest { method = "GET" }) manager
withCompiler "Unpacking" v
Tar.unpack cd . Tar.read . decompress $ response
setupCompiler :: Maybe FilePath -> Version -> IO ()
setupCompiler mp v = do
withCompiler "Configuring" v
cd <- compilerDir mp v
let configurePath = cd ++ "/configure"
setFileMode configurePath ownerModes
setFileMode (cd ++ "/autogen.sh") ownerModes
void $ readCreateProcess ((proc (cd ++ "/autogen.sh") []) { cwd = Just cd }) ""
void $ readCreateProcess ((proc configurePath ["--prefix", cd]) { cwd = Just cd }) ""
withCompiler "Building" v
void $ readCreateProcess ((proc "make" []) { cwd = Just cd, std_err = CreatePipe }) ""
withCompiler "Installing" v
void $ readCreateProcess ((proc "make" ["install"]) { cwd = Just cd, std_err = CreatePipe }) ""