{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE FlexibleContexts  #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE OverloadedStrings #-}

module RIO.PrettyPrint
  (
    -- * Type classes for optionally colored terminal output

    HasTerm (..)
  , HasStylesUpdate (..)
    -- * Pretty printing functions

  , displayPlain
  , displayWithColor
    -- * Logging based on pretty-print typeclass

    -- | The @pretty...@ functions come in three varieties:

    --

    -- * The normal variety, with a single styled document;

    -- * The @L@ variety. The listed styled documents are concatenated with

    --   'fillSep'; and

    -- * The @S@ variety. 'flow' is applied to the 'String'.

    --

    -- Pretty message at log level 'LevelDebug'.

  , prettyDebug
  , prettyDebugL
  , prettyDebugS
    -- | Pretty message at log level 'LevelInfo'.

  , prettyInfo
  , prettyInfoL
  , prettyInfoS
    -- | Pretty messages at log level 'LevelInfo', starting on a new line with

    -- label @Note:@, with the message indented after the label.

  , prettyNote
  , prettyNoteL
  , prettyNoteS
    -- | Pretty messages at log level 'LevelWarn', starting on a new line with

    -- label @Warning:@, with or without the message indented after the label.

  , prettyWarn
  , prettyWarnL
  , prettyWarnS
  , prettyWarnNoIndent
  , prettyWarnNoIndentL
  , prettyWarnNoIndentS
    -- | Pretty messages at log level 'LevelError', starting on a new line with

    -- label @Error:@, with or without the message indented after the label.

  , prettyError
  , prettyErrorL
  , prettyErrorS
  , prettyErrorNoIndent
  , prettyErrorNoIndentL
  , prettyErrorNoIndentS
    -- | Pretty messages at the specified log level.

  , prettyGeneric
  , prettyWith

    -- * Semantic styling functions

    -- | These are used rather than applying colors or other styling directly,

    -- to provide consistency.

  , style
  , displayMilliseconds
  , logLevelToStyle
    -- * Formatting utils

  , blankLine
  , bulletedList
  , spacedBulletedList
  , mkBulletedList
  , mkNarrativeList
  , debugBracket
    -- * Re-exports from "Text.PrettyPrint.Leijen.Extended"

  , Pretty (..)
  , StyleDoc (..)
  , StyleAnn (..)
  , nest
  , line
  , linebreak
  , group
  , softline
  , softbreak
  , align
  , hang
  , indent
  , encloseSep
  , (<+>)
  , hsep
  , vsep
  , fillSep
  , sep
  , hcat
  , vcat
  , fillCat
  , cat
  , punctuate
  , fill
  , fillBreak
  , enclose
  , squotes
  , dquotes
  , parens
  , angles
  , braces
  , brackets
  , string
  , indentAfterLabel
  , wordDocs
  , flow
    -- * Re-exports from "RIO.PrettyPrint.Types.PrettyPrint"

  , Style (..)
  ) where

import           Data.List ( intersperse )
import           RIO
import           RIO.PrettyPrint.StylesUpdate ( HasStylesUpdate (..) )
import           RIO.PrettyPrint.Types ( Style (..) )
import           Text.PrettyPrint.Leijen.Extended
                   ( Pretty (pretty), StyleAnn (..), StyleDoc, (<+>), align
                   , angles, braces, brackets, cat, displayAnsi, displayPlain
                   , dquotes, enclose, encloseSep, fill, fillBreak, fillCat
                   , fillSep, group, hang, hcat, hsep, indent, line, linebreak
                   , nest, parens, punctuate, sep, softbreak, softline, squotes
                   , string, styleAnn, vcat, vsep
                   )

class (HasLogFunc env, HasStylesUpdate env) => HasTerm env where
  useColorL :: Lens' env Bool
  termWidthL :: Lens' env Int

displayWithColor ::
     (HasTerm env, Pretty a, MonadReader env m, HasCallStack)
  => a
  -> m Utf8Builder
displayWithColor :: forall env a (m :: * -> *).
(HasTerm env, Pretty a, MonadReader env m, HasCallStack) =>
a -> m Utf8Builder
displayWithColor a
x = do
  Bool
useAnsi <- forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view forall env. HasTerm env => Lens' env Bool
useColorL
  Int
termWidth <- forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view forall env. HasTerm env => Lens' env Int
termWidthL
  (if Bool
useAnsi then forall a env (m :: * -> *).
(Pretty a, HasLogFunc env, HasStylesUpdate env, MonadReader env m,
 HasCallStack) =>
Int -> a -> m Utf8Builder
displayAnsi else forall a env (m :: * -> *).
(Pretty a, HasLogFunc env, HasStylesUpdate env, MonadReader env m,
 HasCallStack) =>
Int -> a -> m Utf8Builder
displayPlain) Int
termWidth a
x

-- TODO: switch to using implicit callstacks once 7.8 support is dropped


prettyGeneric ::
     (HasTerm env, HasCallStack, Pretty b, MonadReader env m, MonadIO m)
  => LogLevel
  -> b
  -> m ()
prettyGeneric :: forall env b (m :: * -> *).
(HasTerm env, HasCallStack, Pretty b, MonadReader env m,
 MonadIO m) =>
LogLevel -> b -> m ()
prettyGeneric LogLevel
level = forall env b (m :: * -> *) a.
(HasTerm env, HasCallStack, Pretty b, MonadReader env m,
 MonadIO m) =>
LogLevel -> (a -> b) -> a -> m ()
prettyWith LogLevel
level forall a. a -> a
id

prettyWith ::
     (HasTerm env, HasCallStack, Pretty b, MonadReader env m, MonadIO m)
  => LogLevel
  -> (a -> b)
  -> a
  -> m ()
prettyWith :: forall env b (m :: * -> *) a.
(HasTerm env, HasCallStack, Pretty b, MonadReader env m,
 MonadIO m) =>
LogLevel -> (a -> b) -> a -> m ()
prettyWith LogLevel
level a -> b
f = forall (m :: * -> *) env.
(MonadIO m, MonadReader env m, HasLogFunc env, HasCallStack) =>
LogSource -> LogLevel -> Utf8Builder -> m ()
logGeneric LogSource
"" LogLevel
level forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Display a => a -> Utf8Builder
RIO.display forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< forall env a (m :: * -> *).
(HasTerm env, Pretty a, MonadReader env m, HasCallStack) =>
a -> m Utf8Builder
displayWithColor forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> b
f

-- Note: I think keeping this section aligned helps spot errors, might be

-- worth keeping the alignment in place.


prettyDebugWith, prettyInfoWith, prettyNoteWith, prettyWarnWith, prettyErrorWith, prettyWarnNoIndentWith, prettyErrorNoIndentWith
  :: (HasCallStack, HasTerm env, MonadReader env m, MonadIO m)
  => (a -> StyleDoc) -> a -> m ()
prettyDebugWith :: forall env (m :: * -> *) a.
(HasCallStack, HasTerm env, MonadReader env m, MonadIO m) =>
(a -> StyleDoc) -> a -> m ()
prettyDebugWith = forall env b (m :: * -> *) a.
(HasTerm env, HasCallStack, Pretty b, MonadReader env m,
 MonadIO m) =>
LogLevel -> (a -> b) -> a -> m ()
prettyWith LogLevel
LevelDebug
prettyInfoWith :: forall env (m :: * -> *) a.
(HasCallStack, HasTerm env, MonadReader env m, MonadIO m) =>
(a -> StyleDoc) -> a -> m ()
prettyInfoWith  = forall env b (m :: * -> *) a.
(HasTerm env, HasCallStack, Pretty b, MonadReader env m,
 MonadIO m) =>
LogLevel -> (a -> b) -> a -> m ()
prettyWith LogLevel
LevelInfo
prettyNoteWith :: forall env (m :: * -> *) a.
(HasCallStack, HasTerm env, MonadReader env m, MonadIO m) =>
(a -> StyleDoc) -> a -> m ()
prettyNoteWith a -> StyleDoc
f  = forall env b (m :: * -> *) a.
(HasTerm env, HasCallStack, Pretty b, MonadReader env m,
 MonadIO m) =>
LogLevel -> (a -> b) -> a -> m ()
prettyWith LogLevel
LevelInfo
                          ((StyleDoc
line forall a. Semigroup a => a -> a -> a
<>) forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Style -> StyleDoc -> StyleDoc
style Style
Good StyleDoc
"Note:" StyleDoc -> StyleDoc -> StyleDoc
<+>) forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                           StyleDoc -> StyleDoc
indentAfterLabel forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> StyleDoc
f)
prettyWarnWith :: forall env (m :: * -> *) a.
(HasCallStack, HasTerm env, MonadReader env m, MonadIO m) =>
(a -> StyleDoc) -> a -> m ()
prettyWarnWith a -> StyleDoc
f  = forall env b (m :: * -> *) a.
(HasTerm env, HasCallStack, Pretty b, MonadReader env m,
 MonadIO m) =>
