hasufell
/
ghcup-hs
1
1
Fork 0
Code Issues Pull Requests Releases Wiki Activity

Merge branch 'improve-logging'

This commit is contained in:
Julian Ospald 2021-07-11 17:41:32 +02:00
parent 7de552ed82 5cf297a4d2
commit bcd244a92a
Signed by: hasufell
GPG Key ID: 3786C5262ECB4A3F
2 changed files with 31 additions and 8 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

13
ghcup-0.0.5.yaml
View File

@ -2120,8 +2120,17 @@ ghcupDownloads:
- old
viChangeLog: https://github.com/commercialhaskell/stack/blob/master/ChangeLog.md#v251
viPostInstall: &stack-post |
Stack manages GHC versions internally by default. In order to make it use ghcup installed GHC versions have a look at the options 'system-ghc', 'compiler-check' and 'compiler': https://docs.haskellstack.org/en/stable/yaml_configuration/#system-ghc
Additionally, you should upgrade stack only through ghcup.
Stack manages GHC versions internally by default. In order to make it use ghcup installed
GHC versions you can run the following commands:
stack config set install-ghc false --global
stack config set system-ghc true --global
On windows, you may find the following config options useful too:
skip-msys, extra-path, extra-include-dirs, extra-lib-dirs
Also check out: https://docs.haskellstack.org/en/stable/yaml_configuration
!!! Additionally, you should upgrade stack only through ghcup and not use 'stack upgrade' !!!
viArch:
A_64:
Linux_UnknownLinux:

26
lib/GHCup/Utils/Logger.hs
View File

@ -20,6 +20,7 @@ import GHCup.Utils.String.QQ
import Control.Monad
import Control.Monad.IO.Class
import Control.Monad.Logger
import Data.Char ( ord )
import Prelude hiding ( appendFile )
import System.Console.Pretty
import System.FilePath
@ -43,20 +44,33 @@ myLoggerT LoggerConfig {..} loggingt = runLoggingT loggingt mylogger
mylogger :: Loc -> LogSource -> LogLevel -> LogStr -> IO ()
mylogger _ _ level str' = do
-- color output
let style' = case level of
LevelDebug -> style Bold . color Blue
LevelInfo -> style Bold . color Green
LevelWarn -> style Bold . color Yellow
LevelError -> style Bold . color Red
LevelOther _ -> id
let l = case level of
LevelDebug -> toLogStr (style Bold $ color Blue "[ Debug ]")
LevelInfo -> toLogStr (style Bold $ color Green "[ Info ]")
LevelWarn -> toLogStr (style Bold $ color Yellow "[ Warn ]")
LevelError -> toLogStr (style Bold $ color Red "[ Error ]")
LevelDebug -> toLogStr (style' "[ Debug ]")
LevelInfo -> toLogStr (style' "[ Info ]")
LevelWarn -> toLogStr (style' "[ Warn ]")
LevelError -> toLogStr (style' "[ Error ]")
LevelOther t -> toLogStr "[ " <> toLogStr t <> toLogStr " ]"
let out = fromLogStr (l <> toLogStr " " <> str' <> toLogStr "\n")
let strs = fmap toLogStr . B.split (fromIntegral $ ord '\n') . fromLogStr $ str'
let out = case strs of
[] -> B.empty
(x:xs) -> fromLogStr
. foldr (\a b -> a <> toLogStr "\n" <> b) mempty
. ((l <> toLogStr " " <> x) :)
. fmap (\line' -> toLogStr (style' "[ ... ] ") <> line' )
$ xs
when (lcPrintDebug || (not lcPrintDebug && (level /= LevelDebug)))
$ colorOutter out
-- raw output
let lr = case level of
LevelDebug -> toLogStr "Debug: "
LevelDebug -> toLogStr "Debug:"
LevelInfo -> toLogStr "Info:"
LevelWarn -> toLogStr "Warn:"
LevelError -> toLogStr "Error:"