Compare commits

...

8 Commits

20 changed files with 209 additions and 147 deletions

View File

@@ -86,7 +86,7 @@ variables:
.freebsd12: .freebsd12:
tags: tags:
- x86_64-freebsd - x86_64-freebsd12
variables: variables:
OS: "FREEBSD" OS: "FREEBSD"
ARCH: "64" ARCH: "64"

View File

@@ -11,21 +11,23 @@
module Main where module Main where
import GHCup.Types import GHCup.Types
import GHCup.Types.Optics
import GHCup.Errors import GHCup.Errors
import GHCup.Platform import GHCup.Platform
import GHCup.Utils.Dirs import GHCup.Utils.Dirs
import GHCup.Utils.Logger
import GHCup.Types.JSON ( ) import GHCup.Types.JSON ( )
import Control.Monad.Trans.Reader ( runReaderT ) import Control.Monad.Trans.Reader ( runReaderT )
import Control.Monad.IO.Class import Control.Monad.IO.Class
import Data.Char ( toLower ) import Data.Char ( toLower )
import Data.Maybe
#if !MIN_VERSION_base(4,13,0) #if !MIN_VERSION_base(4,13,0)
import Data.Semigroup ( (<>) ) import Data.Semigroup ( (<>) )
#endif #endif
import Options.Applicative hiding ( style ) import Options.Applicative hiding ( style )
import Haskus.Utils.Variant.Excepts import Haskus.Utils.Variant.Excepts
import System.Console.Pretty import System.Console.Pretty
import System.Environment
import System.Exit import System.Exit
import System.IO ( stderr ) import System.IO ( stderr )
import Text.Regex.Posix import Text.Regex.Posix
@@ -114,9 +116,11 @@ com = subparser
main :: IO () main :: IO ()
main = do main = do
no_color <- isJust <$> lookupEnv "NO_COLOR"
let loggerConfig = LoggerConfig { lcPrintDebug = True let loggerConfig = LoggerConfig { lcPrintDebug = True
, colorOutter = T.hPutStr stderr , consoleOutter = T.hPutStr stderr
, rawOutter = \_ -> pure () , fileOutter = \_ -> pure ()
, fancyColors = not no_color
} }
dirs <- liftIO getAllDirs dirs <- liftIO getAllDirs
let leanAppstate = LeanAppState (Settings True False Never Curl True GHCupURL False GPGNone) dirs defaultKeyBindings loggerConfig let leanAppstate = LeanAppState (Settings True False Never Curl True GHCupURL False GPGNone) dirs defaultKeyBindings loggerConfig

View File

@@ -15,6 +15,7 @@ import GHCup.Errors
import GHCup.Types import GHCup.Types
import GHCup.Types.Optics import GHCup.Types.Optics
import GHCup.Utils import GHCup.Utils
import GHCup.Utils.Logger
import GHCup.Utils.Version.QQ import GHCup.Utils.Version.QQ
import Codec.Archive import Codec.Archive

View File