LogLevel -> (a -> b) -> a -> m ()
prettyWith LogLevel
LevelWarn
                          ((StyleDoc
line forall a. Semigroup a => a -> a -> a
<>) forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Style -> StyleDoc -> StyleDoc
style Style
Warning StyleDoc
"Warning:" StyleDoc -> StyleDoc -> StyleDoc
<+>) forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                           StyleDoc -> StyleDoc
indentAfterLabel forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> StyleDoc
f)
prettyErrorWith :: forall env (m :: * -> *) a.
(HasCallStack, HasTerm env, MonadReader env m, MonadIO m) =>
(a -> StyleDoc) -> a -> m ()
prettyErrorWith a -> StyleDoc
f = forall env b (m :: * -> *) a.
(HasTerm env, HasCallStack, Pretty b, MonadReader env m,
 MonadIO m) =>
LogLevel -> (a -> b) -> a -> m ()
prettyWith LogLevel
LevelError
                          ((StyleDoc
line forall a. Semigroup a => a -> a -> a
<>) forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Style -> StyleDoc -> StyleDoc
style Style
Error   StyleDoc
"Error:" StyleDoc -> StyleDoc -> StyleDoc
<+>) forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                           StyleDoc -> StyleDoc
indentAfterLabel forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> StyleDoc
f)
prettyWarnNoIndentWith :: forall env (m :: * -> *) a.
(HasCallStack, HasTerm env, MonadReader env m, MonadIO m) =>
(a -> StyleDoc) -> a -> m ()
prettyWarnNoIndentWith a -> StyleDoc
f  = forall env b (m :: * -> *) a.
(HasTerm env, HasCallStack, Pretty b, MonadReader env m,
 MonadIO m) =>
