diff --git a/Setup.hs b/Setup.hs deleted file mode 100644 --- a/Setup.hs +++ /dev/null @@ -1,2 +0,0 @@ -import Distribution.Simple -main = defaultMain diff --git a/app/Main.hs b/app/Main.hs --- a/app/Main.hs +++ b/app/Main.hs @@ -33,9 +33,12 @@ versionInfo :: Parser (a -> a) versionInfo = infoOption ("atspkg version: " ++ showVersion atspkgVersion) (short 'V' <> long "version" <> help "Show version") -data Command = Install { _archTarget :: Maybe String } +data Command = Install { _archTarget :: Maybe String + , _atspkgArg :: Maybe String + } | Build { _targets :: [String] , _archTarget :: Maybe String + , _atspkgArg :: Maybe String , _rebuildAll :: Bool , _verbosity :: Int , _lint :: Bool @@ -44,16 +47,22 @@ | Clean | Pack { _target :: String } | Test { _targets :: [String] + , _atspkgArg :: Maybe String , _rebuildAll :: Bool , _verbosity :: Int , _lint :: Bool , _prof :: Bool } - | Fetch { _url :: String } + | Fetch { _url :: String + , _atspkgArg :: Maybe String + } | Nuke | Upgrade - | Valgrind { _targets :: [String] } + | Valgrind { _targets :: [String] + , _atspkgArg :: Maybe String + } | Run { _targets :: [String] + , _atspkgArg :: Maybe String , _rebuildAll :: Bool , _verbosity :: Int , _lint :: Bool @@ -97,6 +106,7 @@ install :: Parser Command install = Install <$> triple + <*> pkgArgs checkSet :: Parser Command checkSet = CheckSet @@ -123,6 +133,7 @@ run' :: Parser Command run' = Run <$> targets "run" + <*> pkgArgs <*> rebuild <*> verbosity <*> noLint @@ -131,13 +142,16 @@ test' :: Parser Command test' = Test <$> targets "test" + <*> pkgArgs <*> rebuild <*> verbosity <*> noLint <*> profile valgrind :: Parser Command -valgrind = Valgrind <$> targets "run with valgrind" +valgrind = Valgrind + <$> targets "run with valgrind" + <*> pkgArgs targets :: String -> Parser [String] targets = targetP mempty many @@ -168,6 +182,12 @@ <> short 't' <> help "Set target by using its triple")) +pkgArgs :: Parser (Maybe String) +pkgArgs = optional + (strOption + (long "pkg-args" + <> help "Arguments to be passed to 'atspkg.dhall'")) + verbosity :: Parser Int verbosity = length <$> many (flag' () (short 'v' <> long "verbose" <> help "Turn up verbosity")) @@ -175,6 +195,7 @@ build' :: Parser Command build' = Build <$> targets "build" + <*> pkgArgs <*> triple <*> rebuild <*> verbosity @@ -193,41 +214,42 @@ argument str (metavar "URL" <> help "URL pointing to a tarball containing the package to be installed.") + <*> pkgArgs -fetchPkg :: String -> IO () -fetchPkg pkg = withSystemTempDirectory "atspkg" $ \p -> do +fetchPkg :: Maybe String -> String -> IO () +fetchPkg mStr pkg = withSystemTempDirectory "atspkg" $ \p -> do let (dirName, url') = (p, pkg) & each %~ TL.pack buildHelper True (ATSDependency mempty dirName url' undefined undefined mempty mempty mempty mempty) ps <- getSubdirs p pkgDir <- fromMaybe p <$> findFile (p:ps) "atspkg.dhall" - let setup = [buildAll 0 Nothing (Just pkgDir)] - withCurrentDirectory (takeDirectory pkgDir) (mkPkg False False False setup ["install"] Nothing 0) + let setup = [buildAll 0 mStr Nothing (Just pkgDir)] + withCurrentDirectory (takeDirectory pkgDir) (mkPkg mStr False False False setup ["install"] Nothing 0) stopGlobalPool main :: IO () main = execParser wrapper >>= run -runHelper :: Bool -> Bool -> Bool -> [String] -> Maybe String -> Int -> IO () -runHelper rba lint tim rs tgt v = g . bool x y . (&& isNothing tgt) =<< check Nothing - where g xs = mkPkg rba lint tim xs rs tgt v *> stopGlobalPool +runHelper :: Bool -> Bool -> Bool -> [String] -> Maybe String -> Maybe String -> Int -> IO () +runHelper rba lint tim rs mStr tgt v = g . bool x y . (&& isNothing tgt) =<< check mStr Nothing + where g xs = mkPkg mStr rba lint tim xs rs tgt v *> stopGlobalPool y = mempty - x = [buildAll v tgt Nothing] + x = [buildAll v mStr tgt Nothing] run :: Command -> IO () -run List = displayList "https://raw.githubusercontent.com/vmchale/atspkg/master/ats-pkg/pkgs/pkg-set.dhall" -run (Check p b) = void $ ($ Version [0,1,0]) <$> checkPkg p b -run (CheckSet p b) = void $ checkPkgSet p b -run Upgrade = upgradeBin "vmchale" "atspkg" -run Nuke = cleanAll -run (Fetch u) = fetchPkg u -run Clean = mkPkg False True False mempty ["clean"] Nothing 0 -run (Build rs tgt rba v lint tim) = runHelper rba lint tim rs tgt v -run (Test ts rba v lint tim) = runHelper rba lint tim ("test" : ts) Nothing v -run (Run ts rba v lint tim) = runHelper rba lint tim ("run" : ts) Nothing v -run (Install tgt) = runHelper False True False ["install"] tgt 0 -run (Valgrind ts) = runHelper False True False ("valgrind" : ts) Nothing 0 -run (Pack dir') = packageCompiler dir' -run Setup = installActions +run List = displayList "https://raw.githubusercontent.com/vmchale/atspkg/master/ats-pkg/pkgs/pkg-set.dhall" +run (Check p b) = void $ ($ Version [0,1,0]) <$> checkPkg p b +run (CheckSet p b) = void $ checkPkgSet p b +run Upgrade = upgradeBin "vmchale" "atspkg" +run Nuke = cleanAll +run (Fetch u mArg) = fetchPkg mArg u +run Clean = mkPkg Nothing False True False mempty ["clean"] Nothing 0 +run (Build rs mArg tgt rba v lint tim) = runHelper rba lint tim rs mArg tgt v +run (Test ts mArg rba v lint tim) = runHelper rba lint tim ("test" : ts) mArg Nothing v +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 () installActions = 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.0.0.11 +version: 3.1.0.2 license: BSD3 license-file: LICENSE copyright: Copyright: (c) 2018 Vanessa McHale @@ -124,7 +124,7 @@ ansi-wl-pprint -any, shake -any, bytestring -any, - composition-prelude >=1.3.0.0, + composition-prelude >=1.3.0.3, binary -any, text -any, mtl -any diff --git a/dhall/atspkg-prelude.dhall b/dhall/atspkg-prelude.dhall --- a/dhall/atspkg-prelude.dhall +++ b/dhall/atspkg-prelude.dhall @@ -84,6 +84,10 @@ } in +let iccFlags = + [ "-D__PURE_INTEL_C99_HEADERS__" ] +in + let mapSrc = λ(x : List { atsSrc : Text, cTarget : Text}) → map { atsSrc : Text, cTarget : Text } Src src x in @@ -320,4 +324,5 @@ , debian = debian , noPrelude = noPrelude , atsProject = atsProject +, iccFlags = iccFlags } diff --git a/internal/Quaalude.cpphs b/internal/Quaalude.cpphs --- a/internal/Quaalude.cpphs +++ b/internal/Quaalude.cpphs @@ -47,6 +47,7 @@ , (.*) , (.**) , thread + , bisequence' -- * Dhall reëxports , Interpret , Inject 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.2.2 +.\" Automatically generated by Pandoc 2.2.2.1 .\" .TH "atspkg (1)" "" "" "" "" .hy @@ -61,6 +61,11 @@ .TP .B \f[B]\-V\f[] \f[B]\-\-version\f[] Display version information +.RS +.RE +.TP +.B \f[B]\-\-pkg\-args\f[] +Arguments to be passed to atspkg.dhall .RS .RE .TP diff --git a/src/Distribution/ATS/Version.hs b/src/Distribution/ATS/Version.hs --- a/src/Distribution/ATS/Version.hs +++ b/src/Distribution/ATS/Version.hs @@ -1,7 +1,6 @@ module Distribution.ATS.Version ( atspkgVersion ) where - import qualified Data.Version as V import qualified Paths_ats_pkg as P 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 @@ -29,21 +29,22 @@ import Language.ATS.Package.Type import Quaalude -check :: Maybe FilePath -> IO Bool -check p = do +check :: Maybe String -> Maybe FilePath -> IO Bool +check mStr p = do home <- getEnv "HOME" - v <- wants p + v <- wants mStr p doesFileExist (home ".atspkg" show v "bin" "patscc") -wants :: Maybe FilePath -> IO Version -wants p = compiler <$> getConfig p +wants :: Maybe String -> Maybe FilePath -> IO Version +wants mStr p = compiler <$> getConfig mStr p -- | Build in current directory or indicated directory buildAll :: Int -> Maybe String + -> Maybe String -> Maybe FilePath -> IO () -buildAll v tgt' p = on (*>) (=<< wants p) fetchDef setupDef +buildAll v mStr tgt' p = on (*>) (=<< wants mStr p) fetchDef setupDef where fetchDef = fetchCompiler setupDef = setupCompiler (toVerbosity v) atslibSetup tgt' @@ -52,14 +53,14 @@ -> [String] -- ^ Targets -> IO () build' dir tgt' rs = withCurrentDirectory dir (mkPkgEmpty mempty) - where mkPkgEmpty ts = mkPkg False True False ts rs tgt' 1 + where mkPkgEmpty ts = mkPkg Nothing False True False ts rs tgt' 1 -- | Build a set of targets build :: Int -> [String] -- ^ Targets -> IO () -build v rs = bool (mkPkgEmpty [buildAll v Nothing Nothing]) (mkPkgEmpty mempty) =<< check Nothing - where mkPkgEmpty ts = mkPkg False True False ts rs Nothing 1 +build v rs = bool (mkPkgEmpty [buildAll v Nothing Nothing Nothing]) (mkPkgEmpty mempty) =<< check Nothing Nothing + where mkPkgEmpty ts = mkPkg Nothing False True False ts rs Nothing 1 -- TODO clean generated ATS mkClean :: Rules () @@ -72,10 +73,11 @@ -- TODO take more arguments, in particular, include + library dirs mkInstall :: Maybe String -- ^ Optional target triple + -> Maybe String -- ^ Optional argument to @atspkg.dhall@ -> Rules () -mkInstall tgt = +mkInstall tgt mStr = "install" ~> do - config <- getConfig Nothing + config <- getConfig mStr Nothing let libs' = fmap (unpack . libTarget) . libraries $ config bins = fmap (unpack . target) . bin $ config incs = ((fmap unpack . includes) =<<) . libraries $ config @@ -104,9 +106,9 @@ copyFile' com' comDest Nothing -> pure () -mkManpage :: Rules () -mkManpage = do - c <- getConfig Nothing +mkManpage :: Maybe String -> Rules () +mkManpage mStr = do + c <- getConfig mStr Nothing b <- pandoc case man c of Just _ -> bool (pure ()) manpages b @@ -114,33 +116,34 @@ -- FIXME this doesn't rebuild when it should; it should rebuild when -- @atspkg.dhall@ changes. -getConfig :: MonadIO m => Maybe FilePath -> m Pkg -getConfig dir' = liftIO $ do +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) + then input auto (T.pack (d <> " " <> str)) else fmap (decode . BSL.fromStrict) . BS.readFile $ ".atspkg/config" manTarget :: Text -> FilePath manTarget m = unpack m -<.> "1" -mkPhony :: String -> (String -> String) -> (Pkg -> [Bin]) -> [String] -> Rules () -mkPhony cmdStr f select rs = +mkPhony :: Maybe String -> String -> (String -> String) -> (Pkg -> [Bin]) -> [String] -> Rules () +mkPhony mStr cmdStr f select rs = cmdStr ~> do - config <- getConfig Nothing + config <- getConfig mStr Nothing let runs = bool (filter (/= cmdStr) rs) (fmap (unpack . target) . select $ config) (rs == [cmdStr]) need runs traverse_ cmd_ (f <$> runs) -mkValgrind :: [String] -> Rules () -mkValgrind = mkPhony "valgrind" ("valgrind " <>) bin +mkValgrind :: Maybe String -> [String] -> Rules () +mkValgrind mStr = mkPhony mStr "valgrind" ("valgrind " <>) bin -mkTest :: [String] -> Rules () -mkTest = mkPhony "test" id test +mkTest :: Maybe String -> [String] -> Rules () +mkTest mStr = mkPhony mStr "test" id test -mkRun :: [String] -> Rules () -mkRun = mkPhony "run" id bin +mkRun :: Maybe String -> [String] -> Rules () +mkRun mStr = mkPhony mStr "run" id bin toVerbosity :: Int -> Verbosity toVerbosity 0 = Normal @@ -173,11 +176,12 @@ patterns = thread (mkPattern <$> ["c", "o", "so", "a", "deb"]) mkPattern ext = ("//*." <> ext :) -cleanConfig :: (MonadIO m) => [String] -> m Pkg -cleanConfig ["clean"] = pure undefined -cleanConfig _ = getConfig Nothing +cleanConfig :: (MonadIO m) => Maybe String -> [String] -> m Pkg +cleanConfig _ ["clean"] = pure undefined +cleanConfig mStr _ = getConfig mStr Nothing -mkPkg :: Bool -- ^ Force rebuild +mkPkg :: Maybe String -- ^ Optional argument to @atspkg.dhall@ + -> Bool -- ^ Force rebuild -> Bool -- ^ Run linter -> Bool -- ^ Print build profiling information -> [IO ()] -- ^ Setup @@ -185,32 +189,53 @@ -> Maybe String -- ^ Target triple -> Int -- ^ Verbosity -> IO () -mkPkg rba lint tim setup rs tgt v = do - cfg <- cleanConfig rs +mkPkg mStr rba lint tim setup rs tgt v = do + cfg <- cleanConfig mStr rs let opt = options rba lint tim v $ pkgToTargets cfg tgt rs shake opt $ mconcat [ want (pkgToTargets cfg tgt rs) , mkClean - , pkgToAction setup rs tgt cfg + , pkgToAction mStr setup rs tgt cfg ] -mkConfig :: Rules () -mkConfig = +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 + + shouldWrite' <- shouldWrite mStr args + + args %> \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"] - x <- liftIO $ input auto "./atspkg.dhall" + need ["atspkg.dhall", args] + let go = case mStr of { Just x -> (<> (" " <> 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 (Just m) -> want . bool bins (manTarget m : bins) =<< pandoc Nothing -> want bins -bits :: Maybe String -> [String] -> Rules () -bits tgt rs = mconcat $ [ mkManpage, mkInstall tgt, mkConfig ] <> - sequence [ mkRun, mkTest, mkValgrind ] rs +bits :: Maybe String -> Maybe String -> [String] -> Rules () +bits mStr tgt rs = mconcat $ sequence [ mkManpage, mkInstall tgt, mkConfig ] mStr <> + bisequence' [ mkRun, mkTest, mkValgrind ] mStr rs pkgToTargets :: Pkg -> Maybe String -> [FilePath] -> [FilePath] pkgToTargets ~Pkg{..} tgt [] = (toTgt tgt . target <$> bin) <> (unpack . libTarget <$> libraries) @@ -257,12 +282,13 @@ where maybeTgt (Just t) = (<> ('-' : t)) maybeTgt Nothing = id -pkgToAction :: [IO ()] -- ^ Setup actions to be performed +pkgToAction :: Maybe String -- ^ Optional extra expression to which we should apply @atspkg.dhall@ + -> [IO ()] -- ^ Setup actions to be performed -> [String] -- ^ Targets -> Maybe String -- ^ Optional compiler triple (overrides 'ccompiler') -> Pkg -- ^ Package data type -> Rules () -pkgToAction setup rs tgt ~(Pkg bs ts lbs mt _ v v' ds cds bdeps ccLocal cf af as dl slv deb al) = +pkgToAction mStr setup rs tgt ~(Pkg bs ts lbs mt _ v v' ds cds bdeps ccLocal cf af as dl slv deb al) = unless (rs == ["clean"]) $ do @@ -272,12 +298,7 @@ want (unpack . cTarget <$> as) - newFlag <- do - exists <- liftIO (doesFileExist flags) - contents <- if exists - then liftIO (BSL.readFile flags) - else pure mempty - pure $ BSL.length contents /= 0 && encode tgt /= contents + newFlag <- shouldWrite tgt flags -- this is dumb but w/e flags %> \out -> do @@ -299,7 +320,7 @@ ph <- home' v' v - cDepsRules ph *> bits tgt rs + cDepsRules ph *> bits mStr tgt rs traverse_ (h ph) lbs