{-# OPTIONS_GHC -fno-warn-unused-top-binds #-} {-# LANGUAGE DeriveAnyClass #-} {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE OverloadedStrings #-} module Language.ATS.Package.Type ( Pkg (..) , mkPkg ) where import Control.Composition import Control.Concurrent.ParallelIO.Global import Control.Monad.IO.Class (MonadIO) import Data.Maybe (fromMaybe, isJust) import Data.Semigroup (Semigroup (..)) import qualified Data.Text.Lazy as TL import Development.Shake import Development.Shake.ATS import Development.Shake.FilePath import Development.Shake.Man import Dhall hiding (bool) import Language.ATS.Package.Dependency import System.Directory (findExecutable, getCurrentDirectory) -- TODO custom c compiler options :: ShakeOptions options = shakeOptions { shakeFiles = ".atspkg" , shakeThreads = 4 , shakeProgress = progressSimple } -- TODO verbosity & coloring? mkPkg :: [String] -> IO () mkPkg rs = shake options $ want rs >> mkTest >> mkClean >> mkManpage >> mkInstall >> (pkgToAction rs =<< getConfig) pandoc :: (MonadIO m) => m Bool pandoc = isJust <$> liftIO (findExecutable "pandoc") mkManpage :: Rules () mkManpage = do c <- getConfig b <- pandoc case man c of Just _ -> bool (pure ()) manpages b _ -> pure () getConfig :: MonadIO m => m Pkg getConfig = liftIO $ do d <- getCurrentDirectory input auto (TL.pack d <> "/atspkg.dhall") manTarget :: Text -> FilePath manTarget m = TL.unpack m -<.> "1" mkInstall :: Rules () mkInstall = "install" ~> do config <- getConfig bins <- fmap (TL.unpack . target) . bin <$> getConfig need bins home <- fromMaybe "" <$> getEnv "HOME" let binDest = ((home <> "/.local/bin/") <>) . takeBaseName <$> bins void $ zipWithM copyFile' bins binDest pa <- pandoc case man config of Just mt -> if not pa then pure () else do let mt' = manTarget mt manDest = (home <> "/.local/share/man/man1/") <> mt' need [mt'] copyFile' mt' manDest Nothing -> pure () mkClean :: Rules () mkClean = "clean" ~> do removeFilesAfter "." ["//*.1","//*.c", "tags"] removeFilesAfter "target" ["//*"] removeFilesAfter ".atspkg" ["//*"] mkTest :: Rules () mkTest = "test" ~> do config <- getConfig let tests = fmap (TL.unpack . target) . test $ config need tests mapM_ cmd_ tests -- TODO infer dependencies on gc/atomic gc based on boolean flag. pkgToAction :: [String] -> Pkg -> Rules () pkgToAction rs (Pkg bs ts mt v v' ds cds cc cf) = do unless (rs == ["clean"]) $ liftIO $ fetchDeps False ds cds >> stopGlobalPool action (need ["atspkg.dhall"]) mapM_ g (bs ++ ts) let bins = TL.unpack . target <$> bs pa <- pandoc when (null rs) $ case mt of (Just m) -> want (bool bins (manTarget m : bins) pa) Nothing -> want bins where g (Bin s t ls gc') = atsBin (TL.unpack cc) (TL.unpack <$> cf) (Version v) (Version v') gc' (TL.unpack <$> ls) (TL.unpack s) (TL.unpack t) data Bin = Bin { src :: Text -- ^ Source file (should end with @.dats@) , target :: Text -- ^ Binary to be built , libs :: [Text] -- ^ Libraries to link against (e.g. @[ "pthread" ]@) , gc :: Bool } -- ^ Whether to use the garbage collector deriving (Show, Eq, Generic, Interpret) -- data RemotePkg = RemotePkg Pkg Text data Pkg = Pkg { bin :: [Bin] -- ^ List of binaries to be built , test :: [Bin] -- ^ List of test suites , man :: Maybe Text -- ^ Optional (markdown) manpages to be converted using @pandoc@. , version :: [Integer] -- ^ Library version , compiler :: [Integer] -- ^ Compiler version , dependencies :: [Dependency] -- ^ List of dependencies , clib :: [Dependency] -- ^ List of C dependencies , ccompiler :: Text -- ^ The C compiler we should use , cflags :: [Text] -- ^ List of flags to pass to the C compiler } deriving (Show, Eq, Generic, Interpret)