LogLevel -> (a -> b) -> a -> m ()
prettyWith LogLevel
LevelWarn
                                  ((StyleDoc
line forall a. Semigroup a => a -> a -> a
<>) forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Style -> StyleDoc -> StyleDoc
style Style
Warning StyleDoc
"Warning:" StyleDoc -> StyleDoc -> StyleDoc
<+>) forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> StyleDoc
f)
prettyErrorNoIndentWith :: forall env (m :: * -> *) a.
(HasCallStack, HasTerm env, MonadReader env m, MonadIO m) =>
(a -> StyleDoc) -> a -> m ()
prettyErrorNoIndentWith a -> StyleDoc
f = forall env b (m :: * -> *) a.
(HasTerm env, HasCallStack, Pretty b, MonadReader env m,
 MonadIO m) =>
LogLevel -> (a -> b) -> a -> m ()
prettyWith LogLevel
LevelError
                                  ((StyleDoc
line forall a. Semigroup a => a -> a -> a
<>) forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Style -> StyleDoc -> StyleDoc
style Style
Error   StyleDoc
"Error:" StyleDoc -> StyleDoc -> StyleDoc
<+>) forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> StyleDoc
f)

prettyDebug, prettyInfo, prettyNote, prettyWarn, prettyError, prettyWarnNoIndent, prettyErrorNoIndent
  :: (HasCallStack, HasTerm env, MonadReader env m, MonadIO m)
  => StyleDoc -> m ()
