{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE OverloadedStrings #-}
module RIO.PrettyPrint
(
HasTerm (..), HasStylesUpdate (..)
, displayPlain, displayWithColor
, prettyDebug, prettyInfo, prettyNote, prettyWarn, prettyError, prettyWarnNoIndent, prettyErrorNoIndent
, prettyDebugL, prettyInfoL, prettyNoteL, prettyWarnL, prettyErrorL, prettyWarnNoIndentL, prettyErrorNoIndentL
, prettyDebugS, prettyInfoS, prettyNoteS, prettyWarnS, prettyErrorS, prettyWarnNoIndentS, prettyErrorNoIndentS
, style
, displayMilliseconds
, bulletedList
, spacedBulletedList
, debugBracket
, 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
, indentAfterLabel, wordDocs, flow
, 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,
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 :: a -> m Utf8Builder
displayWithColor a
x = do
Bool
useAnsi <- Getting Bool env Bool -> m Bool
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Bool env Bool
forall env. HasTerm env => Lens' env Bool
useColorL
Int
termWidth <- Getting Int env Int -> m Int
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Int env Int
forall env. HasTerm env => Lens' env Int
termWidthL
(if Bool
useAnsi then Int -> a -> m Utf8Builder
forall a env (m :: * -> *).
(Pretty a, HasLogFunc env, HasStylesUpdate env, MonadReader env m,
HasCallStack) =>
Int -> a -> m Utf8Builder
displayAnsi else Int -> a -> m Utf8Builder
forall a env (m :: * -> *).
(Pretty a, HasLogFunc env, HasStylesUpdate env, MonadReader env m,
HasCallStack) =>
Int -> a -> m Utf8Builder
displayPlain) Int
termWidth a
x
prettyWith :: (HasTerm env, HasCallStack, Pretty b,
MonadReader env m, MonadIO m)
=> LogLevel -> (a -> b) -> a -> m ()
prettyWith :: LogLevel -> (a -> b) -> a -> m ()
prettyWith LogLevel
level a -> b
f = LogSource -> LogLevel -> Utf8Builder -> m ()
forall (m :: * -> *) env.
(MonadIO m, MonadReader env m, HasLogFunc env, HasCallStack) =>
LogSource -> LogLevel -> Utf8Builder -> m ()
logGeneric LogSource
"" LogLevel
level (Utf8Builder -> m ())
-> (Utf8Builder -> Utf8Builder) -> Utf8Builder -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Utf8Builder -> Utf8Builder
forall a. Display a => a -> Utf8Builder
RIO.display (Utf8Builder -> m ()) -> (a -> m Utf8Builder) -> a -> m ()
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< b -> m Utf8Builder
forall env a (m :: * -> *).
(HasTerm env, Pretty a, MonadReader env m, HasCallStack) =>
a -> m Utf8Builder
displayWithColor (b -> m Utf8Builder) -> (a -> b) -> a -> m Utf8Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> b
f
prettyDebugWith, prettyInfoWith, prettyNoteWith, prettyWarnWith, prettyErrorWith, prettyWarnNoIndentWith, prettyErrorNoIndentWith
:: (HasCallStack, HasTerm env, MonadReader env m, MonadIO m)
=> (a -> StyleDoc) -> a -> m ()
prettyDebugWith :: (a -> StyleDoc) -> a -> m ()
prettyDebugWith = LogLevel -> (a -> StyleDoc) -> a -> m ()
forall env b (m :: * -> *) a.
(HasTerm env, HasCallStack, Pretty b, MonadReader env m,
MonadIO m) =>
LogLevel -> (a -> b) -> a -> m ()
prettyWith LogLevel
LevelDebug
prettyInfoWith :: (a -> StyleDoc) -> a -> m ()
prettyInfoWith = LogLevel -> (a -> StyleDoc) -> a -> m ()
forall env b (m :: * -> *) a.
(HasTerm env, HasCallStack, Pretty b, MonadReader env m,
MonadIO m) =>
LogLevel -> (a -> b) -> a -> m ()
prettyWith LogLevel
LevelInfo
prettyNoteWith :: (a -> StyleDoc) -> a -> m ()
prettyNoteWith a -> StyleDoc
f = LogLevel -> (a -> StyleDoc) -> a -> m ()
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 StyleDoc -> StyleDoc -> StyleDoc
forall a. Semigroup a => a -> a -> a
<>) (StyleDoc -> StyleDoc) -> (a -> StyleDoc) -> a -> StyleDoc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Style -> StyleDoc -> StyleDoc
style Style
Good StyleDoc
"Note:" StyleDoc -> StyleDoc -> StyleDoc
<+>) (StyleDoc -> StyleDoc) -> (a -> StyleDoc) -> a -> StyleDoc
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
StyleDoc -> StyleDoc
indentAfterLabel (StyleDoc -> StyleDoc) -> (a -> StyleDoc) -> a -> StyleDoc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> StyleDoc
f)
prettyWarnWith :: (a -> StyleDoc) -> a -> m ()
prettyWarnWith a -> StyleDoc
f = LogLevel -> (a -> StyleDoc) -> a -> m ()
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 StyleDoc -> StyleDoc -> StyleDoc
forall a. Semigroup a => a -> a -> a
<>) (StyleDoc -> StyleDoc) -> (a -> StyleDoc) -> a -> StyleDoc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Style -> StyleDoc -> StyleDoc
style Style
Warning StyleDoc
"Warning:" StyleDoc -> StyleDoc -> StyleDoc
<+>) (StyleDoc -> StyleDoc) -> (a -> StyleDoc) -> a -> StyleDoc
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
StyleDoc -> StyleDoc
indentAfterLabel (StyleDoc -> StyleDoc) -> (a -> StyleDoc) -> a -> StyleDoc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> StyleDoc
f)
prettyErrorWith :: (a -> StyleDoc) -> a -> m ()
prettyErrorWith a -> StyleDoc
f = LogLevel -> (a -> StyleDoc) -> a -> m ()
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 StyleDoc -> StyleDoc -> StyleDoc
forall a. Semigroup a => a -> a -> a
<>) (StyleDoc -> StyleDoc) -> (a -> StyleDoc) -> a -> StyleDoc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Style -> StyleDoc -> StyleDoc
style Style
Error StyleDoc
"Error:" StyleDoc -> StyleDoc -> StyleDoc
<+>) (StyleDoc -> StyleDoc) -> (a -> StyleDoc) -> a -> StyleDoc
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
StyleDoc -> StyleDoc
indentAfterLabel (StyleDoc -> StyleDoc) -> (a -> StyleDoc) -> a -> StyleDoc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> StyleDoc
f)
prettyWarnNoIndentWith :: (a -> StyleDoc) -> a -> m ()
prettyWarnNoIndentWith a -> StyleDoc
f = LogLevel -> (a -> StyleDoc) -> a -> m ()
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 StyleDoc -> StyleDoc -> StyleDoc
forall a. Semigroup a => a -> a -> a
<>) (StyleDoc -> StyleDoc) -> (a -> StyleDoc) -> a -> StyleDoc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Style -> StyleDoc -> StyleDoc
style Style
Warning StyleDoc
"Warning:" StyleDoc -> StyleDoc -> StyleDoc
<+>) (StyleDoc -> StyleDoc) -> (a -> StyleDoc) -> a -> StyleDoc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> StyleDoc
f)
prettyErrorNoIndentWith :: (a -> StyleDoc) -> a -> m ()
prettyErrorNoIndentWith a -> StyleDoc
f = LogLevel -> (a -> StyleDoc) -> a -> m ()
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 StyleDoc -> StyleDoc -> StyleDoc
forall a. Semigroup a => a -> a -> a
<>) (StyleDoc -> StyleDoc) -> (a -> StyleDoc) -> a -> StyleDoc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Style -> StyleDoc -> StyleDoc
style Style
Error StyleDoc
"Error:" StyleDoc -> StyleDoc -> StyleDoc
<+>) (StyleDoc -> StyleDoc) -> (a -> StyleDoc) -> a -> 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 :: StyleDoc -> m ()
prettyDebug = (StyleDoc -> StyleDoc) -> StyleDoc -> m ()
forall env (m :: * -> *) a.
(HasCallStack, HasTerm env, MonadReader env m, MonadIO m) =>
(a -> StyleDoc) -> a -> m ()
prettyDebugWith StyleDoc -> StyleDoc
forall a. a -> a
id
prettyInfo :: StyleDoc -> m ()
prettyInfo = (StyleDoc -> StyleDoc) -> StyleDoc -> m ()
forall env (m :: * -> *) a.
(HasCallStack, HasTerm env, MonadReader env m, MonadIO m) =>
(a -> StyleDoc) -> a -> m ()
prettyInfoWith StyleDoc -> StyleDoc
forall a. a -> a
id
prettyNote :: StyleDoc -> m ()
prettyNote = (StyleDoc -> StyleDoc) -> StyleDoc -> m ()
forall env (m :: * -> *) a.
(HasCallStack, HasTerm env, MonadReader env m, MonadIO m) =>
(a -> StyleDoc) -> a -> m ()
prettyNoteWith StyleDoc -> StyleDoc
forall a. a -> a
id
prettyWarn :: StyleDoc -> m ()
prettyWarn = (StyleDoc -> StyleDoc) -> StyleDoc -> m ()
forall env (m :: * -> *) a.
(HasCallStack, HasTerm env, MonadReader env m, MonadIO m) =>
(a -> StyleDoc) -> a -> m ()
prettyWarnWith StyleDoc -> StyleDoc
forall a. a -> a
id
prettyError :: StyleDoc -> m ()
prettyError = (StyleDoc -> StyleDoc) -> StyleDoc -> m ()
forall env (m :: * -> *) a.
(HasCallStack, HasTerm env, MonadReader env m, MonadIO m) =>
(a -> StyleDoc) -> a -> m ()
prettyErrorWith StyleDoc -> StyleDoc
forall a. a -> a
id
prettyWarnNoIndent :: StyleDoc -> m ()
prettyWarnNoIndent = (StyleDoc -> StyleDoc) -> StyleDoc -> m ()
forall env (m :: * -> *) a.
(HasCallStack, HasTerm env, MonadReader env m, MonadIO m) =>
(a -> StyleDoc) -> a -> m ()
prettyWarnNoIndentWith StyleDoc -> StyleDoc
forall a. a -> a
id
prettyErrorNoIndent :: StyleDoc -> m ()
prettyErrorNoIndent = (StyleDoc -> StyleDoc) -> StyleDoc -> m ()
forall env (m :: * -> *) a.
(HasCallStack, HasTerm env, MonadReader env m, MonadIO m) =>
(a -> StyleDoc) -> a -> m ()
prettyErrorNoIndentWith StyleDoc -> StyleDoc
forall a. a -> a
id
prettyDebugL, prettyInfoL, prettyNoteL, prettyWarnL, prettyErrorL, prettyWarnNoIndentL, prettyErrorNoIndentL
:: (HasCallStack, HasTerm env, MonadReader env m, MonadIO m)
=> [StyleDoc] -> m ()
prettyDebugL :: [StyleDoc] -> m ()
prettyDebugL = ([StyleDoc] -> StyleDoc) -> [StyleDoc] -> m ()
forall env (m :: * -> *) a.
(HasCallStack, HasTerm env, MonadReader env m, MonadIO m) =>
(a -> StyleDoc) -> a -> m ()
prettyDebugWith [StyleDoc] -> StyleDoc
fillSep
prettyInfoL :: [StyleDoc] -> m ()
prettyInfoL = ([StyleDoc] -> StyleDoc) -> [StyleDoc] -> m ()
forall env (m :: * -> *) a.
(HasCallStack, HasTerm env, MonadReader env m, MonadIO m) =>
(a -> StyleDoc) -> a -> m ()
prettyInfoWith [StyleDoc] -> StyleDoc
fillSep
prettyNoteL :: [StyleDoc] -> m ()
prettyNoteL = ([StyleDoc] -> StyleDoc) -> [StyleDoc] -> m ()
forall env (m :: * -> *) a.
(HasCallStack, HasTerm env, MonadReader env m, MonadIO m) =>
(a -> StyleDoc) -> a -> m ()
prettyNoteWith [StyleDoc] -> StyleDoc
fillSep
prettyWarnL :: [StyleDoc] -> m ()
prettyWarnL = ([StyleDoc] -> StyleDoc) -> [StyleDoc] -> m ()
forall env (m :: * -> *) a.
(HasCallStack, HasTerm env, MonadReader env m, MonadIO m) =>
(a -> StyleDoc) -> a -> m ()
prettyWarnWith [StyleDoc] -> StyleDoc
fillSep
prettyErrorL :: [StyleDoc] -> m ()
prettyErrorL = ([StyleDoc] -> StyleDoc) -> [StyleDoc] -> m ()
forall env (m :: * -> *) a.
(HasCallStack, HasTerm env, MonadReader env m, MonadIO m) =>
(a -> StyleDoc) -> a -> m ()
prettyErrorWith [StyleDoc] -> StyleDoc
fillSep
prettyWarnNoIndentL :: [StyleDoc] -> m ()
prettyWarnNoIndentL = ([StyleDoc] -> StyleDoc) -> [StyleDoc] -> m ()
forall env (m :: * -> *) a.
(HasCallStack, HasTerm env, MonadReader env m, MonadIO m) =>
(a -> StyleDoc) -> a -> m ()
prettyWarnNoIndentWith [StyleDoc] -> StyleDoc
fillSep
prettyErrorNoIndentL :: [StyleDoc] -> m ()
prettyErrorNoIndentL = ([StyleDoc] -> StyleDoc) -> [StyleDoc] -> m ()
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 :: String -> m ()
prettyDebugS = (String -> StyleDoc) -> String -> m ()
forall env (m :: * -> *) a.
(HasCallStack, HasTerm env, MonadReader env m, MonadIO m) =>
(a -> StyleDoc) -> a -> m ()
prettyDebugWith String -> StyleDoc
flow
prettyInfoS :: String -> m ()
prettyInfoS = (String -> StyleDoc) -> String -> m ()
forall env (m :: * -> *) a.
(HasCallStack, HasTerm env, MonadReader env m, MonadIO m) =>
(a -> StyleDoc) -> a -> m ()
prettyInfoWith String -> StyleDoc
flow
prettyNoteS :: String -> m ()
prettyNoteS = (String -> StyleDoc) -> String -> m ()
forall env (m :: * -> *) a.
(HasCallStack, HasTerm env, MonadReader env m, MonadIO m) =>
(a -> StyleDoc) -> a -> m ()
prettyNoteWith String -> StyleDoc
flow
prettyWarnS :: String -> m ()
prettyWarnS = (String -> StyleDoc) -> String -> m ()
forall env (m :: * -> *) a.
(HasCallStack, HasTerm env, MonadReader env m, MonadIO m) =>
(a -> StyleDoc) -> a -> m ()
prettyWarnWith String -> StyleDoc
flow
prettyErrorS :: String -> m ()
prettyErrorS = (String -> StyleDoc) -> String -> m ()
forall env (m :: * -> *) a.
(HasCallStack, HasTerm env, MonadReader env m, MonadIO m) =>
(a -> StyleDoc) -> a -> m ()
prettyErrorWith String -> StyleDoc
flow
prettyWarnNoIndentS :: String -> m ()
prettyWarnNoIndentS = (String -> StyleDoc) -> String -> m ()
forall env (m :: * -> *) a.
(HasCallStack, HasTerm env, MonadReader env m, MonadIO m) =>
(a -> StyleDoc) -> a -> m ()
prettyWarnNoIndentWith String -> StyleDoc
flow
prettyErrorNoIndentS :: String -> m ()
prettyErrorNoIndentS = (String -> StyleDoc) -> String -> m ()
forall env (m :: * -> *) a.
(HasCallStack, HasTerm env, MonadReader env m, MonadIO m) =>
(a -> StyleDoc) -> a -> m ()
prettyErrorNoIndentWith String -> StyleDoc
flow
indentAfterLabel :: StyleDoc -> StyleDoc
indentAfterLabel :: StyleDoc -> StyleDoc
indentAfterLabel = StyleDoc -> StyleDoc
align
wordDocs :: String -> [StyleDoc]
wordDocs :: String -> [StyleDoc]
wordDocs = (String -> StyleDoc) -> [String] -> [StyleDoc]
forall a b. (a -> b) -> [a] -> [b]
map String -> StyleDoc
forall a. IsString a => String -> a
fromString ([String] -> [StyleDoc])
-> (String -> [String]) -> String -> [StyleDoc]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [String]
words
flow :: String -> StyleDoc
flow :: String -> StyleDoc
flow = [StyleDoc] -> StyleDoc
fillSep ([StyleDoc] -> StyleDoc)
-> (String -> [StyleDoc]) -> String -> StyleDoc
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 :: StyleDoc -> m a -> m a
debugBracket StyleDoc
msg m a
f = do
let output :: StyleDoc -> m ()
output = Utf8Builder -> m ()
forall (m :: * -> *) env.
(MonadIO m, MonadReader env m, HasLogFunc env, HasCallStack) =>
Utf8Builder -> m ()
logDebug (Utf8Builder -> m ())
-> (Utf8Builder -> Utf8Builder) -> Utf8Builder -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Utf8Builder -> Utf8Builder
forall a. Display a => a -> Utf8Builder
RIO.display (Utf8Builder -> m ())
-> (StyleDoc -> m Utf8Builder) -> StyleDoc -> m ()
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< StyleDoc -> m Utf8Builder
forall env a (m :: * -> *).
(HasTerm env, Pretty a, MonadReader env m, HasCallStack) =>
a -> m Utf8Builder
displayWithColor
StyleDoc -> m ()
output (StyleDoc -> m ()) -> StyleDoc -> m ()
forall a b. (a -> b) -> a -> b
$ StyleDoc
"Start: " StyleDoc -> StyleDoc -> StyleDoc
forall a. Semigroup a => a -> a -> a
<> StyleDoc
msg
Double
start <- m Double
forall (m :: * -> *). MonadIO m => m Double
getMonotonicTime
a
x <- m a
f m a -> (SomeException -> m a) -> m a
forall (m :: * -> *) e a.
(MonadUnliftIO m, Exception e) =>
m a -> (e -> m a) -> m a
`catch` \SomeException
ex -> do
Double
end <- m Double
forall (m :: * -> *). MonadIO m => m Double
getMonotonicTime
let diff :: Double
diff = Double
end Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
start
StyleDoc -> m ()
output (StyleDoc -> m ()) -> StyleDoc -> m ()
forall a b. (a -> b) -> a -> b
$ StyleDoc
"Finished with exception in" StyleDoc -> StyleDoc -> StyleDoc
<+> Double -> StyleDoc
displayMilliseconds Double
diff StyleDoc -> StyleDoc -> StyleDoc
forall a. Semigroup a => a -> a -> a
<> StyleDoc
":" StyleDoc -> StyleDoc -> StyleDoc
<+>
StyleDoc
msg StyleDoc -> StyleDoc -> StyleDoc
forall a. Semigroup a => a -> a -> a
<> StyleDoc
line StyleDoc -> StyleDoc -> StyleDoc
forall a. Semigroup a => a -> a -> a
<>
StyleDoc
"Exception thrown: " StyleDoc -> StyleDoc -> StyleDoc
forall a. Semigroup a => a -> a -> a
<> String -> StyleDoc
forall a. IsString a => String -> a
fromString (SomeException -> String
forall a. Show a => a -> String
show SomeException
ex)
SomeException -> m a
forall (m :: * -> *) e a. (MonadIO m, Exception e) => e -> m a
throwIO (SomeException
ex :: SomeException)
Double
end <- m Double
forall (m :: * -> *). MonadIO m => m Double
getMonotonicTime
let diff :: Double
diff = Double
end Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
start
StyleDoc -> m ()
output (StyleDoc -> m ()) -> StyleDoc -> m ()
forall a b. (a -> b) -> a -> b
$ StyleDoc
"Finished in" StyleDoc -> StyleDoc -> StyleDoc
<+> Double -> StyleDoc
displayMilliseconds Double
diff StyleDoc -> StyleDoc -> StyleDoc
forall a. Semigroup a => a -> a -> a
<> StyleDoc
":" StyleDoc -> StyleDoc -> StyleDoc
<+> StyleDoc
msg
a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return a
x
style :: Style -> StyleDoc -> StyleDoc
style :: Style -> StyleDoc -> StyleDoc
style = Style -> StyleDoc -> StyleDoc
styleAnn
displayMilliseconds :: Double -> StyleDoc
displayMilliseconds :: Double -> StyleDoc
displayMilliseconds Double
t = Style -> StyleDoc -> StyleDoc
style Style
Good (StyleDoc -> StyleDoc) -> StyleDoc -> StyleDoc
forall a b. (a -> b) -> a -> b
$
String -> StyleDoc
forall a. IsString a => String -> a
fromString (Int -> String
forall a. Show a => a -> String
show (Double -> Int
forall a b. (RealFrac a, Integral b) => a -> b
round (Double
t Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
1000) :: Int)) StyleDoc -> StyleDoc -> StyleDoc
forall a. Semigroup a => a -> a -> a
<> StyleDoc
"ms"
bulletedList :: [StyleDoc] -> StyleDoc
bulletedList :: [StyleDoc] -> StyleDoc
bulletedList = [StyleDoc] -> StyleDoc
forall a. Monoid a => [a] -> a
mconcat ([StyleDoc] -> StyleDoc)
-> ([StyleDoc] -> [StyleDoc]) -> [StyleDoc] -> StyleDoc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StyleDoc -> [StyleDoc] -> [StyleDoc]
forall a. a -> [a] -> [a]
intersperse StyleDoc
line ([StyleDoc] -> [StyleDoc])
-> ([StyleDoc] -> [StyleDoc]) -> [StyleDoc] -> [StyleDoc]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (StyleDoc -> StyleDoc) -> [StyleDoc] -> [StyleDoc]
forall a b. (a -> b) -> [a] -> [b]
map ((StyleDoc
"*" StyleDoc -> StyleDoc -> StyleDoc
<+>) (StyleDoc -> StyleDoc)
-> (StyleDoc -> StyleDoc) -> StyleDoc -> StyleDoc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StyleDoc -> StyleDoc
align)
spacedBulletedList :: [StyleDoc] -> StyleDoc
spacedBulletedList :: [StyleDoc] -> StyleDoc
spacedBulletedList = [StyleDoc] -> StyleDoc
forall a. Monoid a => [a] -> a
mconcat ([StyleDoc] -> StyleDoc)
-> ([StyleDoc] -> [StyleDoc]) -> [StyleDoc] -> StyleDoc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StyleDoc -> [StyleDoc] -> [StyleDoc]
forall a. a -> [a] -> [a]
intersperse (StyleDoc
line StyleDoc -> StyleDoc -> StyleDoc
forall a. Semigroup a => a -> a -> a
<> StyleDoc
line) ([StyleDoc] -> [StyleDoc])
-> ([StyleDoc] -> [StyleDoc]) -> [StyleDoc] -> [StyleDoc]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (StyleDoc -> StyleDoc) -> [StyleDoc] -> [StyleDoc]
forall a b. (a -> b) -> [a] -> [b]
map ((StyleDoc
"*" StyleDoc -> StyleDoc -> StyleDoc
<+>) (StyleDoc -> StyleDoc)
-> (StyleDoc -> StyleDoc) -> StyleDoc -> StyleDoc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StyleDoc -> StyleDoc
align)