{-# 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
    , prettyDebug, prettyInfo, prettyNote, prettyWarn, prettyError, prettyWarnNoIndent, prettyErrorNoIndent
    , prettyDebugL, prettyInfoL, prettyNoteL, prettyWarnL, prettyErrorL, prettyWarnNoIndentL, prettyErrorNoIndentL
    , prettyDebugS, prettyInfoS, prettyNoteS, prettyWarnS, prettyErrorS, prettyWarnNoIndentS, prettyErrorNoIndentS
      -- * Semantic styling functions
      -- | These are used rather than applying colors or other styling directly,
      -- to provide consistency.
    , style
    , displayMilliseconds
    , logLevelToStyle
      -- * Formatting utils
    , bulletedList
    , mkNarrativeList
    , spacedBulletedList
    , 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

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 'Doc' 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

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 milliseconds.
displayMilliseconds :: Double -> 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'.
bulletedList :: [StyleDoc] -> StyleDoc
bulletedList :: [StyleDoc] -> StyleDoc
bulletedList = forall a. Monoid a => [a] -> a
mconcat forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> [a] -> [a]
intersperse StyleDoc
line forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map ((StyleDoc
"*" StyleDoc -> StyleDoc -> StyleDoc
<+>) forall b c a. (b -> c) -> (a -> b) -> a -> c
. StyleDoc -> StyleDoc
align)

-- | 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.
spacedBulletedList :: [StyleDoc] -> StyleDoc
spacedBulletedList :: [StyleDoc] -> StyleDoc
spacedBulletedList = forall a. Monoid a => [a] -> a
mconcat forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> [a] -> [a]
intersperse (StyleDoc
line forall a. Semigroup a => a -> a -> a
<> StyleDoc
line) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map ((StyleDoc
"*" StyleDoc -> StyleDoc -> StyleDoc
<+>) forall b c a. (b -> c) -> (a -> b) -> a -> c
. StyleDoc -> StyleDoc
align)

-- | 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