diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -1,15 +1,13 @@ # ats-pkg This is a build system for ATS written in Haskell and configured with Dhall. -You can see a working example -[here](http://github.com/vmchale/polyglot). ## Example To build a binary package from source, run ```bash - $ atspkg remote https://github.com/vmchale/polyglot/archive/0.3.30.tar.gz + $ atspkg remote https://github.com/vmchale/polyglot/archive/0.3.34.tar.gz ``` ## Installation diff --git a/Setup.hs b/Setup.hs --- a/Setup.hs +++ b/Setup.hs @@ -1,2 +1,9 @@ -import Distribution.Simple -main = defaultMain +{-# OPTIONS_GHC -Wall -Wincomplete-uni-patterns -Wincomplete-record-updates -Wcompat #-} + +import Distribution.CommandLine +import Distribution.Simple +import Distribution.Types.HookedBuildInfo + +main :: IO () +main = defaultMainWithHooks $ + simpleUserHooks { preConf = \_ _ -> writeBashCompletions "atspkg" >> pure emptyHookedBuildInfo } diff --git a/ats-pkg.cabal b/ats-pkg.cabal --- a/ats-pkg.cabal +++ b/ats-pkg.cabal @@ -1,5 +1,5 @@ name: ats-pkg -version: 1.2.1.3 +version: 1.3.0.0 synopsis: Package manager for ATS description: A collection of scripts to make building ATS projects easy. homepage: https://github.com/vmchale/ats-pkg#readme @@ -9,7 +9,7 @@ maintainer: vamchale@gmail.com copyright: Copyright: (c) 2018 Vanessa McHale category: Development -build-type: Simple +build-type: Custom extra-doc-files: README.md extra-source-files: stack.yaml cabal-version: 1.18 @@ -20,13 +20,19 @@ default: False } +custom-setup + setup-depends: base + , Cabal >= 2.0 + , cli-setup >= 0.1.0.2 + library hs-source-dirs: src - exposed-modules: Language.ATS.Package + exposed-modules: Language.ATS.Package.Compiler , Language.ATS.Package.Exec + other-modules: Paths_ats_pkg + , Language.ATS.Package.Error , Language.ATS.Package.Type , Language.ATS.Package.Dependency - other-modules: Paths_ats_pkg build-depends: base >= 4.7 && < 5 , http-client , filemanip @@ -47,6 +53,8 @@ , composition-prelude >= 1.1.0.2 , optparse-applicative , temporary + , lzma + , ansi-wl-pprint default-language: Haskell2010 if flag(development) ghc-options: -Werror diff --git a/src/Language/ATS/Package.hs b/src/Language/ATS/Package.hs deleted file mode 100644 --- a/src/Language/ATS/Package.hs +++ /dev/null @@ -1,80 +0,0 @@ -{-# LANGUAGE OverloadedStrings #-} - -module Language.ATS.Package - ( packageCompiler - , nuke - , fetchCompiler - , setupCompiler - , Version (..) - ) 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.List (intercalate) -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 - -nuke :: Version -> IO () -nuke v = do - putStrLn "Cleaning everything..." - b <- doesDirectoryExist =<< compilerDir v - when b - (removeDirectoryRecursive =<< compilerDir v) - -newtype Version = Version [Integer] - deriving (Eq) - -instance Show Version where - show (Version is) = intercalate "." (show <$> is) - --- TODO depend on version -compilerDir :: Version -> IO FilePath -compilerDir v = (++ ("/.atspkg/" ++ show v)) <$> getEnv "HOME" - -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" - -fetchCompiler :: Version -> IO () -fetchCompiler v = do - - cd <- compilerDir v - needsSetup <- not <$> doesDirectoryExist cd - - when needsSetup $ do - - putStrLn "Fetching compiler..." - manager <- newManager tlsManagerSettings - initialRequest <- parseRequest $ pkgUrl v - response <- responseBody <$> httpLbs (initialRequest { method = "GET" }) manager - - putStrLn "Unpacking compiler..." - Tar.unpack cd . Tar.read . decompress $ response - -setupCompiler :: Version -> IO () -setupCompiler v = do - - putStrLn "Configuring compiler..." - cd <- compilerDir 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 }) "" - - putStrLn "Building compiler..." - void $ readCreateProcess ((proc "make" []) { cwd = Just cd, std_err = CreatePipe }) "" - putStrLn "Installing compiler..." - void $ readCreateProcess ((proc "make" ["install"]) { cwd = Just cd, std_err = CreatePipe }) "" diff --git a/src/Language/ATS/Package/Compiler.hs b/src/Language/ATS/Package/Compiler.hs new file mode 100644 --- /dev/null +++ b/src/Language/ATS/Package/Compiler.hs @@ -0,0 +1,83 @@ +{-# LANGUAGE OverloadedStrings #-} + +module Language.ATS.Package.Compiler + ( packageCompiler + , nuke + , fetchCompiler + , setupCompiler + , Version (..) + ) 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.List (intercalate) +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 + +nuke :: Version -> IO () +nuke v = do + putStrLn "Cleaning everything..." + b <- doesDirectoryExist =<< compilerDir v + when b + (removeDirectoryRecursive =<< compilerDir v) + +newtype Version = Version [Integer] + deriving (Eq) + +instance Show Version where + show (Version is) = intercalate "." (show <$> is) + +-- TODO depend on version +compilerDir :: Version -> IO FilePath +compilerDir v = (++ ("/.atspkg/" ++ show v)) <$> getEnv "HOME" + +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 :: Version -> IO () +fetchCompiler v = do + + cd <- compilerDir 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 :: Version -> IO () +setupCompiler v = do + + withCompiler "Configuring" v + cd <- compilerDir 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 }) "" diff --git a/src/Language/ATS/Package/Dependency.hs b/src/Language/ATS/Package/Dependency.hs --- a/src/Language/ATS/Package/Dependency.hs +++ b/src/Language/ATS/Package/Dependency.hs @@ -10,15 +10,18 @@ ) where import qualified Codec.Archive.Tar as Tar -import Codec.Compression.GZip (decompress) +import qualified Codec.Compression.GZip as Gzip +import qualified Codec.Compression.Lzma as Lzma import Control.Concurrent.ParallelIO.Global import Control.Lens import Control.Monad +import Data.ByteString.Lazy (ByteString) import Data.Maybe (fromMaybe) import Data.Semigroup (Semigroup (..)) import qualified Data.Text.Lazy as TL import Dhall -import Network.HTTP.Client hiding (decompress) +import Language.ATS.Package.Error +import Network.HTTP.Client import Network.HTTP.Client.TLS (tlsManagerSettings) import System.Directory import System.Environment (getEnv) @@ -32,20 +35,20 @@ } deriving (Eq, Show, Generic, Interpret) -makeLensesFor [("dir", "dirLens"), ("libName", "libNameLens")] ''Dependency +makeLensesFor [("dir", "dirLens")] ''Dependency fetchDeps :: Bool -- ^ Set to 'False' if unsure. -> [Dependency] -- ^ ATS dependencies -> [Dependency] -- ^ C Dependencies -> IO () fetchDeps b deps cdeps = - unless (null deps) $ do + unless (null deps && null cdeps) $ do putStrLn "Checking ATS dependencies..." d <- (<> "lib/") <$> pkgHome let libs = fmap (buildHelper b) deps unpacked = fmap (over dirLens (TL.pack d <>)) cdeps - clibs = fmap (buildHelper b . over libNameLens (const "")) unpacked - parallel_ (libs ++ clibs) >> stopGlobalPool + clibs = fmap (buildHelper b) unpacked + parallel_ (libs ++ clibs) mapM_ setup unpacked pkgHome :: IO FilePath @@ -60,6 +63,9 @@ ds' <- mapM allSubdirs ds pure $ join (ds : ds') +-- runAutoconf :: FilePath -> IO () +-- runAutoconf p = do + clibSetup :: String -> FilePath -> IO () clibSetup lib' p = do subdirs <- allSubdirs p @@ -82,6 +88,13 @@ clibSetup (TL.unpack lib') (TL.unpack dirName') writeFile lib'' "" +getCompressor :: Text -> IO (ByteString -> ByteString) +getCompressor s + | ".tar.gz" `TL.isSuffixOf` s || ".tgz" `TL.isSuffixOf` s = pure Gzip.decompress + | ".tar.xz" `TL.isSuffixOf` s = pure Lzma.decompress + | ".tar" `TL.isSuffixOf` s = pure id + | otherwise = unrecognized (TL.unpack s) + buildHelper :: Bool -> Dependency -> IO () buildHelper b (Dependency lib' dirName' url'') = do @@ -97,7 +110,8 @@ response <- responseBody <$> httpLbs (initialRequest { method = "GET" }) manager putStrLn ("Unpacking library " ++ lib ++ "...") - Tar.unpack dirName . Tar.read . decompress $ response + compress <- getCompressor url'' + Tar.unpack dirName . Tar.read . compress $ response needsMove <- doesDirectoryExist (dirName ++ "/package") when needsMove $ do diff --git a/src/Language/ATS/Package/Error.hs b/src/Language/ATS/Package/Error.hs new file mode 100644 --- /dev/null +++ b/src/Language/ATS/Package/Error.hs @@ -0,0 +1,25 @@ +{-# LANGUAGE OverloadedStrings #-} + +module Language.ATS.Package.Error ( -- * Helper functions + unrecognized + ) where + +import System.Exit +import Text.PrettyPrint.ANSI.Leijen + +infixr 5 <#> + +unrecognized :: String -> IO a +unrecognized = printErr . Unrecognized + +newtype PackageError = Unrecognized String + +(<#>) :: Doc -> Doc -> Doc +(<#>) a b = a <> line <> b + +instance Pretty PackageError where + pretty (Unrecognized t) = red "Error:" <> "Unrecognized archive format when unpacking" <#> hang 2 (text t) + +-- TODO monaderror? +printErr :: PackageError -> IO a +printErr e = putDoc (pretty e) >> exitFailure diff --git a/src/Language/ATS/Package/Exec.hs b/src/Language/ATS/Package/Exec.hs --- a/src/Language/ATS/Package/Exec.hs +++ b/src/Language/ATS/Package/Exec.hs @@ -13,12 +13,12 @@ import Data.Version hiding (Version (..)) import Development.Shake.FilePath import Dhall hiding (bool) -import Language.ATS.Package +import Language.ATS.Package.Compiler import Language.ATS.Package.Dependency import Language.ATS.Package.Type hiding (test, version) import Options.Applicative hiding (auto) import Paths_ats_pkg -import System.Directory (doesFileExist, findFile, listDirectory, withCurrentDirectory) +import System.Directory import System.Environment (getEnv) import System.IO.Temp (withSystemTempDirectory) @@ -36,6 +36,7 @@ | Clean | Test | Fetch { _url :: String } + | Nuke command' :: Parser Command command' = hsubparser @@ -44,8 +45,14 @@ <> command "remote" (info fetch (progDesc "Fetch and install a binary package")) <> command "build" (info build (progDesc "Build current package targets")) <> command "test" (info (pure Test) (progDesc "Test current package")) + <> command "nuke" (info (pure Nuke) (progDesc "Uninstall all globally installed libraries")) ) +cleanAll :: IO () +cleanAll = do + d <- getEnv "HOME" + removeDirectoryRecursive $ d ++ "/.atspkg" + build :: Parser Command build = Build <$> many (argument str @@ -78,6 +85,7 @@ -- https://github.com/vmchale/polyglot/archive/0.3.27.tar.gz run :: Command -> IO () +run Nuke = cleanAll run (Fetch u) = fetchPkg u run Clean = mkPkg ["clean"] run c = bool (buildAll "./atspkg.dhall" >> mkPkg rs) (mkPkg rs) =<< check "./atspkg.dhall" diff --git a/src/Language/ATS/Package/Type.hs b/src/Language/ATS/Package/Type.hs --- a/src/Language/ATS/Package/Type.hs +++ b/src/Language/ATS/Package/Type.hs @@ -1,27 +1,29 @@ +{-# OPTIONS_GHC -fno-warn-unused-top-binds #-} + {-# LANGUAGE DeriveAnyClass #-} {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE OverloadedStrings #-} module Language.ATS.Package.Type ( Pkg (..) - , Bin (..) - , pkgToAction , mkPkg - , mkManpage ) where import Control.Composition -import Control.Monad.IO.Class (MonadIO) -import Data.Maybe (fromMaybe, isJust) -import Data.Semigroup (Semigroup (..)) -import qualified Data.Text.Lazy as TL +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 Dhall hiding (bool) import Language.ATS.Package.Dependency -import System.Directory (findExecutable, getCurrentDirectory) +import System.Directory (findExecutable, getCurrentDirectory) +-- TODO custom c compiler + options :: ShakeOptions options = shakeOptions { shakeFiles = ".atspkg" , shakeThreads = 4 @@ -90,10 +92,11 @@ 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) = do +pkgToAction rs (Pkg bs ts mt v v' ds cds cc cf) = do unless (rs == ["clean"]) $ - liftIO $ fetchDeps False ds cds + liftIO $ fetchDeps False ds cds >> stopGlobalPool action (need ["atspkg.dhall"]) mapM_ g (bs ++ ts) let bins = TL.unpack . target <$> bs @@ -103,7 +106,7 @@ (Just m) -> want (bool bins (manTarget m : bins) pa) Nothing -> want bins - where g (Bin s t ls gc') = atsBin (Version v) (Version v') gc' (TL.unpack <$> ls) (TL.unpack s) (TL.unpack t) + 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 @@ -120,5 +123,7 @@ , 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) diff --git a/stack.yaml b/stack.yaml --- a/stack.yaml +++ b/stack.yaml @@ -4,9 +4,10 @@ - '.' extra-deps: - shake-ext-1.4.0.1 - - shake-ats-0.1.0.3 + - shake-ats-0.2.0.0 - composition-prelude-1.1.0.2 - language-ats-0.1.1.5 + - cli-setup-0.1.0.3 flags: ats-pkg: development: false