diff --git a/app/Main.hs b/app/Main.hs --- a/app/Main.hs +++ b/app/Main.hs @@ -3,12 +3,7 @@ module Main ( main ) where -import Control.Composition import Control.Concurrent.ParallelIO.Global -import Control.Monad -import Data.Bool (bool) -import Data.Foldable (fold) -import Data.Maybe (fromMaybe, isNothing) import qualified Data.Text.Lazy as TL import Data.Version hiding (Version (..)) import Development.Shake.ATS @@ -20,7 +15,7 @@ import Lens.Micro import Options.Applicative import Paths_ats_pkg -import System.Directory +import Quaalude hiding (command, pack) import System.IO.Temp (withSystemTempDirectory) -- TODO command to list available packages. 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.1.0.6 +version: 3.1.0.12 license: BSD3 license-file: LICENSE copyright: Copyright: (c) 2018 Vanessa McHale @@ -73,7 +73,7 @@ ghc-options: -Wall -Wincomplete-uni-patterns -Wincomplete-record-updates build-depends: - base >=4.11 && <5, + base >=4.10 && <5, http-client -any, bytestring -any, file-embed -any, @@ -151,21 +151,21 @@ -with-rtsopts=-I0 -Wincomplete-uni-patterns -Wincomplete-record-updates build-depends: - base >=4.11, + base >=4.10, ats-pkg -any, optparse-applicative -any, shake-ats -any, microlens -any, temporary -any, directory -any, - composition-prelude -any, text -any, parallel-io -any, quaalude -any, dependency -any, bytestring -any, shake -any, - cli-setup -any + cli-setup -any, + quaalude -any if flag(eventlog) ghc-options: -eventlog -with-rtsopts=-l diff --git a/internal/Quaalude.cpphs b/internal/Quaalude.cpphs --- a/internal/Quaalude.cpphs +++ b/internal/Quaalude.cpphs @@ -1,6 +1,12 @@ {-# OPTIONS_GHC -fno-warn-orphans #-} {-# LANGUAGE FlexibleContexts #-} +#ifdef MIN_VERSION_containers +#if MIN_VERSION_containers(0,6,0) +#define HAVE_containers +#endif +#endif + module Quaalude ( hex , bool , intersperse @@ -17,6 +23,7 @@ , encode , decode , fromMaybe + , isNothing , isPrefixOf , isSuffixOf , on @@ -32,6 +39,7 @@ , showVersion , traverse_ , nubSpecial + , (<>) , ExitCode (ExitSuccess) , MonadIO (..) -- * Miscellaneous @@ -121,7 +129,6 @@ , each , (&) , (%~) - #ifdef DEBUG , traceShowId , traceShow @@ -137,10 +144,16 @@ 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) +import Data.Maybe (fromMaybe, isNothing) import Data.Text.Lazy (Text, pack, unpack) import Data.Version (showVersion) #ifdef DEBUG @@ -175,8 +188,13 @@ 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 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 @@ -114,23 +114,29 @@ Just _ -> bool (pure ()) manpages b _ -> pure () --- cfgFile :: FilePath --- cfgFile = ".atspkg" "config" - parens :: String -> String parens s = mconcat [ "(", s, ")" ] +cfgFile :: FilePath +cfgFile = ".atspkg" "config" + +cfgArgs :: FilePath +cfgArgs = ".atspkg" "args" + +dhallFile :: FilePath +dhallFile = "atspkg.dhall" + -- FIXME this doesn't rebuild when it should; it should rebuild when -- @atspkg.dhall@ changes. getConfig :: MonadIO m => Maybe String -> Maybe FilePath -> m Pkg getConfig mStr dir' = liftIO $ do - d <- fromMaybe <$> fmap ( "atspkg.dhall") getCurrentDirectory <*> pure dir' - b <- not <$> doesFileExist (".atspkg" "config") + d <- fromMaybe <$> fmap ( dhallFile) getCurrentDirectory <*> pure dir' + b <- not <$> doesFileExist cfgFile let go = case mStr of { Just x -> (<> (" " <> parens x)) ; Nothing -> id } - b' <- shouldWrite mStr (".atspkg" "args") + b' <- shouldWrite mStr cfgArgs if b || b' then input auto (T.pack (go d)) - else fmap (decode . BSL.fromStrict) . BS.readFile $ ".atspkg" "config" + else fmap (decode . BSL.fromStrict) . BS.readFile $ cfgFile manTarget :: Text -> FilePath manTarget m = unpack m -<.> "1" @@ -209,23 +215,21 @@ mkConfig :: Maybe String -> Rules () mkConfig mStr = do - shouldWrite' <- shouldWrite mStr args + shouldWrite' <- shouldWrite mStr cfgArgs - args %> \out -> do + cfgArgs %> \out -> do alwaysRerun exists <- liftIO (doesFileExist out) if not exists || shouldWrite' then liftIO (BSL.writeFile out (encode mStr)) else mempty - (".atspkg" "config") %> \out -> do - need ["atspkg.dhall", args] + cfgFile %> \out -> do + need [dhallFile, cfgArgs] let go = case mStr of { Just x -> (<> (" " <> parens x)) ; Nothing -> id } x <- liftIO $ input auto (T.pack (go "./atspkg.dhall")) liftIO $ BSL.writeFile out (encode (x :: Pkg)) - where args = ".atspkg" "args" - setTargets :: [String] -> [FilePath] -> Maybe Text -> Rules () setTargets rs bins mt = when (null rs) $ case mt of @@ -248,11 +252,13 @@ -> FilePath -- ^ Filepath -> IO () atslibSetup tgt' lib' p = do + putStrLn $ "installing " ++ lib' ++ "..." subdirs <- (p:) <$> allSubdirs p - pkgPath <- fromMaybe p <$> findFile subdirs "atspkg.dhall" + pkgPath <- fromMaybe p <$> findFile subdirs dhallFile + let installDir = takeDirectory pkgPath - -- removeDirectoryRecursive (installDir ".atspkg") + build' installDir tgt' ["install"] -- | The directory @~/.atspkg@ @@ -310,7 +316,7 @@ -- TODO depend on tgt somehow? specialDeps %> \out -> do (_, cfgBin') <- cfgBin - need [ cfgBin', flags, ".atspkg" "config"] + need [ cfgBin', flags, cfgFile] v'' <- getVerbosity liftIO $ fetchDeps v'' (ccFromString cc') mStr setup (first unpack <$> ds) (first unpack <$> cdps) (first unpack <$> bdeps) cfgBin' atslibSetup False *> writeFile out "" @@ -341,10 +347,10 @@ cDepsRules ph = unless (null as) $ do let targets = fmap (unpack . cTarget) as sources = fmap (unpack . atsSrc) as - zipWithM_ (cgen (atsToolConfig ph) [specialDeps, ".atspkg" "config"] (fmap (unpack . ats) . atsGen =<< as)) sources targets + zipWithM_ (cgen (atsToolConfig ph) [specialDeps, cfgFile] (fmap (unpack . ats) . atsGen =<< as)) sources targets cc' = maybe (unpack ccLocal) (<> "-gcc") tgt - deps = (flags:) . (specialDeps:) . ((".atspkg" "config"):) . fmap unpack + deps = (flags:) . (specialDeps:) . (cfgFile:) . fmap unpack unpackLinks :: (Text, Text) -> HATSGen unpackLinks (t, t') = HATSGen (unpack t) (unpack t')