core-program 0.4.5.0 → 0.4.5.1
raw patch · 4 files changed
+37/−15 lines, 4 filesPVP: major bump suggested
API removals or changes: PVP suggests a major version bump
API changes (from Hackage documentation)
+ Core.Program: [$sel:terminalColouredFrom:Context] :: Context τ -> Bool
- Core.Program: Context :: MVar Rope -> Int -> Version -> Config -> [Exporter] -> Parameters -> MVar ExitCode -> MVar TimeStamp -> MVar Verbosity -> TQueue (Maybe Rope) -> TQueue (Maybe Datum) -> Maybe Forwarder -> MVar Datum -> MVar τ -> Context τ
+ Core.Program: Context :: MVar Rope -> Int -> Bool -> Version -> Config -> [Exporter] -> Parameters -> MVar ExitCode -> MVar TimeStamp -> MVar Verbosity -> TQueue (Maybe Rope) -> TQueue (Maybe Datum) -> Maybe Forwarder -> MVar Datum -> MVar τ -> Context τ
Files
- core-program.cabal +1/−1
- lib/Core/Program/Context.hs +10/−1
- lib/Core/Program/Execute.hs +2/−0
- lib/Core/Program/Logging.hs +24/−13
core-program.cabal view
@@ -5,7 +5,7 @@ -- see: https://github.com/sol/hpack name: core-program-version: 0.4.5.0+version: 0.4.5.1 synopsis: Opinionated Haskell Interoperability description: A library to help build command-line programs, both tools and longer-running daemons.
lib/Core/Program/Context.hs view
@@ -51,6 +51,7 @@ import Core.System.Base hiding (catch, throw) import Core.Text.Rope import Data.Foldable (foldrM)+import System.IO (hIsTerminalDevice) import Data.Int (Int64) import Data.String (IsString) import Prettyprinter (LayoutOptions (..), PageWidth (..), layoutPretty)@@ -164,6 +165,7 @@ { -- runtime properties programNameFrom :: MVar Rope , terminalWidthFrom :: Int+ , terminalColouredFrom :: Bool , versionFrom :: Version , -- only used during initial setup initialConfigFrom :: Config@@ -353,6 +355,7 @@ q <- newEmptyMVar i <- newMVar start columns <- getConsoleWidth+ coloured <- getConsoleColoured level <- newEmptyMVar out <- newTQueueIO tel <- newTQueueIO@@ -364,6 +367,7 @@ $! Context { programNameFrom = n , terminalWidthFrom = columns+ , terminalColouredFrom = coloured , versionFrom = version , initialConfigFrom = config , initialExportersFrom = []@@ -392,7 +396,12 @@ Nothing -> 80 return columns ---++getConsoleColoured :: IO Bool+getConsoleColoured = do+ terminal <- hIsTerminalDevice stdout+ pure terminal+ {- | Process the command line options and arguments. If an invalid option is
lib/Core/Program/Execute.hs view
@@ -447,6 +447,7 @@ formatLogMessage start now+ True SeverityInternal ("telemetry: sent " <> desc) atomically $ do@@ -460,6 +461,7 @@ formatLogMessage start now+ True SeverityWarn ("sending telemetry failed (Exception: " <> intoRope (show e) <> "); Restarting exporter.") atomically $ do
lib/Core/Program/Logging.hs view
@@ -179,6 +179,7 @@ let i = startTimeFrom context start <- readMVar i let output = outputChannelFrom context+ coloured = terminalColouredFrom context let display = case possiblelValue of Just value ->@@ -187,13 +188,13 @@ else text <> " = " <> value Nothing -> text - let !result = formatLogMessage start now level display+ let !result = formatLogMessage start now coloured level display atomically $ do writeTQueue output (Just result) -formatLogMessage :: TimeStamp -> TimeStamp -> Severity -> Rope -> Rope-formatLogMessage start now severity message =+formatLogMessage :: TimeStamp -> TimeStamp -> Bool -> Severity -> Rope -> Rope+formatLogMessage start now coloured severity message = let !start' = unTimeStamp start !now' = unTimeStamp now !stampZ =@@ -219,16 +220,26 @@ SeverityInternal -> intoEscapes dullBlue !reset = intoEscapes resetColour- in mconcat- [ intoEscapes dullWhite- , intoRope stampZ- , " ("- , padWithZeros 6 (show elapsed)- , ") "- , colour- , message- , reset- ]+ in case coloured of+ True ->+ mconcat+ [ intoEscapes dullWhite+ , intoRope stampZ+ , " ("+ , padWithZeros 6 (show elapsed)+ , ") "+ , colour+ , message+ , reset+ ]+ False ->+ mconcat+ [ intoRope stampZ+ , " ("+ , padWithZeros 6 (show elapsed)+ , ") "+ , message+ ] {- | Utility function to prepend \'0\' characters to a string representing a