module Language.ATS.Package.Dependency (
fetchDeps
, Dependency (..)
) where
import qualified Codec.Archive.Tar as Tar
import Codec.Compression.GZip (decompress)
import Control.Concurrent.ParallelIO.Global
import Control.Lens
import Control.Monad
import qualified Data.Text.Lazy as TL
import Dhall
import Network.HTTP.Client hiding (decompress)
import Network.HTTP.Client.TLS (tlsManagerSettings)
import System.Directory
data Dependency = Dependency { libName :: Text
, dir :: Text
, url :: Text
}
deriving (Eq, Show, Generic, Interpret)
fetchDeps :: Bool -> [Dependency] -> IO ()
fetchDeps b deps =
unless (null deps) $ do
putStrLn "Checking ATS dependencies..."
let libs = fmap (buildHelper b) deps
parallel_ libs >> stopGlobalPool
buildHelper :: Bool -> Dependency -> IO ()
buildHelper b (Dependency lib' dirName' url'') = do
let (lib, dirName, url') = (lib', dirName', url'') & each %~ TL.unpack
needsSetup <- not <$> doesDirectoryExist (dirName ++ if b then "/atspkg.dhall" else "")
when needsSetup $ do
putStrLn ("Fetching library " ++ lib ++ "...")
manager <- newManager tlsManagerSettings
initialRequest <- parseRequest url'
response <- responseBody <$> httpLbs (initialRequest { method = "GET" }) manager
putStrLn ("Unpacking library " ++ lib ++ "...")
Tar.unpack dirName . Tar.read . decompress $ response
putStrLn ("Setting up library " ++ lib ++ "...")
needsMove <- doesDirectoryExist (dirName ++ "/package")
when needsMove $ do
renameDirectory (dirName ++ "/package") "tempdir"
removeDirectoryRecursive dirName
renameDirectory "tempdir" dirName