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

Merge branch 'improve-logging'

Browse Source
This commit is contained in:
Julian Ospald 2021-07-11 17:41:32 +02:00
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 - old
viChangeLog: https://github.com/commercialhaskell/stack/blob/master/ChangeLog.md#v251 viChangeLog: https://github.com/commercialhaskell/stack/blob/master/ChangeLog.md#v251
viPostInstall: &stack-post | 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 Stack manages GHC versions internally by default. In order to make it use ghcup installed
Additionally, you should upgrade stack only through ghcup. 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: viArch:
A_64: A_64:
Linux_UnknownLinux: Linux_UnknownLinux:

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

@ -20,6 +20,7 @@ import GHCup.Utils.String.QQ
import Control.Monad import Control.Monad
import Control.Monad.IO.Class import Control.Monad.IO.Class
import Control.Monad.Logger import Control.Monad.Logger
import Data.Char ( ord )
import Prelude hiding ( appendFile ) import Prelude hiding ( appendFile )
import System.Console.Pretty import System.Console.Pretty
import System.FilePath import System.FilePath
@ -43,13 +44,26 @@ myLoggerT LoggerConfig {..} loggingt = runLoggingT loggingt mylogger
mylogger :: Loc -> LogSource -> LogLevel -> LogStr -> IO () mylogger :: Loc -> LogSource -> LogLevel -> LogStr -> IO ()
mylogger _ _ level str' = do mylogger _ _ level str' = do
-- color output -- 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 let l = case level of
LevelDebug -> toLogStr (style Bold $ color Blue "[ Debug ]") LevelDebug -> toLogStr (style' "[ Debug ]")
LevelInfo -> toLogStr (style Bold $ color Green "[ Info ]") LevelInfo -> toLogStr (style' "[ Info ]")
LevelWarn -> toLogStr (style Bold $ color Yellow "[ Warn ]") LevelWarn -> toLogStr (style' "[ Warn ]")
LevelError -> toLogStr (style Bold $ color Red "[ Error ]") LevelError -> toLogStr (style' "[ Error ]")
LevelOther t -> toLogStr "[ " <> toLogStr t <> toLogStr " ]" 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))) when (lcPrintDebug || (not lcPrintDebug && (level /= LevelDebug)))
$ colorOutter out $ colorOutter out