diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,5 +1,9 @@ # ats-pkg +## 3.2.6.12 + + * Use old Dhall prelude + ## 3.2.5.11 * Set UTF8 encoding in all cases diff --git a/app/Main.hs b/app/Main.hs --- a/app/Main.hs +++ b/app/Main.hs @@ -42,6 +42,7 @@ , _prof :: Bool } | Clean + | Pack { _target :: String } | Test { _targets :: [String] , _atspkgArg :: Maybe String , _rebuildAll :: Bool @@ -70,8 +71,8 @@ | List | Setup -command' :: Parser Command -command' = hsubparser +userCmd :: Parser Command +userCmd = hsubparser (command "install" (info install (progDesc "Install all binaries to $HOME/.local/bin")) <> command "clean" (info (pure Clean) (progDesc "Clean current project directory")) <> command "remote" (info fetch (progDesc "Fetch and install a binary package")) @@ -87,6 +88,19 @@ <> command "setup" (info (pure Setup) (progDesc "Install manpages and shell completions.")) ) +command' :: Parser Command +command' = userCmd <|> internalCmd + +internalCmd :: Parser Command +internalCmd = subparser + (internal + <> command "pack" (info pack (progDesc "Make a tarball for distributing the compiler")) + ) + +pack :: Parser Command +pack = Pack + <$> targetP mempty id "package" + install :: Parser Command install = Install <$> triple @@ -234,6 +248,7 @@ run (Run ts mArg rba v lint tim) = runHelper rba lint tim ("run" : ts) mArg Nothing v run (Install tgt mArg) = runHelper False True False ["install"] mArg tgt 0 run (Valgrind ts mArg) = runHelper False True False ("valgrind" : ts) mArg Nothing 0 +run (Pack dir') = packageCompiler dir' run Setup = installActions installActions :: IO () diff --git a/ats-pkg.cabal b/ats-pkg.cabal --- a/ats-pkg.cabal +++ b/ats-pkg.cabal @@ -1,6 +1,6 @@ cabal-version: 2.0 name: ats-pkg -version: 3.2.5.11 +version: 3.2.5.12 license: BSD3 license-file: LICENSE copyright: Copyright: (c) 2018-2019 Vanessa McHale @@ -82,7 +82,6 @@ Cabal >=2.2.0.0, lzma -any, zlib -any, - libarchive -any, http-client-tls -any, text -any, process -any, @@ -97,7 +96,9 @@ zip-archive -any, ansi-wl-pprint -any, dependency >=1.2.0.0, - quaalude -any + quaalude -any, + tar -any, + filemanip -any if flag(development) ghc-options: -Werror diff --git a/dhall/atspkg-prelude.dhall b/dhall/atspkg-prelude.dhall --- a/dhall/atspkg-prelude.dhall +++ b/dhall/atspkg-prelude.dhall @@ -1,5 +1,5 @@ {- Dhall prelude functions -} -let concatMapSep = https://raw.githubusercontent.com/dhall-lang/dhall-lang/master/Prelude/Text/concatMapSep +let concatMapSep = https://raw.githubusercontent.com/dhall-lang/dhall-lang/0a7f596d03b3ea760a96a8e03935f4baa64274e1/Prelude/Text/concatMapSep in let map = https://raw.githubusercontent.com/dhall-lang/dhall-lang/master/Prelude/List/map in diff --git a/man/atspkg.1 b/man/atspkg.1 --- a/man/atspkg.1 +++ b/man/atspkg.1 @@ -1,4 +1,4 @@ -.\" Automatically generated by Pandoc 2.6 +.\" Automatically generated by Pandoc 2.7.1 .\" .TH "atspkg (1)" "" "" "" "" .hy @@ -46,6 +46,9 @@ \f[B]check-set\f[R] - Check a package set to make sure it is well-typed. .PP \f[B]list\f[R] - List all available packages in current package set. +.PP +\f[B]pack\f[R] - Create a tarball suitable for packaging the compiler. +Takes as an argument a directory containing the unpacked compiler. .PP \f[B]setup\f[R] - Set up manpages and shell completions. .SH OPTIONS diff --git a/src/Language/ATS/Package.hs b/src/Language/ATS/Package.hs --- a/src/Language/ATS/Package.hs +++ b/src/Language/ATS/Package.hs @@ -6,6 +6,8 @@ -- * Ecosystem functionality , displayList , atspkgVersion + -- * Functions involving the compiler + , packageCompiler -- * Types , Version (..) , Pkg (..) diff --git a/src/Language/ATS/Package/Compiler.hs b/src/Language/ATS/Package/Compiler.hs --- a/src/Language/ATS/Package/Compiler.hs +++ b/src/Language/ATS/Package/Compiler.hs @@ -4,15 +4,18 @@ -- | This module contains functions for installing the @patscc@ compiler. It -- also includes functions for building @libatslib@. module Language.ATS.Package.Compiler - ( fetchCompiler + ( packageCompiler + , fetchCompiler , setupCompiler , cleanAll -- * Types , SetupScript ) where -import qualified Codec.Archive as Archive -import Codec.Compression.GZip (decompress) +import System.FilePath.Find (find) +-- import qualified Codec.Archive as Archive +import qualified Codec.Archive.Tar as Tar +import Codec.Compression.GZip (compress, decompress) import Control.Monad import qualified Data.ByteString.Lazy as BS import Data.Dependency @@ -37,6 +40,13 @@ -- gmp = if v >= Version [0,3,13] then "gmp-" else "" -- in "https://cytranet.dl.sourceforge.net/project/ats2-lang/ats2-lang/ats2-postiats-" ++ vs ++ "/ATS2-Postiats-" ++ gmp ++ vs ++ ".tgz" +-- | Make a tarball from a directory containing the compiler. +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) + withCompiler :: String -> Version -> IO () withCompiler s v = putStrLn $ s ++ " compiler v" ++ show v ++ "..." @@ -54,7 +64,8 @@ response <- responseBody <$> httpLbs (initialRequest { method = "GET" }) manager withCompiler "Unpacking" v - Archive.unpackToDir cd (BS.toStrict $ decompress response) + Tar.unpack cd . Tar.read . decompress $ response + -- Archive.unpackToDir cd (BS.toStrict $ decompress response) make :: Verbosity -> Version -> FilePath -> IO () make v' v cd = 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 @@ -7,7 +7,8 @@ , SetupScript ) where -import Codec.Archive as Archive +-- import Codec.Archive as Archive +import qualified Codec.Archive.Tar as Tar import Codec.Archive.Zip (ZipOption (..), extractFilesFromArchive, toArchive) import qualified Codec.Compression.BZip as Bzip import qualified Codec.Compression.GZip as Gzip @@ -107,7 +108,8 @@ tarResponse :: Text -> FilePath -> ByteString -> IO () tarResponse url' dirName response = do compress <- getCompressor url' - let f = Archive.unpackToDir dirName . BSL.toStrict . compress + -- let f = Archive.unpackToDir dirName . BSL.toStrict . compress + let f = Tar.unpack dirName . Tar.read . compress f response zipResponse :: FilePath -> ByteString -> IO ()