Compare commits
8 Commits
hls-compil
...
freebsd12
| Author | SHA1 | Date | |
|---|---|---|---|
|
2fb07201c7
|
|||
|
b5ca01dc4f
|
|||
|
d662682fb5
|
|||
|
ff2b06a5e8
|
|||
|
aece305003
|
|||
|
ef8da9bcec
|
|||
|
3cd55beab1
|
|||
|
6766501858
|
@@ -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"
|
||||||
|
|||||||
@@ -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
|
||||||
let loggerConfig = LoggerConfig { lcPrintDebug = True
|
no_color <- isJust <$> lookupEnv "NO_COLOR"
|
||||||
, colorOutter = T.hPutStr stderr
|
let loggerConfig = LoggerConfig { lcPrintDebug = True
|
||||||
, rawOutter = \_ -> pure ()
|
, consoleOutter = T.hPutStr stderr
|
||||||
|
, 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
|
||||||
|
|||||||
@@ -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
|
||||||
|
|||||||
@@ -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
|
||||||
|
|
||||||
@@ -537,9 +537,10 @@ settings' :: IORef AppState
|
|||||||
{-# NOINLINE settings' #-}
|
{-# NOINLINE settings' #-}
|
||||||
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
|
||||||
|
|||||||
@@ -1338,9 +1338,10 @@ tagCompleter :: Tool -> [String] -> Completer
|
|||||||
tagCompleter tool add = listIOCompleter $ do
|
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)
|
||||||
@@ -1364,9 +1365,10 @@ versionCompleter :: Maybe ListCriteria -> Tool -> Completer
|
|||||||
versionCompleter criteria tool = listIOCompleter $ do
|
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
|
||||||
|
|||||||
@@ -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:
|
||||||
|
|||||||
@@ -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
|
||||||
|
|||||||
@@ -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
|
||||||
|
|
||||||
|
|||||||
@@ -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
|
||||||
|
|
||||||
|
|||||||
@@ -576,11 +576,12 @@ data LogLevel = Warn
|
|||||||
deriving (Eq, Ord, Show)
|
deriving (Eq, Ord, Show)
|
||||||
|
|
||||||
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)
|
||||||
|
|||||||
@@ -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
|
||||||
|
|||||||
@@ -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 ())
|
||||||
)
|
)
|
||||||
|
|||||||
@@ -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
|
||||||
|
|||||||
@@ -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
|
||||||
|
|||||||
5
lib/GHCup/Utils/File/Common.hs-boot
Normal file
5
lib/GHCup/Utils/File/Common.hs-boot
Normal file
@@ -0,0 +1,5 @@
|
|||||||
|
module GHCup.Utils.File.Common where
|
||||||
|
|
||||||
|
import Text.Regex.Posix
|
||||||
|
|
||||||
|
findFiles :: FilePath -> Regex -> IO [FilePath]
|
||||||
@@ -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
|
||||||
|
|
||||||
|
|||||||
@@ -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
|
||||||
|
|||||||
21
lib/GHCup/Utils/Logger.hs-boot
Normal file
21
lib/GHCup/Utils/Logger.hs-boot
Normal 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 ()
|
||||||
|
|
||||||
@@ -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
|
||||||
|
|||||||
@@ -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,41 +52,57 @@ esac
|
|||||||
|
|
||||||
|
|
||||||
die() {
|
die() {
|
||||||
(>&2 printf "\\033[0;31m%s\\033[0m\\n" "$1")
|
if [ -n "${NO_COLOR}" ] ; then
|
||||||
|
(>&2 printf "%s\\n" "$1")
|
||||||
|
else
|
||||||
|
(>&2 printf "\\033[0;31m%s\\033[0m\\n" "$1")
|
||||||
|
fi
|
||||||
exit 2
|
exit 2
|
||||||
}
|
}
|
||||||
|
|
||||||
warn() {
|
warn() {
|
||||||
case "${plat}" in
|
if [ -n "${NO_COLOR}" ] ; then
|
||||||
MSYS*|MINGW*)
|
printf "%s\\n" "$1"
|
||||||
echo -e "\\033[0;35m$1\\033[0m"
|
else
|
||||||
;;
|
case "${plat}" in
|
||||||
*)
|
MSYS*|MINGW*)
|
||||||
printf "\\033[0;35m%s\\033[0m\\n" "$1"
|
echo -e "\\033[0;35m$1\\033[0m"
|
||||||
;;
|
;;
|
||||||
esac
|
*)
|
||||||
|
printf "\\033[0;35m%s\\033[0m\\n" "$1"
|
||||||
|
;;
|
||||||
|
esac
|
||||||
|
fi
|
||||||
}
|
}
|
||||||
|
|
||||||
yellow() {
|
yellow() {
|
||||||
case "${plat}" in
|
if [ -n "${NO_COLOR}" ] ; then
|
||||||
MSYS*|MINGW*)
|
printf "%s\\n" "$1"
|
||||||
echo -e "\\033[0;33m$1\\033[0m"
|
else
|
||||||
;;
|
case "${plat}" in
|
||||||
*)
|
MSYS*|MINGW*)
|
||||||
printf "\\033[0;33m%s\\033[0m\\n" "$1"
|
echo -e "\\033[0;33m$1\\033[0m"
|
||||||
;;
|
;;
|
||||||
esac
|
*)
|
||||||
|
printf "\\033[0;33m%s\\033[0m\\n" "$1"
|
||||||
|
;;
|
||||||
|
esac
|
||||||
|
fi
|
||||||
}
|
}
|
||||||
|
|
||||||
green() {
|
green() {
|
||||||
case "${plat}" in
|
if [ -n "${NO_COLOR}" ] ; then
|
||||||
MSYS*|MINGW*)
|
printf "%s\\n" "$1"
|
||||||
echo -e "\\033[0;32m$1\\033[0m"
|
else
|
||||||
;;
|
case "${plat}" in
|
||||||
*)
|
MSYS*|MINGW*)
|
||||||
printf "\\033[0;32m%s\\033[0m\\n" "$1"
|
echo -e "\\033[0;32m$1\\033[0m"
|
||||||
;;
|
;;
|
||||||
esac
|
*)
|
||||||
|
printf "\\033[0;32m%s\\033[0m\\n" "$1"
|
||||||
|
;;
|
||||||
|
esac
|
||||||
|
fi
|
||||||
}
|
}
|
||||||
|
|
||||||
edo() {
|
edo() {
|
||||||
|
|||||||
Reference in New Issue
Block a user