diff options
| -rw-r--r-- | lib/Distribution/Helper.hs | 16 | ||||
| -rw-r--r-- | src/CabalHelper/Compiletime/Log.hs | 2 | ||||
| -rw-r--r-- | src/CabalHelper/Compiletime/Program/CabalInstall.hs | 14 | ||||
| -rw-r--r-- | src/CabalHelper/Compiletime/Types.hs | 6 | ||||
| -rw-r--r-- | tests/CompileTest.hs | 2 | ||||
| -rw-r--r-- | tests/GhcSession.hs | 4 |
6 files changed, 25 insertions, 19 deletions
diff --git a/lib/Distribution/Helper.hs b/lib/Distribution/Helper.hs index ca5c1b1..95547c3 100644 --- a/lib/Distribution/Helper.hs +++ b/lib/Distribution/Helper.hs @@ -119,6 +119,7 @@ import System.Process import System.Posix.Types import System.PosixCompat.Files import Text.Printf +import Text.Read import Prelude import CabalHelper.Compiletime.Compile @@ -140,7 +141,7 @@ import qualified CabalHelper.Compiletime.Compat.ProgramDb as ProgDb import Distribution.System (buildPlatform) import Distribution.Text (display) -import Distribution.Verbosity (silent, deafening) +import Distribution.Verbosity (silent, normal, verbose, deafening) import Distribution.Simple.GHC as GHC (configure) -- $type-conventions @@ -189,7 +190,8 @@ mkQueryEnv projloc distdir = do { qeReadProcess = \stdin mcwd exe args -> readCreateProcess (proc exe args){ cwd = mcwd } stdin , qeCallProcess = \mcwd exe args -> do - let ?verbose = False -- TODO: we should get this from env or something + let ?verbose = \_ -> False -- TODO: we should get this from env or + -- something callProcessStderr mcwd exe args , qePrograms = defaultPrograms , qeCompPrograms = defaultCompPrograms @@ -569,9 +571,9 @@ lookupEnv' k = lookup k <$> getEnvironment withVerbosity :: (Verbose => IO a) -> IO a withVerbosity act = do x <- lookup "CABAL_HELPER_DEBUG" <$> getEnvironment - let ?verbose = - case x of - Just xs | not (null xs) -> True + let ?verbose = \level -> + case x >>= readMaybe of + Just x | x >= level -> True _ -> False act @@ -591,7 +593,9 @@ withProgs impl QueryEnv{..} f = do guessCompProgramPaths progs | same ghcProgram progs dprogs = return progs guessCompProgramPaths progs = do - let v | ?verbose = deafening + let v | ?verbose 2 = normal + | ?verbose 3 = verbose + | ?verbose 4 = deafening | otherwise = silent mGhcPath0 | same ghcProgram progs dprogs = Nothing | otherwise = Just $ ghcProgram progs diff --git a/src/CabalHelper/Compiletime/Log.hs b/src/CabalHelper/Compiletime/Log.hs index eefb30e..d817098 100644 --- a/src/CabalHelper/Compiletime/Log.hs +++ b/src/CabalHelper/Compiletime/Log.hs @@ -36,5 +36,5 @@ logIOError label a = do vLog :: (MonadIO m, Verbose) => String -> m () vLog msg - | ?verbose = liftIO $ hPutStrLn stderr msg + | ?verbose 0 = liftIO $ hPutStrLn stderr msg | otherwise = return () diff --git a/src/CabalHelper/Compiletime/Program/CabalInstall.hs b/src/CabalHelper/Compiletime/Program/CabalInstall.hs index 3f87215..f989a02 100644 --- a/src/CabalHelper/Compiletime/Program/CabalInstall.hs +++ b/src/CabalHelper/Compiletime/Program/CabalInstall.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE DataKinds #-} +{-# LANGUAGE DataKinds, MultiWayIf #-} -- cabal-helper: Simple interface to Cabal's configuration state -- Copyright (C) 2018 Daniel Gröber <cabal-helper@dxld.at> @@ -118,9 +118,9 @@ callCabalInstall then ["--no-require-sandbox"] else [] , [ "install", srcdir ] - , if ?verbose - then ["-v"] - else [] + , if | ?verbose 3 -> ["-v2"] + | ?verbose 4 -> ["-v3"] + | otherwise -> [] , [ "--only-dependencies" ] ] @@ -216,9 +216,9 @@ installCabalLibV2 _ghcVer (CabalVersion cabalVer) (PackageEnvFile env_file) = do , "--lib" , "Cabal-"++showVersion cabalVer ] - , if ?verbose - then ["-v"] - else [] + , if | ?verbose 3 -> ["-v2"] + | ?verbose 4 -> ["-v3"] + | otherwise -> [] ] tmp <- getTemporaryDirectory callProcessStderr (Just tmp) (cabalProgram ?progs) cabal_opts diff --git a/src/CabalHelper/Compiletime/Types.hs b/src/CabalHelper/Compiletime/Types.hs index 185725d..cea904e 100644 --- a/src/CabalHelper/Compiletime/Types.hs +++ b/src/CabalHelper/Compiletime/Types.hs @@ -303,8 +303,10 @@ data StackProjPaths = StackProjPaths -- Beware: GHC 8.0.2 doesn't like these being recursively defined for some -- reason so just keep them unrolled. -type Verbose = (?verbose :: Bool) -type Env = (?cprogs :: CompPrograms, ?progs :: Programs, ?verbose :: Bool) +type Verbose = (?verbose :: Word -> Bool) +type Env = ( ?cprogs :: CompPrograms + , ?progs :: Programs + , ?verbose :: Word -> Bool) type Progs = (?cprogs :: CompPrograms, ?progs :: Programs) type CProgs = (?cprogs :: CompPrograms) diff --git a/tests/CompileTest.hs b/tests/CompileTest.hs index bae5ad0..4ad5804 100644 --- a/tests/CompileTest.hs +++ b/tests/CompileTest.hs @@ -58,7 +58,7 @@ main = do let ?progs = defaultPrograms let ?cprogs = defaultCompPrograms let ?opts = defaultCompileOptions { oVerbose = True } - let ?verbose = True + let ?verbose = \level -> case level of 1 -> True; _ -> False args <- getArgs case args of diff --git a/tests/GhcSession.hs b/tests/GhcSession.hs index 38ff7c8..aad5be2 100644 --- a/tests/GhcSession.hs +++ b/tests/GhcSession.hs @@ -194,12 +194,12 @@ runTest ps2@(psdImpl -> ProjSetupImpl{..}) topdir projdir cabal_file = do runWithCwd :: FilePath -> String -> [String] -> IO () runWithCwd cwd x xs = do - let ?verbose = True + let ?verbose = (==1) callProcessStderr (Just cwd) x xs run :: String -> [String] -> IO () run x xs = do - let ?verbose = True + let ?verbose = (==1) callProcessStderr Nothing x xs test :: ProjSetup2 pt -> FilePath -> FilePath -> IO [Bool] |