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.2 +version: 3.1.0.6 license: BSD3 license-file: LICENSE copyright: Copyright: (c) 2018 Vanessa McHale diff --git a/internal/Quaalude.cpphs b/internal/Quaalude.cpphs --- a/internal/Quaalude.cpphs +++ b/internal/Quaalude.cpphs @@ -36,6 +36,7 @@ , MonadIO (..) -- * Miscellaneous , makeExe + , shouldWrite -- * "System.Process.Ext" reëxports , silentCreateProcess -- * "Data.Text.Lazy" reëxports @@ -135,6 +136,7 @@ import Data.Binary import Data.Bool (bool) import Data.ByteString.Lazy (ByteString) +import qualified Data.ByteString.Lazy as BSL import Data.Foldable (fold, traverse_) import Data.Functor (($>)) import Data.List @@ -144,7 +146,7 @@ #ifdef DEBUG import Debug.Trace (traceShow, traceShowId) #endif -import Development.Shake hiding (getEnv) +import Development.Shake hiding (doesFileExist, getEnv) import Development.Shake.FilePath import Dhall hiding (Text, bool) import Lens.Micro hiding (both) @@ -199,3 +201,11 @@ -- 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/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,16 +114,23 @@ Just _ -> bool (pure ()) manpages b _ -> pure () +-- cfgFile :: FilePath +-- cfgFile = ".atspkg" "config" + +parens :: String -> String +parens s = mconcat [ "(", s, ")" ] + -- 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" - let str = fromMaybe mempty mStr - if b - then input auto (T.pack (d <> " " <> str)) - else fmap (decode . BSL.fromStrict) . BS.readFile $ ".atspkg/config" + b <- not <$> doesFileExist (".atspkg" "config") + let go = case mStr of { Just x -> (<> (" " <> parens x)) ; Nothing -> id } + b' <- shouldWrite mStr (".atspkg" "args") + if b || b' + then input auto (T.pack (go d)) + else fmap (decode . BSL.fromStrict) . BS.readFile $ ".atspkg" "config" manTarget :: Text -> FilePath manTarget m = unpack m -<.> "1" @@ -199,14 +206,6 @@ , pkgToAction mStr setup rs tgt cfg ] -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 - mkConfig :: Maybe String -> Rules () mkConfig mStr = do @@ -221,7 +220,7 @@ (".atspkg" "config") %> \out -> do need ["atspkg.dhall", args] - let go = case mStr of { Just x -> (<> (" " <> x)) ; Nothing -> id } + 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)) @@ -311,9 +310,9 @@ -- TODO depend on tgt somehow? specialDeps %> \out -> do (_, cfgBin') <- cfgBin - need [ cfgBin', flags, ".atspkg" "config" ] + need [ cfgBin', flags, ".atspkg" "config"] v'' <- getVerbosity - liftIO $ fetchDeps v'' (ccFromString cc') setup (first unpack <$> ds) (first unpack <$> cdps) (first unpack <$> bdeps) cfgBin' atslibSetup False *> writeFile out "" + liftIO $ fetchDeps v'' (ccFromString cc') mStr setup (first unpack <$> ds) (first unpack <$> cdps) (first unpack <$> bdeps) cfgBin' atslibSetup False *> writeFile out "" let bins = toTgt tgt . target <$> bs setTargets rs bins mt 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 @@ -31,6 +31,7 @@ fetchDeps :: Verbosity -- ^ Shake verbosity -> CCompiler -- ^ C compiler to use + -> Maybe String -- ^ Args -> [IO ()] -- ^ Setup steps that can be performed concurrently -> [(String, ATSConstraint)] -- ^ ATS dependencies -> [(String, ATSConstraint)] -- ^ C Dependencies @@ -39,16 +40,16 @@ -> SetupScript -- ^ How to install an ATS library -> Bool -- ^ Whether to perform setup anyhow. -> IO () -fetchDeps v cc' setup' deps cdeps atsBld cfgPath als b' = +fetchDeps v cc' mStr setup' deps cdeps atsBld cfgPath als b' = unless (null deps && null cdeps && null atsBld && b' && False) $ do putStrLn "Resolving dependencies..." pkgSet <- unpack . defaultPkgs . decode <$> BSL.readFile cfgPath - deps' <- setBuildPlan "ats" libDeps pkgSet deps - atsDeps' <- setBuildPlan "atsbld" libBldDeps pkgSet atsBld - cdeps' <- setBuildPlan "c" libDeps pkgSet cdeps + deps' <- setBuildPlan "ats" libDeps mStr pkgSet deps + atsDeps' <- setBuildPlan "atsbld" libBldDeps mStr pkgSet atsBld + cdeps' <- setBuildPlan "c" libDeps mStr pkgSet cdeps -- Set up actions d <- ( "lib/") <$> cpkgHome cc' diff --git a/src/Language/ATS/Package/PackageSet.hs b/src/Language/ATS/Package/PackageSet.hs --- a/src/Language/ATS/Package/PackageSet.hs +++ b/src/Language/ATS/Package/PackageSet.hs @@ -51,12 +51,14 @@ setBuildPlan :: FilePath -- ^ Filepath for cache inside @.atspkg@ -> DepSelector + -> Maybe String -- ^ Arguments -> String -- ^ URL of package set to use. -> [(String, ATSConstraint)] -- ^ Libraries we want -> IO [[ATSDependency]] -setBuildPlan p getDeps url deps = do +setBuildPlan p getDeps mStr url deps = do b <- doesFileExist depCache - bool setBuildPlan' (decode <$> BSL.readFile depCache) b + b' <- shouldWrite mStr (".atspkg" "args") + bool setBuildPlan' (decode <$> BSL.readFile depCache) (b && b') where depCache = ".atspkg/buildplan-" ++ p setBuildPlan' = do