{-# LANGUAGE OverloadedStrings #-}

module Distribution.ATS ( cleanATSCabal
                        , atsUserHooks
                        , fetchDependencies
                        -- * Types
                        , ATSVersion
                        , ATSDependency (..)
                        -- * Libraries
                        , libgmp
                        , intinf
                        , atsPrelude
                        , atsContrib
                        , atsFull
                        , findCli
                        ) where

import qualified Codec.Archive.Tar                    as Tar
import           Codec.Compression.GZip               (decompress)
import           Control.Concurrent.ParallelIO.Global
import           Control.Monad
import           Data.List                            (intercalate)
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

-- | ATS library version to use, e.g. @[0,3,8]@ for @0.3.8@.
type ATSVersion = [Integer]

data ATSDependency = ATSDependency { _libName  :: String -- ^ Library name
                                   , _filepath :: FilePath -- ^ Directory to unpack library into
                                   , _url      :: String -- ^ URL of tarball containing ATS library.
                                   }

maybeCleanBuild :: LocalBuildInfo -> IO ()
maybeCleanBuild li =
    let cf = configConfigurationsFlags (configFlags li) in

    unless ((mkFlagName "development", True) `elem` cf) $
        putStrLn "Cleaning up ATS dependencies..." >>
        cleanATSCabal

-- | This generates user hooks for a Cabal distribution that has some ATS
-- library dependencies. For an example of its use, see the @Setup.hs@ of
-- [fast-arithmetic](https://hackage.haskell.org/package/fast-arithmetic)
atsUserHooks :: [ATSDependency] -> UserHooks
atsUserHooks deps = simpleUserHooks { preConf = \_ _ -> fetchDependencies deps >> pure emptyHookedBuildInfo
                                    , postBuild = \_ _ _ -> maybeCleanBuild
                                    }

-- TODO custom directory?
cleanATSCabal :: IO ()
cleanATSCabal = removeDirectoryRecursive "ats-deps"

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

-- | Directory traversal library for ATS
findCli :: ATSDependency
findCli = ATSDependency"atscntrb-hx-find-cli-1.0.0" "ats-deps/contrib/atscntrb-hx-find-cli" "https://registry.npmjs.org/atscntrb-hx-find-cli/-/atscntrb-hx-find-cli-1.0.0.tgz"

-- | GMP bindings for ATS
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"

-- | Arbitrary-precision arithmetic library for ATS
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"

-- | Full ATS libraries.
atsFull :: ATSVersion -> ATSDependency
atsFull v = ATSDependency ("ats2-postiats-" ++ vs) "ats-deps" ("https://github.com/vmchale/atspkg/raw/master/pkgs/ATS2-Postiats-" ++ vs ++ ".tar.gz")
    where vs = vString v

-- | ATS prelude
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 <$> doesDirectoryExist (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