Add log-level to verbosity conditional

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]