prettyDebug :: forall env (m :: * -> *).
(HasCallStack, HasTerm env, MonadReader env m, MonadIO m) =>
StyleDoc -> m ()
prettyDebug         = forall env (m :: * -> *) a.
(HasCallStack, HasTerm env, MonadReader env m, MonadIO m) =>
(a -> StyleDoc) -> a -> m ()
prettyDebugWith         forall a. a -> a
id
prettyInfo :: forall env (m :: * -> *).
(HasCallStack, HasTerm env, MonadReader env m, MonadIO m) =>
StyleDoc -> m ()
prettyInfo          = forall env (m :: * -> *) a.
(HasCallStack, HasTerm env, MonadReader env m, MonadIO m) =>
(a -> StyleDoc) -> a -> m ()
prettyInfoWith          forall a. a -> a
id
prettyNote :: forall env (m :: * -> *).
(HasCallStack, HasTerm env, MonadReader env m, MonadIO m) =>
StyleDoc -> m ()
prettyNote          = forall env (m :: * -> *) a.
(HasCallStack, HasTerm env, MonadReader env m, MonadIO m) =>
(a -> StyleDoc) -> a -> m ()
prettyNoteWith          forall a. a -> a
id
prettyWarn :: forall env (m :: * -> *).
(HasCallStack, HasTerm env, MonadReader env m, MonadIO m) =>
StyleDoc -> m ()
prettyWarn          = forall env (m :: * -> *) a.
(HasCallStack, HasTerm env, MonadReader env m, MonadIO m) =>
(a -> StyleDoc) -> a -> m ()
prettyWarnWith          forall a. a -> a
id
prettyError :: forall env (m :: * -> *).
(HasCallStack, HasTerm env, MonadReader env m, MonadIO m) =>
StyleDoc -> m ()
prettyError         = forall env (m :: * -> *) a.
(HasCallStack, HasTerm env, MonadReader env m, MonadIO m) =>
(a -> StyleDoc) -> a -> m ()
prettyErrorWith         forall a. a -> a
id
prettyWarnNoIndent :: forall env (m :: * -> *).
(HasCallStack, HasTerm env, MonadReader env m, MonadIO m) =>
StyleDoc -> m ()
prettyWarnNoIndent  = forall env (m :: * -> *) a.
(HasCallStack, HasTerm env, MonadReader env m, MonadIO m) =>
(a -> StyleDoc) -> a -> m ()
prettyWarnNoIndentWith  forall a. a -> a
id
prettyErrorNoIndent :: forall env (m :: * -> *).
(HasCallStack, HasTerm env, MonadReader env m, MonadIO m) =>
StyleDoc -> m ()
prettyErrorNoIndent = forall env (m :: * -> *) a.
(HasCallStack, HasTerm env, MonadReader env m, MonadIO m) =>
(a -> StyleDoc) -> a -> m ()
prettyErrorNoIndentWith forall a. a -> a
id

prettyDebugL, prettyInfoL, prettyNoteL, prettyWarnL, prettyErrorL, prettyWarnNoIndentL, prettyErrorNoIndentL
  :: (HasCallStack, HasTerm env, MonadReader env m, MonadIO m)
  => [StyleDoc] -> m ()