@@ -13,9 +13,9 @@ module BrickMain where
import GHCup import GHCup
import GHCup.Download import GHCup.Download
import GHCup.Errors import GHCup.Errors
import GHCup.Types.Optics hiding ( getGHCupInfo )
import GHCup.Types hiding ( LeanAppState(..) ) import GHCup.Types hiding ( LeanAppState(..) )
import GHCup.Utils import GHCup.Utils
import GHCup.Utils.Logger
import GHCup.Utils.Prelude ( decUTF8Safe ) import GHCup.Utils.Prelude ( decUTF8Safe )
import GHCup.Utils.File import GHCup.Utils.File
@@ -538,8 +538,9 @@ settings' :: IORef AppState
settings' = unsafePerformIO $ do settings' = unsafePerformIO $ do
dirs <- getAllDirs dirs <- getAllDirs
let loggerConfig = LoggerConfig { lcPrintDebug = False let loggerConfig = LoggerConfig { lcPrintDebug = False
, colorOutter = \_ -> pure () , consoleOutter = \_ -> pure ()
, rawOutter = \_ -> pure () , fileOutter = \_ -> pure ()
, fancyColors = True
} }
newIORef $ AppState (Settings { cache = True newIORef $ AppState (Settings { cache = True
, noVerify = False , noVerify = False

View File

@@ -1339,8 +1339,9 @@ tagCompleter tool add = listIOCompleter $ do
dirs' <- liftIO getAllDirs dirs' <- liftIO getAllDirs
let loggerConfig = LoggerConfig let loggerConfig = LoggerConfig
{ lcPrintDebug = False { lcPrintDebug = False
, colorOutter = mempty , consoleOutter = mempty
, rawOutter = mempty , fileOutter = mempty
, fancyColors = False
} }
let appState = LeanAppState let appState = LeanAppState
(Settings True False Never Curl False GHCupURL True GPGNone) (Settings True False Never Curl False GHCupURL True GPGNone)
@@ -1365,8 +1366,9 @@ versionCompleter criteria tool = listIOCompleter $ do
dirs' <- liftIO getAllDirs dirs' <- liftIO getAllDirs
let loggerConfig = LoggerConfig let loggerConfig = LoggerConfig
{ lcPrintDebug = False { lcPrintDebug = False
, colorOutter = mempty , consoleOutter = mempty
, rawOutter = mempty , fileOutter = mempty
, fancyColors = False
} }
let settings = Settings True False Never Curl False GHCupURL True GPGNone let settings = Settings True False Never Curl False GHCupURL True GPGNone
let leanAppState = LeanAppState let leanAppState = LeanAppState
@@ -1688,17 +1690,19 @@ Report bugs at <https://gitlab.haskell.org/haskell/ghcup-hs/issues>|]
-- logger interpreter -- logger interpreter
logfile <- flip runReaderT dirs initGHCupFileLogging logfile <- flip runReaderT dirs initGHCupFileLogging
no_color <- isJust <$> lookupEnv "NO_COLOR"
let loggerConfig = LoggerConfig let loggerConfig = LoggerConfig
{ lcPrintDebug = verbose settings { lcPrintDebug = verbose settings
, colorOutter = T.hPutStr stderr , consoleOutter = T.hPutStr stderr
, rawOutter = , fileOutter =
case optCommand of case optCommand of
Nuke -> \_ -> pure () Nuke -> \_ -> pure ()
_ -> T.appendFile logfile _ -> T.appendFile logfile
, fancyColors = not no_color
} }
let leanAppstate = LeanAppState settings dirs keybindings loggerConfig let leanAppstate = LeanAppState settings dirs keybindings loggerConfig
let runLogger = flip runReaderT leanAppstate let runLogger = flip runReaderT leanAppstate
let siletRunLogger = flip runReaderT (leanAppstate { loggerConfig = loggerConfig { colorOutter = \_ -> pure () } } :: LeanAppState) let siletRunLogger = flip runReaderT (leanAppstate { loggerConfig = loggerConfig { consoleOutter = \_ -> pure () } } :: LeanAppState)
------------------------- -------------------------
@@ -2336,7 +2340,7 @@ Report bugs at <https://gitlab.haskell.org/haskell/ghcup-hs/issues>|]
List ListOptions {..} -> List ListOptions {..} ->
runListGHC (do runListGHC (do
l <- listVersions loTool lCriteria l <- listVersions loTool lCriteria
liftIO $ printListResult lRawFormat l liftIO $ printListResult no_color lRawFormat l
pure ExitSuccess pure ExitSuccess
) )
@@ -2807,9 +2811,8 @@ fromVersion' (SetToolTag t') tool =
throwE $ TagNotFound t' tool throwE $ TagNotFound t' tool
printListResult :: Bool -> [ListResult] -> IO () printListResult :: Bool -> Bool -> [ListResult] -> IO ()
printListResult raw lr = do printListResult no_color raw lr = do
no_color <- isJust <$> lookupEnv "NO_COLOR"
let let
color | raw || no_color = flip const color | raw || no_color = flip const

View File

@@ -2269,7 +2269,7 @@ ghcupDownloads:
dlUri: https://downloads.haskell.org/~ghcup/unofficial-bindists/cabal/3.6.0.0/cabal-install-3.6.0.0-armv7-linux.tar.xz dlUri: https://downloads.haskell.org/~ghcup/unofficial-bindists/cabal/3.6.0.0/cabal-install-3.6.0.0-armv7-linux.tar.xz
dlHash: 11b5ca042a8bf45971224f2127a3e9d6b803f09210042ca80a254bea06f01a2e dlHash: 11b5ca042a8bf45971224f2127a3e9d6b803f09210042ca80a254bea06f01a2e
GHCup: GHCup:
0.1.16.2: 0.1.17:
viTags: viTags:
- Recommended - Recommended
- Latest - Latest
@@ -2279,43 +2279,43 @@ ghcupDownloads:
A_64: A_64:
Linux_UnknownLinux: Linux_UnknownLinux:
unknown_versioning: &ghcup-64 unknown_versioning: &ghcup-64
dlUri: https://downloads.haskell.org/~ghcup/0.1.16.2/x86_64-linux-ghcup-0.1.16.2 dlUri: https://downloads.haskell.org/~ghcup/0.1.17/x86_64-linux-ghcup-0.1.17
dlHash: d5e43b95ce1d42263376e414f7eb7c5dd440271c7c6cd9bad446fdeff3823893 dlHash: 1eaa33af4180f97edf02822d6d711ce618d9828fe9ebbf042d198fe6c1c9d153
Darwin: Darwin:
unknown_versioning: unknown_versioning:
dlUri: https://downloads.haskell.org/~ghcup/0.1.16.2/x86_64-apple-darwin-ghcup-0.1.16.2 dlUri: https://downloads.haskell.org/~ghcup/0.1.17/x86_64-apple-darwin-ghcup-0.1.17
dlHash: a334620ccce7705211b2142882dde544003e6030af4b91a44c890542a90f879f dlHash: a3d4ed12f8631c0537d8d9531cc5518bc6f90edcee3326e5d4e0efb72c8dfc6f
FreeBSD: FreeBSD:
unknown_versioning: unknown_versioning:
dlUri: https://downloads.haskell.org/~ghcup/0.1.16.2/x86_64-portbld-freebsd-ghcup-0.1.16.2 dlUri: https://downloads.haskell.org/~ghcup/0.1.17/x86_64-portbld-freebsd-ghcup-0.1.17
dlHash: 92359592a5694375e53b22628920086bf4bbf0faff5be018a0ed3e745a6426a9 dlHash: 83012de837773f3aa26182c607c2da85ee6ff3b0092becb78907700f407a27fb
Windows: Windows:
unknown_versioning: unknown_versioning:
dlUri: https://downloads.haskell.org/~ghcup/0.1.16.2/x86_64-mingw64-ghcup-0.1.16.2.exe dlUri: https://downloads.haskell.org/~ghcup/0.1.17/x86_64-mingw64-ghcup-0.1.17.exe
dlHash: ec78872a84213968c490675127b9aad2285980b747c68207801ae824b98c7948 dlHash: 40bda6050c800fa69af51d2e668426ca73b4179214bfeef329b795484991d258
Linux_Alpine: Linux_Alpine:
unknown_versioning: *ghcup-64 unknown_versioning: *ghcup-64
A_32: A_32:
Linux_UnknownLinux: Linux_UnknownLinux:
unknown_versioning: &ghcup-32 unknown_versioning: &ghcup-32
dlUri: https://downloads.haskell.org/~ghcup/0.1.16.2/i386-linux-ghcup-0.1.16.2 dlUri: https://downloads.haskell.org/~ghcup/0.1.17/i386-linux-ghcup-0.1.17
dlHash: 01968ca6decac7b6e8ba6e2c817870d3fa47289a6507e0c1ab563f7b6eec0e38 dlHash: d0f887b13a2c7a11477dc54cb90b446ef0ebe1d2a6bfbf60ccd4b37fc5de70cc
Linux_Alpine: Linux_Alpine:
unknown_versioning: *ghcup-32 unknown_versioning: *ghcup-32
A_ARM64: A_ARM64:
Linux_UnknownLinux: Linux_UnknownLinux:
unknown_versioning: unknown_versioning:
dlUri: https://downloads.haskell.org/~ghcup/0.1.16.2/aarch64-linux-ghcup-0.1.16.2 dlUri: https://downloads.haskell.org/~ghcup/0.1.17/aarch64-linux-ghcup-0.1.17
dlHash: 0bdbfc724e0ddabb266156eea83c2c4e19c6ed79dd06db0c29b7d69df8d9fa8c dlHash: be67cf8800ae305c5ba210b645f4fce8751763f3eac3db399f6efca145b7ab38
Darwin: Darwin:
unknown_versioning: unknown_versioning:
dlUri: https://downloads.haskell.org/~ghcup/0.1.16.2/aarch64-apple-darwin-ghcup-0.1.16.2 dlUri: https://downloads.haskell.org/~ghcup/0.1.17/aarch64-apple-darwin-ghcup-0.1.17
dlHash: 8854e991a2ba1350abda59dab96ce50ae7729d1ce99399d67929ef31e90f1da5 dlHash: b1be8c55838bd0d972e42b02b71bdf47fbbf67be1456e0de2d7d346620538539
A_ARM: A_ARM:
Linux_UnknownLinux: Linux_UnknownLinux:
unknown_versioning: unknown_versioning:
dlUri: https://downloads.haskell.org/~ghcup/0.1.16.2/armv7-linux-ghcup-0.1.16.2 dlUri: https://downloads.haskell.org/~ghcup/0.1.17/armv7-linux-ghcup-0.1.17
dlHash: 983ebb5b584bfa600704216a63f94b40d36a02573834e90ef1042c8472d9ad57 dlHash: fe54ded2fafff4f8d82e511229f257f4c3b87b14c796f9b5b0ea35c359c26cb0
HLS: HLS:
1.1.0: 1.1.0:
viTags: viTags:

View File

@@ -34,6 +34,7 @@ import GHCup.Types.JSON ( )
import GHCup.Types.Optics import GHCup.Types.Optics
import GHCup.Utils import GHCup.Utils
import GHCup.Utils.File import GHCup.Utils.File
import GHCup.Utils.Logger
import GHCup.Utils.Prelude import GHCup.Utils.Prelude
import GHCup.Utils.String.QQ import GHCup.Utils.String.QQ
import GHCup.Utils.Version.QQ import GHCup.Utils.Version.QQ

View File

@@ -35,6 +35,7 @@ import GHCup.Types.Optics
import GHCup.Types.JSON ( ) import GHCup.Types.JSON ( )
import GHCup.Utils.Dirs import GHCup.Utils.Dirs
import GHCup.Utils.File import GHCup.Utils.File
import GHCup.Utils.Logger
import GHCup.Utils.Prelude import GHCup.Utils.Prelude
import GHCup.Version import GHCup.Version

View File

@@ -23,6 +23,7 @@ import GHCup.Types
import GHCup.Types.Optics import GHCup.Types.Optics
import GHCup.Types.JSON ( ) import GHCup.Types.JSON ( )
import GHCup.Utils.File import GHCup.Utils.File
import GHCup.Utils.Logger
import GHCup.Utils.Prelude import GHCup.Utils.Prelude
import GHCup.Utils.String.QQ import GHCup.Utils.String.QQ

View File

@@ -577,10 +577,11 @@ data LogLevel = Warn
data LoggerConfig = LoggerConfig data LoggerConfig = LoggerConfig
{ lcPrintDebug :: Bool -- ^ whether to print debug in colorOutter { lcPrintDebug :: Bool -- ^ whether to print debug in colorOutter
, colorOutter :: T.Text -> IO () -- ^ how to write the color output , consoleOutter :: T.Text -> IO () -- ^ how to write the console output
, rawOutter :: T.Text -> IO () -- ^ how to write the full raw output , fileOutter :: T.Text -> IO () -- ^ how to write the file output
, fancyColors :: Bool
} }
deriving Show deriving Show
instance NFData LoggerConfig where instance NFData LoggerConfig where
rnf (LoggerConfig !lcPrintDebug !_ !_) = rnf lcPrintDebug rnf (LoggerConfig !lcPrintDebug !_ !_ !fancyColors) = rnf (lcPrintDebug, fancyColors)

View File

@@ -24,6 +24,8 @@ module GHCup.Types.JSON where
import GHCup.Types import GHCup.Types
import GHCup.Utils.MegaParsec import GHCup.Utils.MegaParsec
import GHCup.Utils.Prelude import GHCup.Utils.Prelude
import GHCup.Utils.Logger () -- TH is broken shite and needs GHCup.Utils.Logger for linking, although we don't depend on the file.
-- This is due to the boot file.
import Control.Applicative ( (<|>) ) import Control.Applicative ( (<|>) )
import Data.Aeson import Data.Aeson

View File

@@ -23,12 +23,9 @@ import GHCup.Types
import Control.Monad.Reader import Control.Monad.Reader
import Data.ByteString ( ByteString ) import Data.ByteString ( ByteString )
import Data.Text ( Text )
import Optics import Optics
import URI.ByteString import URI.ByteString
import System.Console.Pretty
import qualified Data.Text as T
makePrisms ''Tool makePrisms ''Tool
makePrisms ''Architecture makePrisms ''Architecture
@@ -117,80 +114,6 @@ getDirs :: ( MonadReader env m
getDirs = gets @"dirs" getDirs = gets @"dirs"
logInfo :: ( MonadReader env m
, LabelOptic' "loggerConfig" A_Lens env LoggerConfig
, MonadIO m
)
=> Text
-> m ()
logInfo = logInternal Info
logWarn :: ( MonadReader env m
, LabelOptic' "loggerConfig" A_Lens env LoggerConfig
, MonadIO m
)
=> Text
-> m ()
logWarn = logInternal Warn
logDebug :: ( MonadReader env m
, LabelOptic' "loggerConfig" A_Lens env LoggerConfig
, MonadIO m
)
=> Text
-> m ()
logDebug = logInternal Debug
logError :: ( MonadReader env m
, LabelOptic' "loggerConfig" A_Lens env LoggerConfig
, MonadIO m
)
=> Text
-> m ()
logError = logInternal Error
logInternal :: ( MonadReader env m
, LabelOptic' "loggerConfig" A_Lens env LoggerConfig
, MonadIO m
) => LogLevel
-> Text
-> m ()
logInternal logLevel msg = do
LoggerConfig {..} <- gets @"loggerConfig"
let style' = case logLevel of
Debug -> style Bold . color Blue
Info -> style Bold . color Green
Warn -> style Bold . color Yellow
Error -> style Bold . color Red
let l = case logLevel of
Debug -> style' "[ Debug ]"
Info -> style' "[ Info ]"
Warn -> style' "[ Warn ]"
Error -> style' "[ Error ]"
let strs = T.split (== '\n') msg
let out = case strs of
[] -> T.empty
(x:xs) ->
foldr (\a b -> a <> "\n" <> b) mempty
. ((l <> " " <> x) :)
. fmap (\line' -> style' "[ ... ] " <> line' )
$ xs
when (lcPrintDebug || (not lcPrintDebug && (logLevel /= Debug)))
$ liftIO $ colorOutter out
-- raw output
let lr = case logLevel of
Debug -> "Debug:"
Info -> "Info:"
Warn -> "Warn:"
Error -> "Error:"
let outr = lr <> " " <> msg <> "\n"
liftIO $ rawOutter outr
getLogCleanup :: ( MonadReader env m getLogCleanup :: ( MonadReader env m
, LabelOptic' "logCleanup" A_Lens env (IO ()) , LabelOptic' "logCleanup" A_Lens env (IO ())
) )

View File

@@ -35,6 +35,7 @@ import GHCup.Types.Optics
import GHCup.Types.JSON ( ) import GHCup.Types.JSON ( )
import GHCup.Utils.Dirs import GHCup.Utils.Dirs
import GHCup.Utils.File import GHCup.Utils.File
import GHCup.Utils.Logger
import GHCup.Utils.MegaParsec import GHCup.Utils.MegaParsec
import GHCup.Utils.Prelude import GHCup.Utils.Prelude
import GHCup.Utils.String.QQ import GHCup.Utils.String.QQ

View File

@@ -38,6 +38,7 @@ import GHCup.Types
import GHCup.Types.JSON ( ) import GHCup.Types.JSON ( )
import GHCup.Types.Optics import GHCup.Types.Optics
import GHCup.Utils.MegaParsec import GHCup.Utils.MegaParsec
import GHCup.Utils.Logger
import GHCup.Utils.Prelude import GHCup.Utils.Prelude
import Control.Exception.Safe import Control.Exception.Safe

View File

@@ -0,0 +1,5 @@
module GHCup.Utils.File.Common where
import Text.Regex.Posix
findFiles :: FilePath -> Regex -> IO [FilePath]

View File

@@ -17,6 +17,7 @@ module GHCup.Utils.File.Posix where
import GHCup.Utils.File.Common import GHCup.Utils.File.Common
import GHCup.Utils.Prelude import GHCup.Utils.Prelude
import GHCup.Utils.Logger
import GHCup.Types import GHCup.Types
import GHCup.Types.Optics import GHCup.Types.Optics

View File

@@ -1,5 +1,7 @@
{-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE QuasiQuotes #-} {-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE OverloadedStrings #-}
{-| {-|
Module : GHCup.Utils.Logger Module : GHCup.Utils.Logger
@@ -16,21 +18,97 @@ module GHCup.Utils.Logger where
import GHCup.Types import GHCup.Types
import GHCup.Types.Optics import GHCup.Types.Optics
import GHCup.Utils.File import {-# SOURCE #-} GHCup.Utils.File.Common
import GHCup.Utils.String.QQ import GHCup.Utils.String.QQ
import Control.Exception.Safe import Control.Exception.Safe
import Control.Monad import Control.Monad
import Control.Monad.IO.Class import Control.Monad.IO.Class
import Control.Monad.Reader import Control.Monad.Reader
import Data.Text ( Text )
import Optics
import Prelude hiding ( appendFile ) import Prelude hiding ( appendFile )
import System.Console.Pretty
import System.FilePath import System.FilePath
import System.IO.Error import System.IO.Error
import Text.Regex.Posix import Text.Regex.Posix
import qualified Data.ByteString as B import qualified Data.ByteString as B
import GHCup.Utils.Prelude import GHCup.Utils.Prelude
import qualified Data.Text as T
logInfo :: ( MonadReader env m
, LabelOptic' "loggerConfig" A_Lens env LoggerConfig
, MonadIO m
)
=> Text
-> m ()
logInfo = logInternal Info
logWarn :: ( MonadReader env m
, LabelOptic' "loggerConfig" A_Lens env LoggerConfig
, MonadIO m
)
=> Text
-> m ()
logWarn = logInternal Warn
logDebug :: ( MonadReader env m
, LabelOptic' "loggerConfig" A_Lens env LoggerConfig
, MonadIO m
)
=> Text
-> m ()
logDebug = logInternal Debug
logError :: ( MonadReader env m
, LabelOptic' "loggerConfig" A_Lens env LoggerConfig
, MonadIO m
)
=> Text
-> m ()
logError = logInternal Error
logInternal :: ( MonadReader env m
, LabelOptic' "loggerConfig" A_Lens env LoggerConfig
, MonadIO m
) => LogLevel
-> Text
-> m ()
logInternal logLevel msg = do
LoggerConfig {..} <- gets @"loggerConfig"
let color' c = if fancyColors then color c else id
let style' = case logLevel of
Debug -> style Bold . color' Blue
Info -> style Bold . color' Green
Warn -> style Bold . color' Yellow
Error -> style Bold . color' Red
let l = case logLevel of
Debug -> style' "[ Debug ]"
Info -> style' "[ Info ]"
Warn -> style' "[ Warn ]"
Error -> style' "[ Error ]"
let strs = T.split (== '\n') msg
let out = case strs of
[] -> T.empty
(x:xs) ->
foldr (\a b -> a <> "\n" <> b) mempty
. ((l <> " " <> x) :)
. fmap (\line' -> style' "[ ... ] " <> line' )
$ xs
when (lcPrintDebug || (not lcPrintDebug && (logLevel /= Debug)))
$ liftIO $ consoleOutter out
-- raw output
let lr = case logLevel of
Debug -> "Debug:"
Info -> "Info:"
Warn -> "Warn:"
Error -> "Error:"
let outr = lr <> " " <> msg <> "\n"
liftIO $ fileOutter outr
initGHCupFileLogging :: ( MonadReader env m initGHCupFileLogging :: ( MonadReader env m

View File

@@ -0,0 +1,21 @@
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE OverloadedStrings #-}
module GHCup.Utils.Logger where
import GHCup.Types
import Control.Monad.IO.Class
import Control.Monad.Reader
import Data.Text ( Text )
import Optics
logWarn :: ( MonadReader env m
, LabelOptic' "loggerConfig" A_Lens env LoggerConfig
, MonadIO m
)
=> Text
-> m ()

View File

@@ -23,6 +23,7 @@ module GHCup.Utils.Prelude where
import GHCup.Types import GHCup.Types
#endif #endif
import GHCup.Types.Optics import GHCup.Types.Optics
import {-# SOURCE #-} GHCup.Utils.Logger
import Control.Applicative import Control.Applicative
import Control.Exception.Safe import Control.Exception.Safe

View File

@@ -21,7 +21,7 @@
plat="$(uname -s)" plat="$(uname -s)"
arch=$(uname -m) arch=$(uname -m)
ghver="0.1.16.2" ghver="0.1.17"
base_url="https://downloads.haskell.org/~ghcup" base_url="https://downloads.haskell.org/~ghcup"
export GHCUP_SKIP_UPDATE_CHECK=yes export GHCUP_SKIP_UPDATE_CHECK=yes
@@ -52,11 +52,18 @@ esac
die() { die() {
if [ -n "${NO_COLOR}" ] ; then
(>&2 printf "%s\\n" "$1")
else
(>&2 printf "\\033[0;31m%s\\033[0m\\n" "$1") (>&2 printf "\\033[0;31m%s\\033[0m\\n" "$1")
fi
exit 2 exit 2
} }
warn() { warn() {
if [ -n "${NO_COLOR}" ] ; then
printf "%s\\n" "$1"
else
case "${plat}" in case "${plat}" in
MSYS*|MINGW*) MSYS*|MINGW*)
echo -e "\\033[0;35m$1\\033[0m" echo -e "\\033[0;35m$1\\033[0m"
@@ -65,9 +72,13 @@ warn() {
printf "\\033[0;35m%s\\033[0m\\n" "$1" printf "\\033[0;35m%s\\033[0m\\n" "$1"
;; ;;
esac esac
fi
} }
yellow() { yellow() {
if [ -n "${NO_COLOR}" ] ; then
printf "%s\\n" "$1"
else
case "${plat}" in case "${plat}" in
MSYS*|MINGW*) MSYS*|MINGW*)
echo -e "\\033[0;33m$1\\033[0m" echo -e "\\033[0;33m$1\\033[0m"
@@ -76,9 +87,13 @@ yellow() {
printf "\\033[0;33m%s\\033[0m\\n" "$1" printf "\\033[0;33m%s\\033[0m\\n" "$1"
;; ;;
esac esac
fi
} }
green() { green() {
if [ -n "${NO_COLOR}" ] ; then
printf "%s\\n" "$1"
else
case "${plat}" in case "${plat}" in
MSYS*|MINGW*) MSYS*|MINGW*)
echo -e "\\033[0;32m$1\\033[0m" echo -e "\\033[0;32m$1\\033[0m"
@@ -87,6 +102,7 @@ green() {
printf "\\033[0;32m%s\\033[0m\\n" "$1" printf "\\033[0;32m%s\\033[0m\\n" "$1"
;; ;;
esac esac
fi
} }
edo() { edo() {