diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,5 +1,13 @@ # ats-pkg +## 3.2.3.0 + + * Update to not use `cpphs` + +## 3.2.2.4 + + * Fix `dhall/atslib.dhall` file that is embedded into the binary + ## 3.3.2.0 * Update `Debian` type and adjust prelude accordingly diff --git a/app/Language/ATS/Package/Upgrade.hs b/app/Language/ATS/Package/Upgrade.hs --- a/app/Language/ATS/Package/Upgrade.hs +++ b/app/Language/ATS/Package/Upgrade.hs @@ -15,7 +15,7 @@ targetArch :: String targetArch = g [arch, manufacturer, os] - where g = mconcat . intersperse "-" + where g = fold . intersperse "-" atspkgPath :: IO String atspkgPath = do 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.2.3 +version: 3.2.3.0 license: BSD3 license-file: LICENSE copyright: Copyright: (c) 2018 Vanessa McHale @@ -105,7 +105,6 @@ library quaalude exposed-modules: Quaalude - build-tools: cpphs -any hs-source-dirs: internal other-modules: System.Process.Ext @@ -125,7 +124,8 @@ composition-prelude >=1.3.0.3, binary -any, text -any, - mtl -any + mtl -any, + containers >=0.6 if flag(development) cpp-options: -DDEBUG diff --git a/dhall/atslib.dhall b/dhall/atslib.dhall --- a/dhall/atslib.dhall +++ b/dhall/atslib.dhall @@ -1,5 +1,5 @@ {- Dhall prelude imports -} -let map = http://hackage.haskell.org/package/dhall/src/Prelude/List/map +let map = https://raw.githubusercontent.com/dhall-lang/Prelude/master/List/map in let concat = https://raw.githubusercontent.com/dhall-lang/Prelude/master/List/concat in diff --git a/internal/Quaalude.cpphs b/internal/Quaalude.cpphs deleted file mode 100644 --- a/internal/Quaalude.cpphs +++ /dev/null @@ -1,221 +0,0 @@ -{-# LANGUAGE FlexibleContexts #-} - -#ifdef MIN_VERSION_containers -#if MIN_VERSION_containers(0,6,0) -#define HAVE_containers -#endif -#endif - -module Quaalude ( hex - , bool - , intersperse - , transpose - , sortBy - , void - , unless - , when - , join - , fold - , zipWithM_ - , zipWithM - , filterM - , encode - , decode - , fromMaybe - , isNothing - , isPrefixOf - , isSuffixOf - , on - , both - , (***) - , (&&&) - , (<=<) - , ($>) - , first - , second - , getEnv - , exitWith - , showVersion - , traverse_ - , nubSpecial - , (<>) - , ExitCode (ExitSuccess) - , MonadIO (..) - -- * Miscellaneous - , makeExe - , shouldWrite - -- * "System.Process.Ext" reëxports - , silentCreateProcess - -- * "Data.Text.Lazy" reëxports - , Text - , pack - , unpack - -- * "Control.Composition" reëxports - , biaxe - , (.*) - , (.**) - , thread - , bisequence' - -- * Dhall reëxports - , Interpret - , Inject - , Generic - , Binary - , input - , auto - , detailed - -- * Shake reëxports - , Rules - , Action - , command - , command_ - , (%>) - , need - , want - , shake - , Rebuild (..) - , (~>) - , cmd - , cmd_ - , ShakeOptions (..) - , shakeOptions - , copyFile' - , Change (..) - , Verbosity (..) - , removeFilesAfter - , Lint (..) - , takeBaseName - , takeFileName - , takeDirectory - , (-<.>) - , makeExecutable - -- * "Network.HTTP.Client.TLS" reëxports - , tlsManagerSettings - -- "Network.HTTP.Client" reëxports - , newManager - , parseRequest - , httpLbs - , Response (..) - , Request (method, redirectCount) - -- * "System.FilePath" reëxports - , () - , pathSeparator - -- * ByteString reëxports - , ByteString - -- * Helpers for pretty-printing - , (<#>) - -- * "Text.PrettyPrint.ANSI.Leijen" reëxports - , (<+>) - , text - , punctuate - , dullred - , linebreak - , dullyellow - , hardline - , hang - , indent - , putDoc - , Pretty (pretty) - , module X - -- Lens exports - , Lens' - , over - , _Just - , view - , _1 - , _2 - , _4 - , each - , (&) - , (%~) -#ifdef DEBUG - , traceShowId - , traceShow -#endif - ) where - -import Control.Arrow hiding ((<+>)) -import Control.Composition -import Control.Monad -import Control.Monad.IO.Class -import Control.Monad.State.Lazy -import Data.Binary -import Data.Bool (bool) -import Data.ByteString.Lazy (ByteString) -import qualified Data.ByteString.Lazy as BSL -#ifdef HAVE_containers -import Data.Containers.ListUtils (nubOrd) -#endif -import Data.Foldable (fold, traverse_) -import Data.Functor (($>)) -#if !MIN_VERSION_base(4,11,0) -import Data.Semigroup -#endif -import Data.List -import Data.Maybe (fromMaybe, isNothing) -import Data.Text.Lazy (Text, pack, unpack) -import Data.Version (showVersion) -#ifdef DEBUG -import Debug.Trace (traceShow, traceShowId) -#endif -import Development.Shake hiding (doesFileExist, getEnv) -import Development.Shake.FilePath -import Dhall hiding (Text, bool) -import Lens.Micro hiding (both) -import Lens.Micro.Extras -import Network.HTTP.Client -import Network.HTTP.Client.TLS (tlsManagerSettings) -import Numeric (showHex) -import System.Directory as X -import System.Environment (getEnv) -import System.Exit (ExitCode (ExitSuccess), exitWith) -import System.Info (os) -#ifndef mingw32_HOST_OS -import System.Posix.Files -#endif -import System.Process as X -import System.Process.Ext -import Text.PrettyPrint.ANSI.Leijen hiding (bool, group, (<$>), (), (<>)) - -infixr 5 <#> - -#ifdef mingw32_HOST_OS -makeExecutable :: FilePath -> IO () -makeExecutable = pure mempty -#else -makeExecutable :: FilePath -> IO () -makeExecutable = flip setFileMode ownerModes -#endif - -#ifdef HAVE_containers -nubSpecial :: (Ord a) => [[a]] -> [[a]] -nubSpecial = fmap pure . nubOrd . join -#else -nubSpecial :: (Eq a) => [[a]] -> [[a]] -nubSpecial = fmap pure . nub . join -#endif - -makeExe :: String -makeExe = case os of - "freebsd" -> "gmake" - "openbsd" -> "gmake" - "netbsd" -> "gmake" - "solaris" -> "gmake" - "dragonfly" -> "gmake" - _ -> "make" - -hex :: Int -> String -hex = flip showHex mempty - --- | Same as "Text.PrettyPrint.ANSI.Leijen"'s @<$>@, but doesn't clash with the --- prelude. -(<#>) :: Doc -> Doc -> Doc -(<#>) a b = a <> line <> b - -shouldWrite :: (MonadIO m, Binary a) => a -> FilePath -> m Bool -shouldWrite x fp = do - exists <- liftIO (doesFileExist fp) - contents <- if exists - then liftIO (BSL.readFile fp) - else pure mempty - pure $ BSL.length contents /= 0 && encode x /= contents diff --git a/internal/Quaalude.hs b/internal/Quaalude.hs new file mode 100644 --- /dev/null +++ b/internal/Quaalude.hs @@ -0,0 +1,209 @@ +{-# LANGUAGE CPP #-} +{-# LANGUAGE FlexibleContexts #-} + +module Quaalude ( hex + , bool + , intersperse + , transpose + , sortBy + , void + , unless + , when + , join + , fold + , zipWithM_ + , zipWithM + , filterM + , encode + , decode + , fromMaybe + , isNothing + , isPrefixOf + , isSuffixOf + , on + , both + , (***) + , (&&&) + , (<=<) + , ($>) + , first + , second + , getEnv + , exitWith + , showVersion + , traverse_ + , nubSpecial + , (<>) + , ExitCode (ExitSuccess) + , MonadIO (..) + -- * Miscellaneous + , makeExe + , shouldWrite + -- * "System.Process.Ext" reëxports + , silentCreateProcess + -- * "Data.Text.Lazy" reëxports + , Text + , pack + , unpack + -- * "Control.Composition" reëxports + , biaxe + , (.*) + , (.**) + , thread + , bisequence' + -- * Dhall reëxports + , Interpret + , Inject + , Generic + , Binary + , input + , auto + , detailed + -- * Shake reëxports + , Rules + , Action + , command + , command_ + , (%>) + , need + , want + , shake + , Rebuild (..) + , (~>) + , cmd + , cmd_ + , ShakeOptions (..) + , shakeOptions + , copyFile' + , Change (..) + , Verbosity (..) + , removeFilesAfter + , Lint (..) + , takeBaseName + , takeFileName + , takeDirectory + , (-<.>) + , makeExecutable + -- * "Network.HTTP.Client.TLS" reëxports + , tlsManagerSettings + -- "Network.HTTP.Client" reëxports + , newManager + , parseRequest + , httpLbs + , Response (..) + , Request (method, redirectCount) + -- * "System.FilePath" reëxports + , () + , pathSeparator + -- * ByteString reëxports + , ByteString + -- * Helpers for pretty-printing + , (<#>) + -- * "Text.PrettyPrint.ANSI.Leijen" reëxports + , (<+>) + , text + , punctuate + , dullred + , linebreak + , dullyellow + , hardline + , hang + , indent + , putDoc + , Pretty (pretty) + , module X + -- Lens exports + , Lens' + , over + , _Just + , view + , _1 + , _2 + , _4 + , each + , (&) + , (%~) +#ifdef DEBUG + , traceShowId + , traceShow +#endif + ) where + +import Control.Arrow hiding ((<+>)) +import Control.Composition +import Control.Monad +import Control.Monad.IO.Class +import Control.Monad.State.Lazy +import Data.Binary +import Data.Bool (bool) +import Data.ByteString.Lazy (ByteString) +import qualified Data.ByteString.Lazy as BSL +import Data.Containers.ListUtils (nubOrd) +import Data.Foldable (fold, traverse_) +import Data.Functor (($>)) +#if !MIN_VERSION_base(4,11,0) +import Data.Semigroup +#endif +import Data.List +import Data.Maybe (fromMaybe, isNothing) +import Data.Text.Lazy (Text, pack, unpack) +import Data.Version (showVersion) +#ifdef DEBUG +import Debug.Trace (traceShow, traceShowId) +#endif +import Development.Shake hiding (doesFileExist, getEnv) +import Development.Shake.FilePath +import Dhall hiding (Text, bool) +import Lens.Micro hiding (both) +import Lens.Micro.Extras +import Network.HTTP.Client +import Network.HTTP.Client.TLS (tlsManagerSettings) +import Numeric (showHex) +import System.Directory as X +import System.Environment (getEnv) +import System.Exit (ExitCode (ExitSuccess), exitWith) +import System.Info (os) +#ifndef mingw32_HOST_OS +import System.Posix.Files +#endif +import System.Process as X +import System.Process.Ext +import Text.PrettyPrint.ANSI.Leijen hiding (bool, group, (<$>), (), (<>)) + +infixr 5 <#> + +#ifdef mingw32_HOST_OS +makeExecutable :: FilePath -> IO () +makeExecutable = pure mempty +#else +makeExecutable :: FilePath -> IO () +makeExecutable = flip setFileMode ownerModes +#endif + +nubSpecial :: (Ord a) => [[a]] -> [[a]] +nubSpecial = fmap pure . nubOrd . join + +makeExe :: String +makeExe = case os of + "freebsd" -> "gmake" + "openbsd" -> "gmake" + "netbsd" -> "gmake" + "solaris" -> "gmake" + "dragonfly" -> "gmake" + _ -> "make" + +hex :: Int -> String +hex = flip showHex mempty + +-- | Same as "Text.PrettyPrint.ANSI.Leijen"'s @<$>@, but doesn't clash with the +-- prelude. +(<#>) :: Doc -> Doc -> Doc +(<#>) a b = a <> line <> b + +shouldWrite :: (MonadIO m, Binary a) => a -> FilePath -> m Bool +shouldWrite x fp = do + exists <- liftIO (doesFileExist fp) + contents <- if exists + then liftIO (BSL.readFile fp) + else pure mempty + pure $ BSL.length contents /= 0 && encode x /= contents 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.3 +.\" Automatically generated by Pandoc 2.3.1 .\" .TH "atspkg (1)" "" "" "" "" .hy diff --git a/src/Language/ATS/Package/Build.hs b/src/Language/ATS/Package/Build.hs --- a/src/Language/ATS/Package/Build.hs +++ b/src/Language/ATS/Package/Build.hs @@ -358,7 +358,7 @@ unpackLinks (t, t') = HATSGen (unpack t) (unpack t') unpackTgt :: TargetPair -> ATSGen - unpackTgt (TargetPair t t' b) = ATSGen (unpack t) (unpack t') b + unpackTgt (TargetPair t t' _) = ATSGen (unpack t) (unpack t') specialDeps = ".atspkg" "deps" ++ maybe "" ("-" <>) tgt flags = ".atspkg" "flags" 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 @@ -37,6 +37,8 @@ bytes <- fmap Tar.write . Tar.pack directory $ fmap (drop $ length (directory :: String) + 1) files BS.writeFile (directory ++ ".tar.gz") (compress bytes) +-- TODO: +-- http://ats-lang.sourceforge.net/IMPLEMENT/Postiats/ATS2-Postiats-0.3.12.tgz ? pkgUrl :: Version -> String pkgUrl v = "https://github.com/vmchale/atspkg/releases/download/compiler/ATS2-Postiats-" ++ show v ++ ".tar.gz"