prettyDebugL :: forall env (m :: * -> *).
(HasCallStack, HasTerm env, MonadReader env m, MonadIO m) =>
[StyleDoc] -> m ()
prettyDebugL         = forall env (m :: * -> *) a.
(HasCallStack, HasTerm env, MonadReader env m, MonadIO m) =>
(a -> StyleDoc) -> a -> m ()
prettyDebugWith         [StyleDoc] -> StyleDoc
fillSep
prettyInfoL :: forall env (m :: * -> *).
(HasCallStack, HasTerm env, MonadReader env m, MonadIO m) =>
[StyleDoc] -> m ()
prettyInfoL          = forall env (m :: * -> *) a.
(HasCallStack, HasTerm env, MonadReader env m, MonadIO m) =>
(a -> StyleDoc) -> a -> m ()
prettyInfoWith          [StyleDoc] -> StyleDoc
fillSep
prettyNoteL :: forall env (m :: * -> *).
(HasCallStack, HasTerm env, MonadReader env m, MonadIO m) =>
[StyleDoc] -> m ()
prettyNoteL          = forall env (m :: * -> *) a.
(HasCallStack, HasTerm env, MonadReader env m, MonadIO m) =>
(a -> StyleDoc) -> a -> m ()
prettyNoteWith          [StyleDoc] -> StyleDoc
fillSep
prettyWarnL :: forall env (m :: * -> *).
(HasCallStack, HasTerm env, MonadReader env m, MonadIO m) =>
[StyleDoc] -> m ()
prettyWarnL          = forall env (m :: * -> *) a.
(HasCallStack, HasTerm env, MonadReader env m, MonadIO m) =>
(a -> StyleDoc) -> a -> m ()
prettyWarnWith          [StyleDoc] -> StyleDoc
fillSep
prettyErrorL :: forall env (m :: * -> *).
(HasCallStack, HasTerm env, MonadReader env m, MonadIO m) =>
[StyleDoc] -> m ()
prettyErrorL         = forall env (m :: * -> *) a.
(HasCallStack, HasTerm env, MonadReader env m, MonadIO m) =>
(a -> StyleDoc) -> a -> m ()
prettyErrorWith         [StyleDoc] -> StyleDoc
fillSep
prettyWarnNoIndentL :: forall env (m :: * -> *).
(HasCallStack, HasTerm env, MonadReader env m, MonadIO m) =>
[StyleDoc] -> m ()
prettyWarnNoIndentL  = forall env (m :: * -> *) a.
(HasCallStack, HasTerm env, MonadReader env m, MonadIO m) =>
(a -> StyleDoc) -> a -> m ()
prettyWarnNoIndentWith  [StyleDoc] -> StyleDoc
fillSep
prettyErrorNoIndentL :: forall env (m :: * -> *).
(HasCallStack, HasTerm env, MonadReader env m, MonadIO m) =>
[StyleDoc] -> m ()
prettyErrorNoIndentL = forall env (m :: * -> *) a.
(HasCallStack, HasTerm env, MonadReader env m, MonadIO m) =>
(a -> StyleDoc) -> a -> m ()
prettyErrorNoIndentWith [StyleDoc] -> StyleDoc
fillSep

prettyDebugS, prettyInfoS, prettyNoteS, prettyWarnS, prettyErrorS, prettyWarnNoIndentS, prettyErrorNoIndentS
  :: (HasCallStack, HasTerm env, MonadReader env m, MonadIO m)
  => String -> m ()
