diff --git a/Setup.hs b/Setup.hs --- a/Setup.hs +++ b/Setup.hs @@ -2,6 +2,7 @@ import Data.Bool (bool) import Data.Foldable (fold) +import Data.Functor (($>)) import Distribution.CommandLine import Distribution.PackageDescription import Distribution.Simple @@ -22,4 +23,4 @@ main :: IO () main = defaultMainWithHooks $ - simpleUserHooks { preConf = \_ flags -> maybeInstallActions flags >> pure emptyHookedBuildInfo } + simpleUserHooks { preConf = \_ flags -> maybeInstallActions flags $> emptyHookedBuildInfo } diff --git a/app/Main.hs b/app/Main.hs --- a/app/Main.hs +++ b/app/Main.hs @@ -203,7 +203,7 @@ 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 + where g xs = mkPkg rba lint tim xs rs tgt v *> stopGlobalPool y = mempty x = [buildAll v tgt Nothing] diff --git a/ats-pkg.cabal b/ats-pkg.cabal --- a/ats-pkg.cabal +++ b/ats-pkg.cabal @@ -1,12 +1,11 @@ cabal-version: 1.18 name: ats-pkg -version: 2.11.0.1 +version: 2.11.0.7 license: BSD3 license-file: LICENSE copyright: Copyright: (c) 2018 Vanessa McHale maintainer: vamchale@gmail.com author: Vanessa McHale -homepage: https://github.com/vmchale/atspkg/tree/master/ats-pkg#readme bug-reports: https://github.com/vmchale/atspkg/issues synopsis: A build tool for ATS description: @@ -30,11 +29,6 @@ Cabal >=2.2, cli-setup >=0.2.0.1 -flag static - description: - Make static binaries - default: False - flag profile description: Enable profiling @@ -164,6 +158,3 @@ if flag(development) ghc-options: -Werror - - if flag(static) - ghc-options: -static -optc-static -optl-static diff --git a/src/Distribution/ATS/Build.hs b/src/Distribution/ATS/Build.hs --- a/src/Distribution/ATS/Build.hs +++ b/src/Distribution/ATS/Build.hs @@ -14,11 +14,12 @@ -- | Use this in place of 'defaultMain' for a simple build. atsPolyglotBuild :: IO () atsPolyglotBuild = - defaultMainWithHooks cabalHooks >> + defaultMainWithHooks cabalHooks *> stopGlobalPool configureCabal :: IO LocalBuildInfo -> IO LocalBuildInfo configureCabal = (<*>) $ do + -- TODO get host triple from Platform of LocalBuildInfo build 1 mempty libDir <- (<> [pathSeparator]) <$> getCurrentDirectory pure (modifyConf libDir) @@ -44,14 +45,14 @@ -- | Write a dummy file that will allow packaging to work. writeDummyFile :: IO () writeDummyFile = - createDirectoryIfMissing True ("dist-newstyle" "lib") >> + createDirectoryIfMissing True ("dist-newstyle" "lib") *> writeFile ("dist-newstyle" "lib" "empty") "" -- | This uses the users hooks as is @simpleUserHooks@, modified to build the -- ATS library. cabalHooks :: UserHooks cabalHooks = let defConf = confHook simpleUserHooks - in simpleUserHooks { preConf = (writeDummyFile >>) .* preConf simpleUserHooks + in simpleUserHooks { preConf = (writeDummyFile *>) .* preConf simpleUserHooks , confHook = configureCabal .* defConf } -- FIXME registration + installation/copy hooks -- ideally in a library of its own for C builds 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 @@ -13,7 +13,7 @@ import qualified Data.ByteString as BS import qualified Data.ByteString.Lazy as BSL import Data.List (intercalate) -import Development.Shake (getVerbosity) +import Development.Shake (alwaysRerun, getVerbosity) import Development.Shake.ATS import Development.Shake.C (ccFromString) import Development.Shake.Check @@ -42,7 +42,7 @@ -> Maybe String -> Maybe FilePath -> IO () -buildAll v tgt' p = on (>>) (=<< wants p) fetchDef setupDef +buildAll v tgt' p = on (*>) (=<< wants p) fetchDef setupDef where fetchDef = fetchCompiler setupDef = setupCompiler (toVerbosity v) atslibSetup tgt' @@ -130,7 +130,7 @@ config <- getConfig Nothing let runs = bool (filter (/= cmdStr) rs) (fmap (unpack . target) . select $ config) (rs == [cmdStr]) need runs - mapM_ cmd_ (f <$> runs) + traverse_ cmd_ (f <$> runs) mkValgrind :: [String] -> Rules () mkValgrind = mkPhony "valgrind" ("valgrind " <>) bin @@ -227,6 +227,7 @@ subdirs <- (p:) <$> allSubdirs p pkgPath <- fromMaybe p <$> findFile subdirs "atspkg.dhall" let installDir = takeDirectory pkgPath + -- removeDirectoryRecursive (installDir ".atspkg") build' installDir tgt' ["install"] -- | The directory @~/.atspkg@ @@ -270,23 +271,38 @@ 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 + + -- this is dumb but w/e + flags %> \out -> do + alwaysRerun + exists <- liftIO (doesFileExist out) + liftIO $ if not exists || newFlag + then BSL.writeFile out (encode tgt) + else mempty + -- TODO depend on tgt somehow? specialDeps %> \out -> do (_, cfgBin') <- cfgBin - need [ cfgBin', ".atspkg" "config" ] + need [ cfgBin', flags, ".atspkg" "config" ] v'' <- getVerbosity - liftIO $ fetchDeps v'' (ccFromString cc') setup (unpack . fst <$> ds) (unpack . fst <$> cdps) (unpack . fst <$> bdeps) cfgBin' atslibSetup False >> writeFile out "" + liftIO $ fetchDeps v'' (ccFromString cc') setup (unpack . fst <$> ds) (unpack . fst <$> cdps) (unpack . fst <$> bdeps) cfgBin' atslibSetup False *> writeFile out "" let bins = toTgt tgt . target <$> bs setTargets rs bins mt ph <- home' v' v - cDepsRules ph >> bits tgt rs + cDepsRules ph *> bits tgt rs - mapM_ (h ph) lbs + traverse_ (h ph) lbs - mapM_ (g ph) (bs ++ ts) + traverse_ (g ph) (bs ++ ts) fold (debRules <$> deb) @@ -307,7 +323,7 @@ zipWithM_ (cgen (atsToolConfig ph) [specialDeps, ".atspkg" "config"] (fmap (unpack . ats) . atsGen =<< as)) sources targets cc' = maybe (unpack ccLocal) (<> "-gcc") tgt - deps = (specialDeps:) . ((".atspkg" "config"):) . fmap unpack + deps = (flags:) . (specialDeps:) . ((".atspkg" "config"):) . fmap unpack unpackLinks :: (Text, Text) -> HATSGen unpackLinks (t, t') = HATSGen (unpack t) (unpack t') @@ -316,3 +332,4 @@ unpackTgt (TargetPair t t' b) = ATSGen (unpack t) (unpack t') b specialDeps = ".atspkg" "deps" ++ maybe "" ("-" <>) tgt + flags = ".atspkg" "flags" diff --git a/src/Language/ATS/Package/Build/C.hs b/src/Language/ATS/Package/Build/C.hs --- a/src/Language/ATS/Package/Build/C.hs +++ b/src/Language/ATS/Package/Build/C.hs @@ -16,19 +16,18 @@ d' <- listDirectory d let d'' = (d ) <$> d' ds <- filterM doesDirectoryExist d'' - ds' <- mapM allSubdirs ds + ds' <- traverse allSubdirs ds pure $ join (ds : ds') - ccForConfig :: CCompiler -> String ccForConfig = g . ccToString where g "icc" = "cc" g x = x -{-makeExecutable' :: FilePath -> [FilePath] -> IO () +makeExecutable' :: FilePath -> [FilePath] -> IO () makeExecutable' file dirs = do p <- findFile dirs file - fold (setFileMode <$> p <*> pure ownerModes)-} + fold (makeExecutable <$> p) clibSetup :: Verbosity -- ^ Shake verbosity level -> CCompiler -- ^ C compiler @@ -37,13 +36,12 @@ -> IO () clibSetup v cc' lib' p = do - -- TODO autogen.sh - -- Find configure script and make it executable subdirs <- allSubdirs p configurePath <- findFile (p:subdirs) "configure" cmakeLists <- findFile (p:subdirs) "CMakeLists.txt" fold (makeExecutable <$> configurePath) + makeExecutable' "install-sh" (p:subdirs) -- Set environment variables for configure script h <- cpkgHome cc' @@ -59,7 +57,7 @@ configure :: Verbosity -> FilePath -> FilePath -> Maybe [(String, String)] -> String -> FilePath -> IO () configure v prefixPath configurePath procEnv lib' p = - putStrLn ("configuring " ++ lib' ++ "...") >> + putStrLn ("configuring " ++ lib' ++ "...") *> silentCreateProcess v ((proc configurePath ["--prefix", prefixPath, "--host", host]) { cwd = Just p, env = procEnv }) findMakefile :: FilePath -> IO FilePath @@ -72,10 +70,10 @@ make v lib' p = do putStrLn ("building " ++ lib' ++ "...") p' <- findMakefile p - silentCreateProcess v ((proc "make" ["-j4"]) { cwd = Just p' }) + silentCreateProcess v ((proc makeExe ["-j4"]) { cwd = Just p' }) install :: Verbosity -> String -> FilePath -> IO () install v lib' p = do putStrLn ("installing " ++ lib' ++ "...") p' <- findMakefile p - silentCreateProcess v ((proc "make" ["install"]) { cwd = Just p' }) + silentCreateProcess v ((proc makeExe ["install"]) { cwd = Just p' }) 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 @@ -64,8 +64,8 @@ make :: Verbosity -> Version -> FilePath -> IO () make v' v cd = - withCompiler "Building" v >> - silentCreateProcess v' ((proc "make" []) { cwd = Just cd }) + withCompiler "Building" v *> + silentCreateProcess v' ((proc makeExe []) { cwd = Just cd }) type SetupScript = Maybe String -- ^ Optional target triple -> String -- ^ Library name @@ -76,7 +76,7 @@ libInstall atslibSetup cd triple = unless (triple == "musl") $ mconcat [ putStrLn "Installing cross libraries..." - , writeFile (cd ++ "/atspkg.dhall") libatsCfg + , writeFile (cd "atspkg.dhall") libatsCfg , atslibSetup (Just triple) "atslib" cd ] @@ -87,8 +87,8 @@ -> FilePath -> IO () install v' tgt' als v cd = - withCompiler "Installing" v >> - silentCreateProcess v' ((proc "make" ["install"]) { cwd = Just cd }) >> + withCompiler "Installing" v *> + silentCreateProcess v' ((proc makeExe ["install"]) { cwd = Just cd }) *> maybe mempty (libInstall als cd) tgt' configure :: Verbosity -> FilePath -> Version -> FilePath -> IO () diff --git a/src/Language/ATS/Package/Debian.hs b/src/Language/ATS/Package/Debian.hs --- a/src/Language/ATS/Package/Debian.hs +++ b/src/Language/ATS/Package/Debian.hs @@ -14,7 +14,7 @@ import Data.Hashable (Hashable) import Data.List (intercalate) import Data.Text.Lazy (Text) -import Development.Shake +import Development.Shake hiding ((*>)) import Development.Shake.FilePath import Dhall import Quaalude @@ -57,13 +57,13 @@ libDir = makeRel "/usr/local/lib" manDir = makeRel "/usr/local/share/man/man1" - mapM_ (liftIO . createDirectoryIfMissing True) + traverse_ (liftIO . createDirectoryIfMissing True) [ binDir, debianDir, manDir ] fold $ do mp <- manpage deb pure $ - need [unpack mp] >> + need [unpack mp] *> copyFile' (unpack mp) (manDir ++ "/" ++ takeFileName (unpack mp)) zipWithM_ copyFile' (unpack <$> binaries deb) (((binDir ++ "/") ++) . unpack <$> binaries deb) 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 @@ -57,15 +57,15 @@ unpacked = fmap (over dirLens (pack d <>)) <$> cdeps' clibs = fmap (buildHelper False) (join unpacked) atsLibs = fmap (buildHelper False) (join atsDeps') - cBuild = mapM_ (setup v cc') <$> (transpose . fmap reverse) unpacked - atsBuild = mapM_ (atsPkgSetup als tgt') <$> (transpose . fmap reverse) atsDeps' + cBuild = traverse_ (setup v cc') <$> (transpose . fmap reverse) unpacked + atsBuild = traverse_ (atsPkgSetup als tgt') <$> (transpose . fmap reverse) atsDeps' -- Fetch all packages & build compiler parallel' $ join [ setup', libs', clibs, atsLibs ] let tagBuild str bld = unless (null bld) $ - putStrLn (mconcat ["Building ", str, " dependencies..."]) >> + putStrLn (mconcat ["Building ", str, " dependencies..."]) *> sequence_ bld -- FIXME parallel' zipWithM_ tagBuild [ "C", "ATS" ] [ cBuild, atsBuild ] diff --git a/src/Language/ATS/Package/Dhall.hs b/src/Language/ATS/Package/Dhall.hs --- a/src/Language/ATS/Package/Dhall.hs +++ b/src/Language/ATS/Package/Dhall.hs @@ -7,17 +7,19 @@ import Language.ATS.Package.Type import Quaalude +-- | Check a @pkg.dhall@ file. checkPkg :: FilePath -> Bool -> IO (Version -> ATSDependency) checkPkg = checkDhall checkDhall :: Interpret a - => FilePath - -> Bool - -> IO a + => FilePath + -> Bool + -> IO a checkDhall path d = - bool id detailed d $ input auto (pack ('.' : pathSeparator : path)) + bool id detailed d $ + input auto (pack ('.' : pathSeparator : path)) checkPkgSet :: FilePath -- ^ Path to @.dhall@ file defining a package set. -> Bool -- ^ Whether to print detailed error messages. diff --git a/src/Language/ATS/Package/Error.hs b/src/Language/ATS/Package/Error.hs --- a/src/Language/ATS/Package/Error.hs +++ b/src/Language/ATS/Package/Error.hs @@ -26,4 +26,4 @@ -- TODO monaderror? printErr :: PackageError -> IO a -printErr e = putDoc (pretty e) >> exitFailure +printErr e = putDoc (pretty e) *> exitFailure 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 @@ -57,9 +57,9 @@ pkgSet <- listDeps False url case mkBuildPlan getDeps pkgSet deps of Left x -> resolutionFailed x - Right x -> createDirectoryIfMissing True ".atspkg" >> - BSL.writeFile depCache (encode x) >> - pure x + Right x -> createDirectoryIfMissing True ".atspkg" *> + BSL.writeFile depCache (encode x) $> + x mkBuildPlan :: DepSelector -> ATSPackageSet diff --git a/src/Language/ATS/Package/Upgrade.hs b/src/Language/ATS/Package/Upgrade.hs --- a/src/Language/ATS/Package/Upgrade.hs +++ b/src/Language/ATS/Package/Upgrade.hs @@ -25,7 +25,7 @@ upgradeBin :: String -> String -> IO () upgradeBin user proj = do - let inner = user <> "/" <> proj + let inner = user proj putStrLn "Finding latest release..." manager <- newManager tlsManagerSettings diff --git a/src/Quaalude.cpphs b/src/Quaalude.cpphs --- a/src/Quaalude.cpphs +++ b/src/Quaalude.cpphs @@ -24,13 +24,17 @@ , (&&&) , (<=<) , (<>) + , ($>) , first , second , getEnv , exitWith , showVersion + , traverse_ , ExitCode (ExitSuccess) , MonadIO (..) + -- * Miscellaneous + , makeExe -- * "System.Process.Ext" reëxports , silentCreateProcess -- * "Data.Text.Lazy" reëxports @@ -123,7 +127,8 @@ import Data.Binary import Data.Bool (bool) import Data.ByteString.Lazy (ByteString) -import Data.Foldable (fold) +import Data.Foldable (fold, traverse_) +import Data.Functor (($>)) import Data.List import Data.Maybe (fromMaybe) import Data.Semigroup @@ -140,6 +145,7 @@ 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 @@ -156,6 +162,15 @@ makeExecutable :: FilePath -> IO () makeExecutable = flip setFileMode ownerModes #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