diff --git a/app/Main.hs b/app/Main.hs --- a/app/Main.hs +++ b/app/Main.hs @@ -41,6 +41,7 @@ | Pack { _target :: String } | Test { _targets :: [String] , _rebuildAll :: Bool + , _verbosity :: Int , _lint :: Bool , _prof :: Bool } @@ -125,6 +126,7 @@ test' = Test <$> targets "test" <*> rebuild + <*> verbosity <*> noLint <*> profile @@ -192,7 +194,7 @@ 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 Nothing (Just pkgDir)] + let setup = [buildAll 0 Nothing (Just pkgDir)] withCurrentDirectory (takeDirectory pkgDir) (mkPkg False False False setup ["install"] Nothing 0) stopGlobalPool @@ -203,7 +205,7 @@ runHelper rba lint tim rs tgt v = g . bool x y =<< check Nothing where g xs = mkPkg rba lint tim xs rs tgt v >> stopGlobalPool y = mempty - x = [buildAll tgt Nothing] + x = [buildAll v tgt Nothing] run :: Command -> IO () run List = displayList "https://raw.githubusercontent.com/vmchale/atspkg/master/ats-pkg/pkgs/pkg-set.dhall" @@ -214,7 +216,7 @@ 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 lint tim) = runHelper rba lint tim ("test" : ts) Nothing 0 +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 diff --git a/ats-pkg.cabal b/ats-pkg.cabal --- a/ats-pkg.cabal +++ b/ats-pkg.cabal @@ -1,6 +1,6 @@ cabal-version: 1.18 name: ats-pkg -version: 2.10.0.17 +version: 2.10.0.20 license: BSD3 license-file: LICENSE copyright: Copyright: (c) 2018 Vanessa McHale @@ -30,9 +30,10 @@ cli-setup >=0.2.0.1 flag profile - description: Enable profiling - default: False - manual: True + description: + Enable profiling + default: False + manual: True flag eventlog description: @@ -109,7 +110,7 @@ dependency -any, filemanip -any - if flag(development) && impl(ghc <8.4) + if (flag(development) && impl(ghc <8.4)) ghc-options: -Werror executable atspkg @@ -118,12 +119,13 @@ other-modules: Paths_ats_pkg default-language: Haskell2010 - ghc-options: -threaded -rtsopts -with-rtsopts=-N -Wall -with-rtsopts=-I0 - -Wincomplete-uni-patterns -Wincomplete-record-updates + ghc-options: -threaded -rtsopts -with-rtsopts=-N -Wall + -with-rtsopts=-I0 -Wincomplete-uni-patterns + -Wincomplete-record-updates if flag(eventlog) ghc-options: -eventlog -with-rtsopts=-l - + if flag(profile) ghc-options: -with-rtsopts=-h 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 @@ -19,7 +19,7 @@ configureCabal :: IO LocalBuildInfo -> IO LocalBuildInfo configureCabal = (<*>) $ do - build mempty + build 1 mempty libDir <- (<> "/") <$> getCurrentDirectory pure (modifyConf libDir) 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,6 +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.ATS import Development.Shake.C (ccFromString) import Development.Shake.Check @@ -37,12 +38,13 @@ wants p = compiler <$> getConfig p -- | Build in current directory or indicated directory -buildAll :: Maybe String +buildAll :: Int + -> Maybe String -> Maybe FilePath -> IO () -buildAll tgt' p = on (>>) (=<< wants p) fetchDef setupDef +buildAll v tgt' p = on (>>) (=<< wants p) fetchDef setupDef where fetchDef = fetchCompiler - setupDef = setupCompiler atslibSetup tgt' + setupDef = setupCompiler (toVerbosity v) atslibSetup tgt' build' :: FilePath -- ^ Directory -> Maybe String -- ^ Target triple @@ -52,9 +54,10 @@ where mkPkgEmpty ts = mkPkg False True False ts rs tgt' 1 -- | Build a set of targets -build :: [String] -- ^ Targets +build :: Int + -> [String] -- ^ Targets -> IO () -build rs = bool (mkPkgEmpty [buildAll Nothing Nothing]) (mkPkgEmpty mempty) =<< check Nothing +build v rs = bool (mkPkgEmpty [buildAll v Nothing Nothing]) (mkPkgEmpty mempty) =<< check Nothing where mkPkgEmpty ts = mkPkg False True False ts rs Nothing 1 -- TODO clean generated ATS @@ -265,8 +268,8 @@ specialDeps %> \out -> do (_, cfgBin') <- cfgBin need [ cfgBin', ".atspkg/config" ] - -- TODO use an oracle for c compiler/flags - liftIO $ fetchDeps (ccFromString cc') setup (unpack . fst <$> ds) (unpack . fst <$> cdps) (unpack . fst <$> bdeps) cfgBin' atslibSetup False >> writeFile out "" + v'' <- getVerbosity + liftIO $ fetchDeps v'' (ccFromString cc') setup (unpack . fst <$> ds) (unpack . fst <$> cdps) (unpack . fst <$> bdeps) cfgBin' atslibSetup False >> writeFile out "" let bins = unpack . target <$> bs setTargets rs bins mt 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 @@ -25,34 +25,41 @@ where g "icc" = "cc" g x = x -clibSetup :: CCompiler -- ^ C compiler +makeExecutable :: FilePath -> [FilePath] -> IO () +makeExecutable file dirs = do + p <- findFile dirs file + fold (setFileMode <$> p <*> pure ownerModes) + +clibSetup :: Verbosity -- ^ Shake verbosity level + -> CCompiler -- ^ C compiler -> String -- ^ Library name -> FilePath -- ^ Filepath to unpack to -> IO () -clibSetup cc' lib' p = do +clibSetup v cc' lib' p = do -- Find configure script and make it executable subdirs <- allSubdirs p configurePath <- findFile (p:subdirs) "configure" cmakeLists <- findFile (p:subdirs) "CMakeLists.txt" fold (setFileMode <$> configurePath <*> pure ownerModes) + makeExecutable "install-sh" (p:subdirs) -- Set environment variables for configure script h <- cpkgHome cc' let procEnv = Just [("CC", ccForConfig cc'), ("CFLAGS" :: String, "-I" <> h <> "include"), ("PATH", "/usr/bin:/bin")] - biaxe [fold (configure h <$> configurePath <*> pure procEnv), cmake h cmakeLists, make, install] lib' p + biaxe [fold (configure v h <$> configurePath <*> pure procEnv), cmake v h cmakeLists, make v, install v] lib' p -cmake :: FilePath -> Maybe FilePath -> String -> FilePath -> IO () -cmake _ Nothing _ _ = mempty -cmake prefixPath (Just cfgLists) _ _ = do +cmake :: Verbosity -> FilePath -> Maybe FilePath -> String -> FilePath -> IO () +cmake _ _ Nothing _ _ = mempty +cmake v prefixPath (Just cfgLists) _ _ = do let p = takeDirectory cfgLists - silentCreateProcess ((proc "cmake" ["-DCMAKE_INSTALL_PREFIX:PATH=" ++ prefixPath, p]) { cwd = Just p }) + silentCreateProcess v ((proc "cmake" ["-DCMAKE_INSTALL_PREFIX:PATH=" ++ prefixPath, p]) { cwd = Just p }) -configure :: FilePath -> FilePath -> Maybe [(String, String)] -> String -> FilePath -> IO () -configure prefixPath configurePath procEnv lib' p = +configure :: Verbosity -> FilePath -> FilePath -> Maybe [(String, String)] -> String -> FilePath -> IO () +configure v prefixPath configurePath procEnv lib' p = putStrLn ("configuring " ++ lib' ++ "...") >> - silentCreateProcess ((proc configurePath ["--prefix", prefixPath, "--host", host]) { cwd = Just p, env = procEnv }) + silentCreateProcess v ((proc configurePath ["--prefix", prefixPath, "--host", host]) { cwd = Just p, env = procEnv }) findMakefile :: FilePath -> IO FilePath findMakefile p = do @@ -61,14 +68,14 @@ mp <- findFile (p:subdirs) "Makefile" pure $ maybe p takeDirectory mp -- (maybe p takeDirectory mp) takeDirectory mc -make :: String -> FilePath -> IO () -make lib' p = do +make :: Verbosity -> String -> FilePath -> IO () +make v lib' p = do putStrLn ("building " ++ lib' ++ "...") p' <- findMakefile p - silentCreateProcess ((proc "make" ["-j4"]) { cwd = Just p' }) + silentCreateProcess v ((proc "make" ["-j4"]) { cwd = Just p' }) -install :: String -> FilePath -> IO () -install lib' p = do +install :: Verbosity -> String -> FilePath -> IO () +install v lib' p = do putStrLn ("installing " ++ lib' ++ "...") p' <- findMakefile p - silentCreateProcess ((proc "make" ["install"]) { cwd = Just p' }) + silentCreateProcess v ((proc "make" ["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 @@ -62,10 +62,10 @@ withCompiler "Unpacking" v Tar.unpack cd . Tar.read . decompress $ response -make :: Version -> FilePath -> IO () -make v cd = +make :: Verbosity -> Version -> FilePath -> IO () +make v' v cd = withCompiler "Building" v >> - silentCreateProcess ((proc "make" []) { cwd = Just cd }) + silentCreateProcess v' ((proc "make" []) { cwd = Just cd }) type SetupScript = Maybe String -- ^ Optional target triple -> String -- ^ Library name @@ -80,35 +80,36 @@ , atslibSetup (Just triple) "atslib" cd ] -install :: Maybe String +install :: Verbosity + -> Maybe String -> SetupScript -> Version -> FilePath -> IO () -install tgt' als v cd = +install v' tgt' als v cd = withCompiler "Installing" v >> - silentCreateProcess ((proc "make" ["install"]) { cwd = Just cd }) >> + silentCreateProcess v' ((proc "make" ["install"]) { cwd = Just cd }) >> writeFile (cd ++ "/done") "" >> maybe mempty (libInstall als cd) tgt' -configure :: FilePath -> Version -> FilePath -> IO () -configure configurePath v cd = do +configure :: Verbosity -> FilePath -> Version -> FilePath -> IO () +configure v' configurePath v cd = do withCompiler "Configuring" v setFileMode configurePath ownerModes setFileMode (cd ++ "/autogen.sh") ownerModes - silentCreateProcess ((proc (cd ++ "/autogen.sh") []) { cwd = Just cd }) + silentCreateProcess v' ((proc (cd ++ "/autogen.sh") []) { cwd = Just cd }) - silentCreateProcess ((proc configurePath ["--prefix", cd]) { cwd = Just cd }) + silentCreateProcess v' ((proc configurePath ["--prefix", cd]) { cwd = Just cd }) -setupCompiler :: SetupScript -> Maybe FilePath -> Version -> IO () -setupCompiler als tgt' v = do +setupCompiler :: Verbosity -> SetupScript -> Maybe FilePath -> Version -> IO () +setupCompiler v' als tgt' v = do cd <- compilerDir v - biaxe [configure (cd ++ "/configure"), make, install tgt' als] v cd + biaxe [configure v' (cd ++ "/configure"), make v', install v' tgt' als] v cd cleanAll :: IO () cleanAll = do 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 @@ -29,7 +29,8 @@ getTgt (GHC x _) = x getTgt _ = Nothing -fetchDeps :: CCompiler -- ^ C compiler to use +fetchDeps :: Verbosity -- ^ Shake verbosity + -> CCompiler -- ^ C compiler to use -> [IO ()] -- ^ Setup steps that can be performed concurrently -> [String] -- ^ ATS dependencies -> [String] -- ^ C Dependencies @@ -38,7 +39,7 @@ -> SetupScript -- ^ How to install an ATS library -> Bool -- ^ Whether to perform setup anyhow. -> IO () -fetchDeps cc' setup' deps cdeps atsBld cfgPath als b' = +fetchDeps v cc' setup' deps cdeps atsBld cfgPath als b' = unless (null deps && null cdeps && null atsBld && b') $ do @@ -56,7 +57,7 @@ unpacked = fmap (over dirLens (pack d <>)) <$> cdeps' clibs = fmap (buildHelper False) (join unpacked) atsLibs = fmap (buildHelper False) (join atsDeps') - cBuild = mapM_ (setup cc') <$> (transpose . fmap reverse) unpacked + cBuild = mapM_ (setup v cc') <$> (transpose . fmap reverse) unpacked atsBuild = mapM_ (atsPkgSetup als tgt') <$> (transpose . fmap reverse) atsDeps' -- Fetch all packages & build compiler @@ -83,14 +84,15 @@ als tgt' (unpack lib') (unpack dirName') writeFile lib'' "" -setup :: CCompiler -- ^ C compiler to use +setup :: Verbosity + -> CCompiler -- ^ C compiler to use -> ATSDependency -- ^ ATSDependency itself -> IO () -setup cc' (ATSDependency lib' dirName' _ _ _ _ _ _ _) = do +setup v' cc' (ATSDependency lib' dirName' _ _ _ _ _ _ _) = do lib'' <- (<> unpack lib') <$> cpkgHome cc' b <- doesFileExist lib'' unless b $ do - clibSetup cc' (unpack lib') (unpack dirName') + clibSetup v' cc' (unpack lib') (unpack dirName') writeFile lib'' "" getCompressor :: Text -> IO (ByteString -> ByteString) diff --git a/src/System/Process/Ext.hs b/src/System/Process/Ext.hs --- a/src/System/Process/Ext.hs +++ b/src/System/Process/Ext.hs @@ -2,8 +2,20 @@ ) where import Control.Monad +import Development.Shake +import System.Exit import System.Process -silentCreateProcess :: CreateProcess -> IO () -silentCreateProcess proc' = - void $ readCreateProcess (proc' { std_err = CreatePipe }) "" +verbosityErr :: Verbosity -> StdStream +verbosityErr v | v >= Loud = Inherit +verbosityErr _ = CreatePipe + +handleExit :: ExitCode -> IO () +handleExit ExitSuccess = mempty +handleExit x = exitWith x + +silentCreateProcess :: Verbosity -> CreateProcess -> IO () +silentCreateProcess v proc' | v >= Chatty = do + (_, _, _, r) <- createProcess (proc' { std_err = verbosityErr v, std_out = Inherit }) + handleExit =<< waitForProcess r +silentCreateProcess v proc' = void $ readCreateProcess (proc' { std_err = verbosityErr v }) ""