prettyDebugS :: forall env (m :: * -> *).
(HasCallStack, HasTerm env, MonadReader env m, MonadIO m) =>
String -> m ()
prettyDebugS         = forall env (m :: * -> *) a.
(HasCallStack, HasTerm env, MonadReader env m, MonadIO m) =>
(a -> StyleDoc) -> a -> m ()
prettyDebugWith         String -> StyleDoc
flow
prettyInfoS :: forall env (m :: * -> *).
(HasCallStack, HasTerm env, MonadReader env m, MonadIO m) =>
String -> m ()
prettyInfoS          = forall env (m :: * -> *) a.
(HasCallStack, HasTerm env, MonadReader env m, MonadIO m) =>
(a -> StyleDoc) -> a -> m ()
prettyInfoWith          String -> StyleDoc
flow
prettyNoteS :: forall env (m :: * -> *).
(HasCallStack, HasTerm env, MonadReader env m, MonadIO m) =>
String -> m ()
prettyNoteS          = forall env (m :: * -> *) a.
(HasCallStack, HasTerm env, MonadReader env m, MonadIO m) =>
(a -> StyleDoc) -> a -> m ()
prettyNoteWith          String -> StyleDoc
flow
prettyWarnS :: forall env (m :: * -> *).
(HasCallStack, HasTerm env, MonadReader env m, MonadIO m) =>
String -> m ()
prettyWarnS          = forall env (m :: * -> *) a.
(HasCallStack, HasTerm env, MonadReader env m, MonadIO m) =>
(a -> StyleDoc) -> a -> m ()
prettyWarnWith          String -> StyleDoc
flow
prettyErrorS :: forall env (m :: * -> *).
(HasCallStack, HasTerm env, MonadReader env m, MonadIO m) =>
String -> m ()
prettyErrorS         = forall env (m :: * -> *) a.
(HasCallStack, HasTerm env, MonadReader env m, MonadIO m) =>
(a -> StyleDoc) -> a -> m ()
prettyErrorWith         String -> StyleDoc
flow
prettyWarnNoIndentS :: forall env (m :: * -> *).
(HasCallStack, HasTerm env, MonadReader env m, MonadIO m) =>
String -> m ()
prettyWarnNoIndentS  = forall env (m :: * -> *) a.
(HasCallStack, HasTerm env, MonadReader env m, MonadIO m) =>
(a -> StyleDoc) -> a -> m ()
prettyWarnNoIndentWith  String -> StyleDoc
flow
prettyErrorNoIndentS :: forall env (m :: * -> *).
(HasCallStack, HasTerm env, MonadReader env m, MonadIO m) =>
String -> m ()
prettyErrorNoIndentS = forall env (m :: * -> *) a.
(HasCallStack, HasTerm env, MonadReader env m, MonadIO m) =>
(a -> StyleDoc) -> a -> m ()
prettyErrorNoIndentWith String -> StyleDoc
flow

-- End of aligned section


-- | Use after a label and before the rest of what's being labelled for

--   consistent spacing/indenting/etc.

--

--   For example this is used after "Warning:" in warning messages.

indentAfterLabel :: StyleDoc -> StyleDoc
indentAfterLabel :: StyleDoc -> StyleDoc
indentAfterLabel = StyleDoc -> StyleDoc
align

-- | Make a 'StyleDoc' from each word in a 'String'

wordDocs :: String -> [StyleDoc]
wordDocs :: String -> [StyleDoc]
wordDocs = forall a b. (a -> b) -> [a] -> [b]
map forall a. IsString a => String -> a
fromString forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [String]
words

-- | Wordwrap a 'String'

flow :: String -> StyleDoc
flow :: String -> StyleDoc
flow = [StyleDoc] -> StyleDoc
fillSep forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [StyleDoc]
wordDocs

-- | A blank line.

blankLine :: StyleDoc
blankLine :: StyleDoc
blankLine = StyleDoc
line forall a. Semigroup a => a -> a -> a
<> StyleDoc
line

-- | @debug message action@ brackets any output of the specified @action@ with

-- an initial and final @message@ at log level 'LevelDebug'. The initial message

-- is prefixed with the label @Start:@. The final message is prefixed with

-- information about the duration of the action in milliseconds (ms) and, if

-- an exception is thrown by the action, the exception. For example:

--

-- > Start: <message>

-- > <output of action>

-- > Finished in ...ms: <message>

--

-- or:

--

-- > Start: <message>

-- > <output of action>

-- > Finished with exception in ...ms: <message>

-- > Exception thrown: <exception_message>

debugBracket :: (HasCallStack, HasTerm env, MonadReader env m,
                 MonadIO m, MonadUnliftIO m) => StyleDoc -> m a -> m a
debugBracket :: forall env (m :: * -> *) a.
(HasCallStack, HasTerm env, MonadReader env m, MonadIO m,
 MonadUnliftIO m) =>
StyleDoc -> m a -> m a
debugBracket StyleDoc
msg m a
f = do
  let output :: StyleDoc -> m ()
output = forall (m :: * -> *) env.
(MonadIO m, MonadReader env m, HasLogFunc env, HasCallStack) =>
Utf8Builder -> m ()
logDebug forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Display a => a -> Utf8Builder
RIO.display forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< forall env a (m :: * -> *).
(HasTerm env, Pretty a, MonadReader env m, HasCallStack) =>
a -> m Utf8Builder
displayWithColor
  StyleDoc -> m ()
output forall a b. (a -> b) -> a -> b
$ StyleDoc
"Start: " forall a. Semigroup a => a -> a -> a
<> StyleDoc
msg
  Double
start <- forall (m :: * -> *). MonadIO m => m Double
getMonotonicTime
  a
x <- m a
f forall (m :: * -> *) e a.
(MonadUnliftIO m, Exception e) =>
m a -> (e -> m a) -> m a
`catch` \SomeException
ex -> do
    Double
end <- forall (m :: * -> *). MonadIO m => m Double
getMonotonicTime
    let diff :: Double
diff = Double
end forall a. Num a => a -> a -> a
- Double
start
    StyleDoc -> m ()
output forall a b. (a -> b) -> a -> b
$
         StyleDoc
"Finished with exception in"
      StyleDoc -> StyleDoc -> StyleDoc
<+> Double -> StyleDoc
displayMilliseconds Double
diff forall a. Semigroup a => a -> a -> a
<> StyleDoc
":"
      StyleDoc -> StyleDoc -> StyleDoc
<+> StyleDoc
msg
      forall a. Semigroup a => a -> a -> a
<> StyleDoc
line
      forall a. Semigroup a => a -> a -> a
<> StyleDoc
"Exception thrown: "
      forall a. Semigroup a => a -> a -> a
<> forall a. IsString a => String -> a
fromString (forall a. Show a => a -> String
show SomeException
ex)
    forall (m :: * -> *) e a. (MonadIO m, Exception e) => e -> m a
throwIO (SomeException
ex :: SomeException)
  Double
end <- forall (m :: * -> *). MonadIO m => m Double
getMonotonicTime
  let diff :: Double
diff = Double
end forall a. Num a => a -> a -> a
- Double
start
  StyleDoc -> m ()
output forall a b. (a -> b) -> a -> b
$ StyleDoc
"Finished in" StyleDoc -> StyleDoc -> StyleDoc
<+> Double -> StyleDoc
displayMilliseconds Double
diff forall a. Semigroup a => a -> a -> a
<> StyleDoc
":" StyleDoc -> StyleDoc -> StyleDoc
<+> StyleDoc
msg
  forall (m :: * -> *) a. Monad m => a -> m a
return a
x

-- | Annotate a 'StyleDoc' with a 'Style'.

style :: Style -> StyleDoc -> StyleDoc
style :: Style -> StyleDoc -> StyleDoc
style = Style -> StyleDoc -> StyleDoc
styleAnn

-- | Display as milliseconds in style 'Good'.

displayMilliseconds ::
     Double
     -- ^ Amount of time in seconds.

  -> StyleDoc
displayMilliseconds :: Double -> StyleDoc
displayMilliseconds Double
t = Style -> StyleDoc -> StyleDoc
style Style
Good forall a b. (a -> b) -> a -> b
$
  forall a. IsString a => String -> a
fromString (forall a. Show a => a -> String
show (forall a b. (RealFrac a, Integral b) => a -> b
round (Double
t forall a. Num a => a -> a -> a
* Double
1000) :: Int)) forall a. Semigroup a => a -> a -> a
<> StyleDoc
"ms"

-- | Display a bulleted list of 'StyleDoc' with @*@ as the bullet point.

bulletedList :: [StyleDoc] -> StyleDoc
bulletedList :: [StyleDoc] -> StyleDoc
bulletedList = Bool -> Char -> [StyleDoc] -> StyleDoc
mkBulletedList Bool
False Char
'*'

-- | Display a bulleted list of 'StyleDoc', spaced with blank lines or not,

-- given a character for the bullet point.

--

-- @since 0.1.6.0

mkBulletedList ::
     Bool
     -- ^ Spaced with a blank line between each item?

  -> Char
     -- ^ The character to act as the bullet point.

  -> [StyleDoc]
  -> StyleDoc
mkBulletedList :: Bool -> Char -> [StyleDoc] -> StyleDoc
mkBulletedList Bool
isSpaced Char
bullet =
  forall a. Monoid a => [a] -> a
mconcat forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> [a] -> [a]
intersperse StyleDoc
spacer forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map ((forall a. IsString a => String -> a
fromString [Char
bullet] StyleDoc -> StyleDoc -> StyleDoc
<+>) forall b c a. (b -> c) -> (a -> b) -> a -> c
. StyleDoc -> StyleDoc
align)
 where
  spacer :: StyleDoc
spacer = if Bool
isSpaced then StyleDoc
line forall a. Semigroup a => a -> a -> a
<> StyleDoc
line else StyleDoc
line

-- | A helper function to yield a narrative list from a list of items, with a

-- final fullstop. For example, helps produce the output

-- @\"apple, ball and cat.\"@ (no serial comma) or @\"apple, ball, and cat.\"@

-- (serial comma) from @[\"apple\", \"ball\", \"cat\"]@.

--

-- @since 0.1.4.0

mkNarrativeList ::
     Pretty a
  => Maybe Style
  -- ^ Style the items in the list?

  -> Bool
  -- ^ Use a serial comma?

  -> [a]
  -> [StyleDoc]
mkNarrativeList :: forall a. Pretty a => Maybe Style -> Bool -> [a] -> [StyleDoc]
mkNarrativeList Maybe Style
_ Bool
_ [] = []
mkNarrativeList Maybe Style
mStyle Bool
_ [a
x] = [forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall a. a -> a
id Style -> StyleDoc -> StyleDoc
style Maybe Style
mStyle (forall a. Pretty a => a -> StyleDoc
pretty a
x) forall a. Semigroup a => a -> a -> a
<> StyleDoc
"."]
mkNarrativeList Maybe Style
mStyle Bool
useSerialComma [a
x1, a
x2] =
    StyleDoc -> StyleDoc
mStyle' (forall a. Pretty a => a -> StyleDoc
pretty a
x1) forall a. Semigroup a => a -> a -> a
<> (if Bool
useSerialComma then StyleDoc
"," else forall a. Monoid a => a
mempty)
  forall a. a -> [a] -> [a]
: StyleDoc
"and"
  forall a. a -> [a] -> [a]
: forall a. Pretty a => Maybe Style -> Bool -> [a] -> [StyleDoc]
mkNarrativeList Maybe Style
mStyle Bool
useSerialComma [a
x2]
 where
  mStyle' :: StyleDoc -> StyleDoc
mStyle' = forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall a. a -> a
id Style -> StyleDoc -> StyleDoc
style Maybe Style
mStyle
mkNarrativeList Maybe Style
mStyle Bool
useSerialComma (a
x:[a]
xs) =
    forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall a. a -> a
id Style -> StyleDoc -> StyleDoc
style Maybe Style
mStyle (forall a. Pretty a => a -> StyleDoc
pretty a
x) forall a. Semigroup a => a -> a -> a
<> StyleDoc
","
  forall a. a -> [a] -> [a]
: forall a. Pretty a => Maybe Style -> Bool -> [a] -> [StyleDoc]
mkNarrativeList Maybe Style
mStyle Bool
useSerialComma [a]
xs

-- | Display a bulleted list of 'StyleDoc' with a blank line between

-- each and @*@ as the bullet point.

spacedBulletedList :: [StyleDoc] -> StyleDoc
spacedBulletedList :: [StyleDoc] -> StyleDoc
spacedBulletedList = Bool -> Char -> [StyleDoc] -> StyleDoc
mkBulletedList Bool
True Char
'*'

-- | The 'Style' intended to be associated with a 'LogLevel'.

--

-- @since 0.1.1.0

logLevelToStyle :: LogLevel -> Style
logLevelToStyle :: LogLevel -> Style
logLevelToStyle LogLevel
level = case LogLevel
level of
  LogLevel
LevelDebug   -> Style
Debug
  LogLevel
LevelInfo    -> Style
Info
  LogLevel
LevelWarn    -> Style
Warning
  LogLevel
LevelError   -> Style
Error
  LevelOther LogSource
_ -> Style
OtherLevel