{-# LANGUAGE DefaultSignatures          #-}
{-# LANGUAGE DeriveFunctor              #-}
{-# LANGUAGE DeriveTraversable          #-}
{-# LANGUAGE DeriveGeneric              #-}
{-# LANGUAGE FlexibleContexts           #-}
{-# LANGUAGE FlexibleInstances          #-}
{-# LANGUAGE FunctionalDependencies     #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE MultiParamTypeClasses      #-}
{-# LANGUAGE NamedFieldPuns             #-}
{-# LANGUAGE OverloadedStrings          #-}
{-# LANGUAGE RankNTypes                 #-}
{-# LANGUAGE TemplateHaskell            #-}
{-# LANGUAGE TypeFamilies               #-}
{-# LANGUAGE UndecidableInstances       #-}

{-# OPTIONS_GHC -Wall            #-}

{-|

Provides logging for analyses. 'MonadLogger' is a type class for monads which
support logging. 'LoggerT' is a concrete monad transformer instantiating the
class.

As a logger runs, it may print out log messages on the fly (depending on the
provided 'LogOutput' function). It also collects logs to be inspected at the end
of the computation.

A log message must usually include an 'Origin', which describes where in a
Fortran source file the message originated. This is made more convenient via
functions such as 'logWarn\'', which produces an 'Origin' based on a piece of
Fortran syntax, along with a default source file stored in the environment.

Log messages each come with an associated 'LogLevel':

- 'LogError' is for hard errors which will often cause the computation to fail.
- 'LogWarn' is for messages about things that are likely to cause problems.
- 'LogInfo' is for general information about what the computation is doing.
- 'LogDebug' is for extra-verbose output that helps with debugging, but which
  will be uninteresting to most users.

-}
module Camfort.Analysis.Logger
  (
  -- * Conversion to text description
    Describe(..)
  , tellDescribe
  , describeShow
  , builderToStrict
  , Builder
  , Text
  , (<>)
  -- * Messages
  , Origin(..)
  , ParsedOrigin(..)
  , parseOrigin
  , oFile
  , oSpan
  , LogLevel(..)
  , LogMessage(..)
  , lmOrigin
  , lmMsg
  , SomeMessage(..)
  , _MsgError
  , _MsgWarn
  , _MsgInfo
  , _MsgDebug
  -- * Logging monad
  , MonadLogger(..)
  , atSpanned
  , atSpannedInFile
  , LoggerT
  , mapLoggerT
  -- * Running a logger
  , LogOutput
  , logOutputStd
  , logOutputNone
  , runLoggerT
  ) where

import qualified Data.Semigroup                 as SG
import           Data.Void                      (Void)

import           Control.DeepSeq
import           Control.Lens

import           Control.Monad.Except
import           Control.Monad.Morph
import           Control.Monad.Reader
import           Control.Monad.RWS
import qualified Control.Monad.State            as Lazy
import           Control.Monad.State.Strict
import           Control.Monad.Writer
import           Control.Monad.Fail

import           Data.Text                      (Text)
import qualified Data.Text.IO                   as Text
import qualified Data.Text.Lazy                 as Lazy
import           Data.Text.Lazy.Builder         (Builder)
import qualified Data.Text.Lazy.Builder         as Builder

import           GHC.Generics

import           Text.Read                      (readMaybe)
import qualified Language.Fortran.Util.Position as F

--------------------------------------------------------------------------------
--  'Describe' class
--------------------------------------------------------------------------------

-- TODO: More 'Describe' instances for built-in types.

-- | A type class for efficiently converting values to human-readable output.
-- Can be automatically instantiated for 'Show' types, but this will not be very
-- human-readable for a lot of types.
class Describe a where
  -- | Convert the value to a human-readable output as a strict 'Text' value.
  describe :: a -> Text

  -- | Convert the value to human-readable output in a text 'Builder' which can
  -- be efficiently concatenated with other 'Builder's.
  describeBuilder :: a -> Builder

  default describeBuilder :: Show a => a -> Builder
  describe = Builder -> Text
builderToStrict (Builder -> Text) -> (a -> Builder) -> a -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Builder
forall a. Describe a => a -> Builder
describeBuilder
  describeBuilder = String -> Builder
Builder.fromString (String -> Builder) -> (a -> String) -> a -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> String
forall a. Show a => a -> String
show

instance Describe F.SrcSpan
instance Describe Text where
  describeBuilder :: Text -> Builder
describeBuilder = Text -> Builder
Builder.fromText
instance Describe [Char] where
  describeBuilder :: String -> Builder
describeBuilder = String -> Builder
Builder.fromString
instance Describe () where
  describeBuilder :: () -> Builder
describeBuilder = Builder -> () -> Builder
forall a b. a -> b -> a
const Builder
forall a. Monoid a => a
mempty
instance Describe Int
instance Describe Integer
instance Describe Float
instance Describe Double
instance Describe Void

-- | A convenience combinator to directly convert a lazy text 'Builder' to a
-- strict 'Text' value.
builderToStrict :: Builder -> Text
builderToStrict :: Builder -> Text
builderToStrict = Text -> Text
Lazy.toStrict (Text -> Text) -> (Builder -> Text) -> Builder -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> Text
Builder.toLazyText

-- | Write a 'Describe'-able value directly into a writer monad.
tellDescribe :: (MonadWriter Builder m, Describe a) => a -> m ()
tellDescribe :: a -> m ()
tellDescribe = Builder -> m ()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell (Builder -> m ()) -> (a -> Builder) -> a -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Builder
forall a. Describe a => a -> Builder
describeBuilder

-- | Convert a 'Show'-able value directly to strict 'Text'. Useful when you have
-- a 'Show' instance but not a 'Describe' instance.
describeShow :: (Show a) => a -> Text
describeShow :: a -> Text
describeShow = String -> Text
forall a. Describe a => a -> Text
describe (String -> Text) -> (a -> String) -> a -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> String
forall a. Show a => a -> String
show

--------------------------------------------------------------------------------
--  Messages
--------------------------------------------------------------------------------

-- | A message origin, containing a file and a source span.
data Origin =
  Origin
  { Origin -> String
_oFile :: FilePath
  , Origin -> SrcSpan
_oSpan :: F.SrcSpan
  }
  deriving (Int -> Origin -> ShowS
[Origin] -> ShowS
Origin -> String
(Int -> Origin -> ShowS)
-> (Origin -> String) -> ([Origin] -> ShowS) -> Show Origin
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Origin] -> ShowS
$cshowList :: [Origin] -> ShowS
show :: Origin -> String
$cshow :: Origin -> String
showsPrec :: Int -> Origin -> ShowS
$cshowsPrec :: Int -> Origin -> ShowS
Show, Origin -> Origin -> Bool
(Origin -> Origin -> Bool)
-> (Origin -> Origin -> Bool) -> Eq Origin
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Origin -> Origin -> Bool
$c/= :: Origin -> Origin -> Bool
== :: Origin -> Origin -> Bool
$c== :: Origin -> Origin -> Bool
Eq, Eq Origin
Eq Origin
-> (Origin -> Origin -> Ordering)
-> (Origin -> Origin -> Bool)
-> (Origin -> Origin -> Bool)
-> (Origin -> Origin -> Bool)
-> (Origin -> Origin -> Bool)
-> (Origin -> Origin -> Origin)
-> (Origin -> Origin -> Origin)
-> Ord Origin
Origin -> Origin -> Bool
Origin -> Origin -> Ordering
Origin -> Origin -> Origin
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Origin -> Origin -> Origin
$cmin :: Origin -> Origin -> Origin
max :: Origin -> Origin -> Origin
$cmax :: Origin -> Origin -> Origin
>= :: Origin -> Origin -> Bool
$c>= :: Origin -> Origin -> Bool
> :: Origin -> Origin -> Bool
$c> :: Origin -> Origin -> Bool
<= :: Origin -> Origin -> Bool
$c<= :: Origin -> Origin -> Bool
< :: Origin -> Origin -> Bool
$c< :: Origin -> Origin -> Bool
compare :: Origin -> Origin -> Ordering
$ccompare :: Origin -> Origin -> Ordering
$cp1Ord :: Eq Origin
Ord, (forall x. Origin -> Rep Origin x)
-> (forall x. Rep Origin x -> Origin) -> Generic Origin
forall x. Rep Origin x -> Origin
forall x. Origin -> Rep Origin x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Origin x -> Origin
$cfrom :: forall x. Origin -> Rep Origin x
Generic)

makeLenses ''Origin

instance NFData Origin

instance Describe Origin where
  describeBuilder :: Origin -> Builder
describeBuilder Origin
origin =
    Builder
"at [" Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> String -> Builder
Builder.fromString (Origin
origin Origin -> Getting String Origin String -> String
forall s a. s -> Getting a s a -> a
^. Getting String Origin String
Lens' Origin String
oFile) Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<>
    Builder
", " Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> SrcSpan -> Builder
forall a. Describe a => a -> Builder
describeBuilder (Origin
origin Origin -> Getting SrcSpan Origin SrcSpan -> SrcSpan
forall s a. s -> Getting a s a -> a
^. Getting SrcSpan Origin SrcSpan
Lens' Origin SrcSpan
oSpan) Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
"]"

data ParsedOrigin = ParsedOrigin FilePath (Int, Int) (Int, Int)
  deriving (Int -> ParsedOrigin -> ShowS
[ParsedOrigin] -> ShowS
ParsedOrigin -> String
(Int -> ParsedOrigin -> ShowS)
-> (ParsedOrigin -> String)
-> ([ParsedOrigin] -> ShowS)
-> Show ParsedOrigin
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ParsedOrigin] -> ShowS
$cshowList :: [ParsedOrigin] -> ShowS
show :: ParsedOrigin -> String
$cshow :: ParsedOrigin -> String
showsPrec :: Int -> ParsedOrigin -> ShowS
$cshowsPrec :: Int -> ParsedOrigin -> ShowS
Show, ParsedOrigin -> ParsedOrigin -> Bool
(ParsedOrigin -> ParsedOrigin -> Bool)
-> (ParsedOrigin -> ParsedOrigin -> Bool) -> Eq ParsedOrigin
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ParsedOrigin -> ParsedOrigin -> Bool
$c/= :: ParsedOrigin -> ParsedOrigin -> Bool
== :: ParsedOrigin -> ParsedOrigin -> Bool
$c== :: ParsedOrigin -> ParsedOrigin -> Bool
Eq, Eq ParsedOrigin
Eq ParsedOrigin
-> (ParsedOrigin -> ParsedOrigin -> Ordering)
-> (ParsedOrigin -> ParsedOrigin -> Bool)
-> (ParsedOrigin -> ParsedOrigin -> Bool)
-> (ParsedOrigin -> ParsedOrigin -> Bool)
-> (ParsedOrigin -> ParsedOrigin -> Bool)
-> (ParsedOrigin -> ParsedOrigin -> ParsedOrigin)
-> (ParsedOrigin -> ParsedOrigin -> ParsedOrigin)
-> Ord ParsedOrigin
ParsedOrigin -> ParsedOrigin -> Bool
ParsedOrigin -> ParsedOrigin -> Ordering
ParsedOrigin -> ParsedOrigin -> ParsedOrigin
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: ParsedOrigin -> ParsedOrigin -> ParsedOrigin
$cmin :: ParsedOrigin -> ParsedOrigin -> ParsedOrigin
max :: ParsedOrigin -> ParsedOrigin -> ParsedOrigin
$cmax :: ParsedOrigin -> ParsedOrigin -> ParsedOrigin
>= :: ParsedOrigin -> ParsedOrigin -> Bool
$c>= :: ParsedOrigin -> ParsedOrigin -> Bool
> :: ParsedOrigin -> ParsedOrigin -> Bool
$c> :: ParsedOrigin -> ParsedOrigin -> Bool
<= :: ParsedOrigin -> ParsedOrigin -> Bool
$c<= :: ParsedOrigin -> ParsedOrigin -> Bool
< :: ParsedOrigin -> ParsedOrigin -> Bool
$c< :: ParsedOrigin -> ParsedOrigin -> Bool
compare :: ParsedOrigin -> ParsedOrigin -> Ordering
$ccompare :: ParsedOrigin -> ParsedOrigin -> Ordering
$cp1Ord :: Eq ParsedOrigin
Ord)

-- | Extract information about filename and source span from a string.
parseOrigin :: String -> Maybe ParsedOrigin
parseOrigin :: String -> Maybe ParsedOrigin
parseOrigin String
str
  | Bool -> Bool
not (String -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
filename)
  , Just ((Int, Int)
pos1, String
rest) <- String -> Maybe ((Int, Int), String)
parsePos String
comma
  , Just ((Int, Int)
pos2, String
_)    <- String -> Maybe ((Int, Int), String)
parsePos String
rest = ParsedOrigin -> Maybe ParsedOrigin
forall a. a -> Maybe a
Just (String -> (Int, Int) -> (Int, Int) -> ParsedOrigin
ParsedOrigin String
filename (Int, Int)
pos1 (Int, Int)
pos2)
  | Bool
otherwise                          = Maybe ParsedOrigin
forall a. Maybe a
Nothing
  where
    lbrack :: String
lbrack            = (Char -> Bool) -> ShowS
forall a. (a -> Bool) -> [a] -> [a]
dropWhile (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'[') String
str
    (String
filename, String
comma) = (Char -> Bool) -> String -> (String, String)
forall a. (a -> Bool) -> [a] -> ([a], [a])
break (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
==Char
',') (Int -> ShowS
forall a. Int -> [a] -> [a]
drop Int
1 String
lbrack)

parsePos :: String -> Maybe ((Int, Int), String)
parsePos :: String -> Maybe ((Int, Int), String)
parsePos String
str
  | Just Int
l <- String -> Maybe Int
forall a. Read a => String -> Maybe a
readMaybe String
line
  , Just Int
c <- String -> Maybe Int
forall a. Read a => String -> Maybe a
readMaybe String
col  = ((Int, Int), String) -> Maybe ((Int, Int), String)
forall a. a -> Maybe a
Just ((Int
l, Int
c), String
rest)
  | Bool
otherwise                = Maybe ((Int, Int), String)
forall a. Maybe a
Nothing
  where
    lparen :: String
lparen        = (Char -> Bool) -> ShowS
forall a. (a -> Bool) -> [a] -> [a]
dropWhile (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'(') String
str
    (String
line, String
colon) = (Char -> Bool) -> String -> (String, String)
forall a. (a -> Bool) -> [a] -> ([a], [a])
break (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
':') (Int -> ShowS
forall a. Int -> [a] -> [a]
drop Int
1 String
lparen)
    (String
col, String
rest)   = (Char -> Bool) -> String -> (String, String)
forall a. (a -> Bool) -> [a] -> ([a], [a])
span (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
')') (Int -> ShowS
forall a. Int -> [a] -> [a]
drop Int
1 String
colon)

-- | A logging level. At each logging level, only produce output at that level or lower.
data LogLevel
  = LogError
  -- ^ At level 'LogError', only error messages are shown.
  | LogWarn
  -- ^ At level 'LogWarn', error and warning messages are shown.
  | LogInfo
  -- ^ At level 'LogInfo', error, warning and information messages are shown.
  | LogDebug
  -- ^ At level 'LogDebug', error, warning, information and debug output is
  -- shown.
  deriving (Int -> LogLevel -> ShowS
[LogLevel] -> ShowS
LogLevel -> String
(Int -> LogLevel -> ShowS)
-> (LogLevel -> String) -> ([LogLevel] -> ShowS) -> Show LogLevel
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [LogLevel] -> ShowS
$cshowList :: [LogLevel] -> ShowS
show :: LogLevel -> String
$cshow :: LogLevel -> String
showsPrec :: Int -> LogLevel -> ShowS
$cshowsPrec :: Int -> LogLevel -> ShowS
Show, LogLevel -> LogLevel -> Bool
(LogLevel -> LogLevel -> Bool)
-> (LogLevel -> LogLevel -> Bool) -> Eq LogLevel
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: LogLevel -> LogLevel -> Bool
$c/= :: LogLevel -> LogLevel -> Bool
== :: LogLevel -> LogLevel -> Bool
$c== :: LogLevel -> LogLevel -> Bool
Eq, Eq LogLevel
Eq LogLevel
-> (LogLevel -> LogLevel -> Ordering)
-> (LogLevel -> LogLevel -> Bool)
-> (LogLevel -> LogLevel -> Bool)
-> (LogLevel -> LogLevel -> Bool)
-> (LogLevel -> LogLevel -> Bool)
-> (LogLevel -> LogLevel -> LogLevel)
-> (LogLevel -> LogLevel -> LogLevel)
-> Ord LogLevel
LogLevel -> LogLevel -> Bool
LogLevel -> LogLevel -> Ordering
LogLevel -> LogLevel -> LogLevel
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: LogLevel -> LogLevel -> LogLevel
$cmin :: LogLevel -> LogLevel -> LogLevel
max :: LogLevel -> LogLevel -> LogLevel
$cmax :: LogLevel -> LogLevel -> LogLevel
>= :: LogLevel -> LogLevel -> Bool
$c>= :: LogLevel -> LogLevel -> Bool
> :: LogLevel -> LogLevel -> Bool
$c> :: LogLevel -> LogLevel -> Bool
<= :: LogLevel -> LogLevel -> Bool
$c<= :: LogLevel -> LogLevel -> Bool
< :: LogLevel -> LogLevel -> Bool
$c< :: LogLevel -> LogLevel -> Bool
compare :: LogLevel -> LogLevel -> Ordering
$ccompare :: LogLevel -> LogLevel -> Ordering
$cp1Ord :: Eq LogLevel
Ord)

instance Describe LogLevel where
  describeBuilder :: LogLevel -> Builder
describeBuilder LogLevel
LogError = Builder
"ERROR"
  describeBuilder LogLevel
LogWarn  = Builder
"WARN"
  describeBuilder LogLevel
LogInfo  = Builder
"INFO"
  describeBuilder LogLevel
LogDebug = Builder
"DEBUG"

-- | A logged message with an origin and a message value.
data LogMessage a =
  LogMessage
  { LogMessage a -> Maybe Origin
_lmOrigin :: Maybe Origin
  , LogMessage a -> a
_lmMsg    :: a
  }
  deriving (Int -> LogMessage a -> ShowS
[LogMessage a] -> ShowS
LogMessage a -> String
(Int -> LogMessage a -> ShowS)
-> (LogMessage a -> String)
-> ([LogMessage a] -> ShowS)
-> Show (LogMessage a)
forall a. Show a => Int -> LogMessage a -> ShowS
forall a. Show a => [LogMessage a] -> ShowS
forall a. Show a => LogMessage a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [LogMessage a] -> ShowS
$cshowList :: forall a. Show a => [LogMessage a] -> ShowS
show :: LogMessage a -> String
$cshow :: forall a. Show a => LogMessage a -> String
showsPrec :: Int -> LogMessage a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> LogMessage a -> ShowS
Show, LogMessage a -> LogMessage a -> Bool
(LogMessage a -> LogMessage a -> Bool)
-> (LogMessage a -> LogMessage a -> Bool) -> Eq (LogMessage a)
forall a. Eq a => LogMessage a -> LogMessage a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: LogMessage a -> LogMessage a -> Bool
$c/= :: forall a. Eq a => LogMessage a -> LogMessage a -> Bool
== :: LogMessage a -> LogMessage a -> Bool
$c== :: forall a. Eq a => LogMessage a -> LogMessage a -> Bool
Eq, a -> LogMessage b -> LogMessage a
(a -> b) -> LogMessage a -> LogMessage b
(forall a b. (a -> b) -> LogMessage a -> LogMessage b)
-> (forall a b. a -> LogMessage b -> LogMessage a)
-> Functor LogMessage
forall a b. a -> LogMessage b -> LogMessage a
forall a b. (a -> b) -> LogMessage a -> LogMessage b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> LogMessage b -> LogMessage a
$c<$ :: forall a b. a -> LogMessage b -> LogMessage a
fmap :: (a -> b) -> LogMessage a -> LogMessage b
$cfmap :: forall a b. (a -> b) -> LogMessage a -> LogMessage b
Functor, LogMessage a -> Bool
(a -> m) -> LogMessage a -> m
(a -> b -> b) -> b -> LogMessage a -> b
(forall m. Monoid m => LogMessage m -> m)
-> (forall m a. Monoid m => (a -> m) -> LogMessage a -> m)
-> (forall m a. Monoid m => (a -> m) -> LogMessage a -> m)
-> (forall a b. (a -> b -> b) -> b -> LogMessage a -> b)
-> (forall a b. (a -> b -> b) -> b -> LogMessage a -> b)
-> (forall b a. (b -> a -> b) -> b -> LogMessage a -> b)
-> (forall b a. (b -> a -> b) -> b -> LogMessage a -> b)
-> (forall a. (a -> a -> a) -> LogMessage a -> a)
-> (forall a. (a -> a -> a) -> LogMessage a -> a)
-> (forall a. LogMessage a -> [a])
-> (forall a. LogMessage a -> Bool)
-> (forall a. LogMessage a -> Int)
-> (forall a. Eq a => a -> LogMessage a -> Bool)
-> (forall a. Ord a => LogMessage a -> a)
-> (forall a. Ord a => LogMessage a -> a)
-> (forall a. Num a => LogMessage a -> a)
-> (forall a. Num a => LogMessage a -> a)
-> Foldable LogMessage
forall a. Eq a => a -> LogMessage a -> Bool
forall a. Num a => LogMessage a -> a
forall a. Ord a => LogMessage a -> a
forall m. Monoid m => LogMessage m -> m
forall a. LogMessage a -> Bool
forall a. LogMessage a -> Int
forall a. LogMessage a -> [a]
forall a. (a -> a -> a) -> LogMessage a -> a
forall m a. Monoid m => (a -> m) -> LogMessage a -> m
forall b a. (b -> a -> b) -> b -> LogMessage a -> b
forall a b. (a -> b -> b) -> b -> LogMessage a -> b
forall (t :: * -> *).
(forall m. Monoid m => t m -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. t a -> [a])
-> (forall a. t a -> Bool)
-> (forall a. t a -> Int)
-> (forall a. Eq a => a -> t a -> Bool)
-> (forall a. Ord a => t a -> a)
-> (forall a. Ord a => t a -> a)
-> (forall a. Num a => t a -> a)
-> (forall a. Num a => t a -> a)
-> Foldable t
product :: LogMessage a -> a
$cproduct :: forall a. Num a => LogMessage a -> a
sum :: LogMessage a -> a
$csum :: forall a. Num a => LogMessage a -> a
minimum :: LogMessage a -> a
$cminimum :: forall a. Ord a => LogMessage a -> a
maximum :: LogMessage a -> a
$cmaximum :: forall a. Ord a => LogMessage a -> a
elem :: a -> LogMessage a -> Bool
$celem :: forall a. Eq a => a -> LogMessage a -> Bool
length :: LogMessage a -> Int
$clength :: forall a. LogMessage a -> Int
null :: LogMessage a -> Bool
$cnull :: forall a. LogMessage a -> Bool
toList :: LogMessage a -> [a]
$ctoList :: forall a. LogMessage a -> [a]
foldl1 :: (a -> a -> a) -> LogMessage a -> a
$cfoldl1 :: forall a. (a -> a -> a) -> LogMessage a -> a
foldr1 :: (a -> a -> a) -> LogMessage a -> a
$cfoldr1 :: forall a. (a -> a -> a) -> LogMessage a -> a
foldl' :: (b -> a -> b) -> b -> LogMessage a -> b
$cfoldl' :: forall b a. (b -> a -> b) -> b -> LogMessage a -> b
foldl :: (b -> a -> b) -> b -> LogMessage a -> b
$cfoldl :: forall b a. (b -> a -> b) -> b -> LogMessage a -> b
foldr' :: (a -> b -> b) -> b -> LogMessage a -> b
$cfoldr' :: forall a b. (a -> b -> b) -> b -> LogMessage a -> b
foldr :: (a -> b -> b) -> b -> LogMessage a -> b
$cfoldr :: forall a b. (a -> b -> b) -> b -> LogMessage a -> b
foldMap' :: (a -> m) -> LogMessage a -> m
$cfoldMap' :: forall m a. Monoid m => (a -> m) -> LogMessage a -> m
foldMap :: (a -> m) -> LogMessage a -> m
$cfoldMap :: forall m a. Monoid m => (a -> m) -> LogMessage a -> m
fold :: LogMessage m -> m
$cfold :: forall m. Monoid m => LogMessage m -> m
Foldable, Functor LogMessage
Foldable LogMessage
Functor LogMessage
-> Foldable LogMessage
-> (forall (f :: * -> *) a b.
    Applicative f =>
    (a -> f b) -> LogMessage a -> f (LogMessage b))
-> (forall (f :: * -> *) a.
    Applicative f =>
    LogMessage (f a) -> f (LogMessage a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> LogMessage a -> m (LogMessage b))
-> (forall (m :: * -> *) a.
    Monad m =>
    LogMessage (m a) -> m (LogMessage a))
-> Traversable LogMessage
(a -> f b) -> LogMessage a -> f (LogMessage b)
forall (t :: * -> *).
Functor t
-> Foldable t
-> (forall (f :: * -> *) a b.
    Applicative f =>
    (a -> f b) -> t a -> f (t b))
-> (forall (f :: * -> *) a. Applicative f => t (f a) -> f (t a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> t a -> m (t b))
-> (forall (m :: * -> *) a. Monad m => t (m a) -> m (t a))
-> Traversable t
forall (m :: * -> *) a.
Monad m =>
LogMessage (m a) -> m (LogMessage a)
forall (f :: * -> *) a.
Applicative f =>
LogMessage (f a) -> f (LogMessage a)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> LogMessage a -> m (LogMessage b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> LogMessage a -> f (LogMessage b)
sequence :: LogMessage (m a) -> m (LogMessage a)
$csequence :: forall (m :: * -> *) a.
Monad m =>
LogMessage (m a) -> m (LogMessage a)
mapM :: (a -> m b) -> LogMessage a -> m (LogMessage b)
$cmapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> LogMessage a -> m (LogMessage b)
sequenceA :: LogMessage (f a) -> f (LogMessage a)
$csequenceA :: forall (f :: * -> *) a.
Applicative f =>
LogMessage (f a) -> f (LogMessage a)
traverse :: (a -> f b) -> LogMessage a -> f (LogMessage b)
$ctraverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> LogMessage a -> f (LogMessage b)
$cp2Traversable :: Foldable LogMessage
$cp1Traversable :: Functor LogMessage
Traversable, (forall x. LogMessage a -> Rep (LogMessage a) x)
-> (forall x. Rep (LogMessage a) x -> LogMessage a)
-> Generic (LogMessage a)
forall x. Rep (LogMessage a) x -> LogMessage a
forall x. LogMessage a -> Rep (LogMessage a) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall a x. Rep (LogMessage a) x -> LogMessage a
forall a x. LogMessage a -> Rep (LogMessage a) x
$cto :: forall a x. Rep (LogMessage a) x -> LogMessage a
$cfrom :: forall a x. LogMessage a -> Rep (LogMessage a) x
Generic)

makeLenses ''LogMessage

instance NFData a => NFData (LogMessage a)

instance Describe a => Describe (LogMessage a) where
  describeBuilder :: LogMessage a -> Builder
describeBuilder LogMessage a
msg =
    Builder -> (Origin -> Builder) -> Maybe Origin -> Builder
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Builder
"" Origin -> Builder
forall a. Describe a => a -> Builder
describeBuilder (LogMessage a
msg LogMessage a
-> Getting (Maybe Origin) (LogMessage a) (Maybe Origin)
-> Maybe Origin
forall s a. s -> Getting a s a -> a
^. Getting (Maybe Origin) (LogMessage a) (Maybe Origin)
forall a. Lens' (LogMessage a) (Maybe Origin)
lmOrigin) Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<>
    Builder
": " Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> a -> Builder
forall a. Describe a => a -> Builder
describeBuilder (LogMessage a
msg LogMessage a -> Getting a (LogMessage a) a -> a
forall s a. s -> Getting a s a -> a
^. Getting a (LogMessage a) a
forall a a. Lens (LogMessage a) (LogMessage a) a a
lmMsg)

-- | A message at one of the four 'LogLevel's.
data SomeMessage e w
  = MsgError (LogMessage e)
  | MsgWarn (LogMessage w)
  | MsgInfo (LogMessage Text)
  | MsgDebug (LogMessage Text)
  deriving (Int -> SomeMessage e w -> ShowS
[SomeMessage e w] -> ShowS
SomeMessage e w -> String
(Int -> SomeMessage e w -> ShowS)
-> (SomeMessage e w -> String)
-> ([SomeMessage e w] -> ShowS)
-> Show (SomeMessage e w)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall e w. (Show e, Show w) => Int -> SomeMessage e w -> ShowS
forall e w. (Show e, Show w) => [SomeMessage e w] -> ShowS
forall e w. (Show e, Show w) => SomeMessage e w -> String
showList :: [SomeMessage e w] -> ShowS
$cshowList :: forall e w. (Show e, Show w) => [SomeMessage e w] -> ShowS
show :: SomeMessage e w -> String
$cshow :: forall e w. (Show e, Show w) => SomeMessage e w -> String
showsPrec :: Int -> SomeMessage e w -> ShowS
$cshowsPrec :: forall e w. (Show e, Show w) => Int -> SomeMessage e w -> ShowS
Show, SomeMessage e w -> SomeMessage e w -> Bool
(SomeMessage e w -> SomeMessage e w -> Bool)
-> (SomeMessage e w -> SomeMessage e w -> Bool)
-> Eq (SomeMessage e w)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall e w.
(Eq e, Eq w) =>
SomeMessage e w -> SomeMessage e w -> Bool
/= :: SomeMessage e w -> SomeMessage e w -> Bool
$c/= :: forall e w.
(Eq e, Eq w) =>
SomeMessage e w -> SomeMessage e w -> Bool
== :: SomeMessage e w -> SomeMessage e w -> Bool
$c== :: forall e w.
(Eq e, Eq w) =>
SomeMessage e w -> SomeMessage e w -> Bool
Eq, (forall x. SomeMessage e w -> Rep (SomeMessage e w) x)
-> (forall x. Rep (SomeMessage e w) x -> SomeMessage e w)
-> Generic (SomeMessage e w)
forall x. Rep (SomeMessage e w) x -> SomeMessage e w
forall x. SomeMessage e w -> Rep (SomeMessage e w) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall e w x. Rep (SomeMessage e w) x -> SomeMessage e w
forall e w x. SomeMessage e w -> Rep (SomeMessage e w) x
$cto :: forall e w x. Rep (SomeMessage e w) x -> SomeMessage e w
$cfrom :: forall e w x. SomeMessage e w -> Rep (SomeMessage e w) x
Generic)

makePrisms ''SomeMessage

instance (NFData e, NFData w) => NFData (SomeMessage e w)

someMessageOrigin :: Lens' (SomeMessage e w) (Maybe Origin)
someMessageOrigin :: (Maybe Origin -> f (Maybe Origin))
-> SomeMessage e w -> f (SomeMessage e w)
someMessageOrigin =
  (SomeMessage e w -> Maybe Origin)
-> (SomeMessage e w -> Maybe Origin -> SomeMessage e w)
-> Lens
     (SomeMessage e w) (SomeMessage e w) (Maybe Origin) (Maybe Origin)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens
  (Getting (First Origin) (SomeMessage e w) Origin
-> SomeMessage e w -> Maybe Origin
forall s (m :: * -> *) a.
MonadReader s m =>
Getting (First a) s a -> m (Maybe a)
preview (Getting (First Origin) (SomeMessage e w) Origin
 -> SomeMessage e w -> Maybe Origin)
-> Getting (First Origin) (SomeMessage e w) Origin
-> SomeMessage e w
-> Maybe Origin
forall a b. (a -> b) -> a -> b
$
    ((LogMessage e
 -> BazaarT
      (->)
      (BazaarT
         (->)
         (BazaarT (->) (Const (First Origin)) (Maybe Origin) (Maybe Origin))
         (Maybe Origin)
         (Maybe Origin))
      (Maybe Origin)
      (Maybe Origin)
      (LogMessage e))
-> SomeMessage e w
-> BazaarT
     (->)
     (BazaarT
        (->)
        (BazaarT (->) (Const (First Origin)) (Maybe Origin) (Maybe Origin))
        (Maybe Origin)
        (Maybe Origin))
     (Maybe Origin)
     (Maybe Origin)
     (SomeMessage e w)
forall e w e.
Prism
  (SomeMessage e w) (SomeMessage e w) (LogMessage e) (LogMessage e)
_MsgError ((LogMessage e
  -> BazaarT
       (->)
       (BazaarT
          (->)
          (BazaarT (->) (Const (First Origin)) (Maybe Origin) (Maybe Origin))
          (Maybe Origin)
          (Maybe Origin))
       (Maybe Origin)
       (Maybe Origin)
       (LogMessage e))
 -> SomeMessage e w
 -> BazaarT
      (->)
      (BazaarT
         (->)
         (BazaarT (->) (Const (First Origin)) (Maybe Origin) (Maybe Origin))
         (Maybe Origin)
         (Maybe Origin))
      (Maybe Origin)
      (Maybe Origin)
      (SomeMessage e w))
-> ((Maybe Origin
     -> BazaarT
          (->)
          (BazaarT
             (->)
             (BazaarT (->) (Const (First Origin)) (Maybe Origin) (Maybe Origin))
             (Maybe Origin)
             (Maybe Origin))
          (Maybe Origin)
          (Maybe Origin)
          (Maybe Origin))
    -> LogMessage e
    -> BazaarT
         (->)
         (BazaarT
            (->)
            (BazaarT (->) (Const (First Origin)) (Maybe Origin) (Maybe Origin))
            (Maybe Origin)
            (Maybe Origin))
         (Maybe Origin)
         (Maybe Origin)
         (LogMessage e))
-> (Maybe Origin
    -> BazaarT
         (->)
         (BazaarT
            (->)
            (BazaarT (->) (Const (First Origin)) (Maybe Origin) (Maybe Origin))
            (Maybe Origin)
            (Maybe Origin))
         (Maybe Origin)
         (Maybe Origin)
         (Maybe Origin))
-> SomeMessage e w
-> BazaarT
     (->)
     (BazaarT
        (->)
        (BazaarT (->) (Const (First Origin)) (Maybe Origin) (Maybe Origin))
        (Maybe Origin)
        (Maybe Origin))
     (Maybe Origin)
     (Maybe Origin)
     (SomeMessage e w)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Maybe Origin
 -> BazaarT
      (->)
      (BazaarT
         (->)
         (BazaarT (->) (Const (First Origin)) (Maybe Origin) (Maybe Origin))
         (Maybe Origin)
         (Maybe Origin))
      (Maybe Origin)
      (Maybe Origin)
      (Maybe Origin))
-> LogMessage e
-> BazaarT
     (->)
     (BazaarT
        (->)
        (BazaarT (->) (Const (First Origin)) (Maybe Origin) (Maybe Origin))
        (Maybe Origin)
        (Maybe Origin))
     (Maybe Origin)
     (Maybe Origin)
     (LogMessage e)
forall a. Lens' (LogMessage a) (Maybe Origin)
lmOrigin ((Maybe Origin
  -> BazaarT
       (->)
       (BazaarT
          (->)
          (BazaarT (->) (Const (First Origin)) (Maybe Origin) (Maybe Origin))
          (Maybe Origin)
          (Maybe Origin))
       (Maybe Origin)
       (Maybe Origin)
       (Maybe Origin))
 -> SomeMessage e w
 -> BazaarT
      (->)
      (BazaarT
         (->)
         (BazaarT (->) (Const (First Origin)) (Maybe Origin) (Maybe Origin))
         (Maybe Origin)
         (Maybe Origin))
      (Maybe Origin)
      (Maybe Origin)
      (SomeMessage e w))
-> Over
     (->)
     (BazaarT
        (->)
        (BazaarT (->) (Const (First Origin)) (Maybe Origin) (Maybe Origin))
        (Maybe Origin)
        (Maybe Origin))
     (SomeMessage e w)
     (SomeMessage e w)
     (Maybe Origin)
     (Maybe Origin)
-> Over
     (->)
     (BazaarT
        (->)
        (BazaarT (->) (Const (First Origin)) (Maybe Origin) (Maybe Origin))
        (Maybe Origin)
        (Maybe Origin))
     (SomeMessage e w)
     (SomeMessage e w)
     (Maybe Origin)
     (Maybe Origin)
forall (p :: * -> * -> *) (f :: * -> *) s t a b.
(Conjoined p, Applicative f) =>
Traversing p f s t a b -> Over p f s t a b -> Over p f s t a b
`failing`
     (LogMessage w
 -> BazaarT
      (->)
      (BazaarT (->) (Const (First Origin)) (Maybe Origin) (Maybe Origin))
      (Maybe Origin)
      (Maybe Origin)
      (LogMessage w))
-> SomeMessage e w
-> BazaarT
     (->)
     (BazaarT (->) (Const (First Origin)) (Maybe Origin) (Maybe Origin))
     (Maybe Origin)
     (Maybe Origin)
     (SomeMessage e w)
forall e w w.
Prism
  (SomeMessage e w) (SomeMessage e w) (LogMessage w) (LogMessage w)
_MsgWarn  ((LogMessage w
  -> BazaarT
       (->)
       (BazaarT (->) (Const (First Origin)) (Maybe Origin) (Maybe Origin))
       (Maybe Origin)
       (Maybe Origin)
       (LogMessage w))
 -> SomeMessage e w
 -> BazaarT
      (->)
      (BazaarT (->) (Const (First Origin)) (Maybe Origin) (Maybe Origin))
      (Maybe Origin)
      (Maybe Origin)
      (SomeMessage e w))
-> ((Maybe Origin
     -> BazaarT
          (->)
          (BazaarT (->) (Const (First Origin)) (Maybe Origin) (Maybe Origin))
          (Maybe Origin)
          (Maybe Origin)
          (Maybe Origin))
    -> LogMessage w
    -> BazaarT
         (->)
         (BazaarT (->) (Const (First Origin)) (Maybe Origin) (Maybe Origin))
         (Maybe Origin)
         (Maybe Origin)
         (LogMessage w))
-> Over
     (->)
     (BazaarT
        (->)
        (BazaarT (->) (Const (First Origin)) (Maybe Origin) (Maybe Origin))
        (Maybe Origin)
        (Maybe Origin))
     (SomeMessage e w)
     (SomeMessage e w)
     (Maybe Origin)
     (Maybe Origin)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Maybe Origin
 -> BazaarT
      (->)
      (BazaarT (->) (Const (First Origin)) (Maybe Origin) (Maybe Origin))
      (Maybe Origin)
      (Maybe Origin)
      (Maybe Origin))
-> LogMessage w
-> BazaarT
     (->)
     (BazaarT (->) (Const (First Origin)) (Maybe Origin) (Maybe Origin))
     (Maybe Origin)
     (Maybe Origin)
     (LogMessage w)
forall a. Lens' (LogMessage a) (Maybe Origin)
lmOrigin Over
  (->)
  (BazaarT
     (->)
     (BazaarT (->) (Const (First Origin)) (Maybe Origin) (Maybe Origin))
     (Maybe Origin)
     (Maybe Origin))
  (SomeMessage e w)
  (SomeMessage e w)
  (Maybe Origin)
  (Maybe Origin)
-> Over
     (->)
     (BazaarT (->) (Const (First Origin)) (Maybe Origin) (Maybe Origin))
     (SomeMessage e w)
     (SomeMessage e w)
     (Maybe Origin)
     (Maybe Origin)
-> Over
     (->)
     (BazaarT (->) (Const (First Origin)) (Maybe Origin) (Maybe Origin))
     (SomeMessage e w)
     (SomeMessage e w)
     (Maybe Origin)
     (Maybe Origin)
forall (p :: * -> * -> *) (f :: * -> *) s t a b.
(Conjoined p, Applicative f) =>
Traversing p f s t a b -> Over p f s t a b -> Over p f s t a b
`failing`
     (LogMessage Text
 -> BazaarT
      (->)
      (Const (First Origin))
      (Maybe Origin)
      (Maybe Origin)
      (LogMessage Text))
-> SomeMessage e w
-> BazaarT
     (->)
     (Const (First Origin))
     (Maybe Origin)
     (Maybe Origin)
     (SomeMessage e w)
forall e w. Prism' (SomeMessage e w) (LogMessage Text)
_MsgInfo  ((LogMessage Text
  -> BazaarT
       (->)
       (Const (First Origin))
       (Maybe Origin)
       (Maybe Origin)
       (LogMessage Text))
 -> SomeMessage e w
 -> BazaarT
      (->)
      (Const (First Origin))
      (Maybe Origin)
      (Maybe Origin)
      (SomeMessage e w))
-> ((Maybe Origin
     -> BazaarT
          (->)
          (Const (First Origin))
          (Maybe Origin)
          (Maybe Origin)
          (Maybe Origin))
    -> LogMessage Text
    -> BazaarT
         (->)
         (Const (First Origin))
         (Maybe Origin)
         (Maybe Origin)
         (LogMessage Text))
-> Over
     (->)
     (BazaarT (->) (Const (First Origin)) (Maybe Origin) (Maybe Origin))
     (SomeMessage e w)
     (SomeMessage e w)
     (Maybe Origin)
     (Maybe Origin)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Maybe Origin
 -> BazaarT
      (->)
      (Const (First Origin))
      (Maybe Origin)
      (Maybe Origin)
      (Maybe Origin))
-> LogMessage Text
-> BazaarT
     (->)
     (Const (First Origin))
     (Maybe Origin)
     (Maybe Origin)
     (LogMessage Text)
forall a. Lens' (LogMessage a) (Maybe Origin)
lmOrigin Over
  (->)
  (BazaarT (->) (Const (First Origin)) (Maybe Origin) (Maybe Origin))
  (SomeMessage e w)
  (SomeMessage e w)
  (Maybe Origin)
  (Maybe Origin)
-> Over
     (->)
     (Const (First Origin))
     (SomeMessage e w)
     (SomeMessage e w)
     (Maybe Origin)
     (Maybe Origin)
-> Over
     (->)
     (Const (First Origin))
     (SomeMessage e w)
     (SomeMessage e w)
     (Maybe Origin)
     (Maybe Origin)
forall (p :: * -> * -> *) (f :: * -> *) s t a b.
(Conjoined p, Applicative f) =>
Traversing p f s t a b -> Over p f s t a b -> Over p f s t a b
`failing`
     (LogMessage Text -> Const (First Origin) (LogMessage Text))
-> SomeMessage e w -> Const (First Origin) (SomeMessage e w)
forall e w. Prism' (SomeMessage e w) (LogMessage Text)
_MsgDebug ((LogMessage Text -> Const (First Origin) (LogMessage Text))
 -> SomeMessage e w -> Const (First Origin) (SomeMessage e w))
-> ((Maybe Origin -> Const (First Origin) (Maybe Origin))
    -> LogMessage Text -> Const (First Origin) (LogMessage Text))
-> Over
     (->)
     (Const (First Origin))
     (SomeMessage e w)
     (SomeMessage e w)
     (Maybe Origin)
     (Maybe Origin)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Maybe Origin -> Const (First Origin) (Maybe Origin))
-> LogMessage Text -> Const (First Origin) (LogMessage Text)
forall a. Lens' (LogMessage a) (Maybe Origin)
lmOrigin
    ) Over
  (->)
  (Const (First Origin))
  (SomeMessage e w)
  (SomeMessage e w)
  (Maybe Origin)
  (Maybe Origin)
-> ((Origin -> Const (First Origin) Origin)
    -> Maybe Origin -> Const (First Origin) (Maybe Origin))
-> Getting (First Origin) (SomeMessage e w) Origin
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Origin -> Const (First Origin) Origin)
-> Maybe Origin -> Const (First Origin) (Maybe Origin)
forall a b. Prism (Maybe a) (Maybe b) a b
_Just)
  ((Maybe Origin -> SomeMessage e w -> SomeMessage e w)
-> SomeMessage e w -> Maybe Origin -> SomeMessage e w
forall a b c. (a -> b -> c) -> b -> a -> c
flip ((Maybe Origin -> SomeMessage e w -> SomeMessage e w)
 -> SomeMessage e w -> Maybe Origin -> SomeMessage e w)
-> (Maybe Origin -> SomeMessage e w -> SomeMessage e w)
-> SomeMessage e w
-> Maybe Origin
-> SomeMessage e w
forall a b. (a -> b) -> a -> b
$ \Maybe Origin
o ->
   ASetter
  (SomeMessage e w) (SomeMessage e w) (Maybe Origin) (Maybe Origin)
-> Maybe Origin -> SomeMessage e w -> SomeMessage e w
forall s t a b. ASetter s t a b -> b -> s -> t
set ((LogMessage e -> Identity (LogMessage e))
-> SomeMessage e w -> Identity (SomeMessage e w)
forall e w e.
Prism
  (SomeMessage e w) (SomeMessage e w) (LogMessage e) (LogMessage e)
_MsgError ((LogMessage e -> Identity (LogMessage e))
 -> SomeMessage e w -> Identity (SomeMessage e w))
-> ((Maybe Origin -> Identity (Maybe Origin))
    -> LogMessage e -> Identity (LogMessage e))
-> ASetter
     (SomeMessage e w) (SomeMessage e w) (Maybe Origin) (Maybe Origin)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Maybe Origin -> Identity (Maybe Origin))
-> LogMessage e -> Identity (LogMessage e)
forall a. Lens' (LogMessage a) (Maybe Origin)
lmOrigin) Maybe Origin
o (SomeMessage e w -> SomeMessage e w)
-> (SomeMessage e w -> SomeMessage e w)
-> SomeMessage e w
-> SomeMessage e w
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
   ASetter
  (SomeMessage e w) (SomeMessage e w) (Maybe Origin) (Maybe Origin)
-> Maybe Origin -> SomeMessage e w -> SomeMessage e w
forall s t a b. ASetter s t a b -> b -> s -> t
set ((LogMessage w -> Identity (LogMessage w))
-> SomeMessage e w -> Identity (SomeMessage e w)
forall e w w.
Prism
  (SomeMessage e w) (SomeMessage e w) (LogMessage w) (LogMessage w)
_MsgWarn  ((LogMessage w -> Identity (LogMessage w))
 -> SomeMessage e w -> Identity (SomeMessage e w))
-> ((Maybe Origin -> Identity (Maybe Origin))
    -> LogMessage w -> Identity (LogMessage w))
-> ASetter
     (SomeMessage e w) (SomeMessage e w) (Maybe Origin) (Maybe Origin)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Maybe Origin -> Identity (Maybe Origin))
-> LogMessage w -> Identity (LogMessage w)
forall a. Lens' (LogMessage a) (Maybe Origin)
lmOrigin) Maybe Origin
o (SomeMessage e w -> SomeMessage e w)
-> (SomeMessage e w -> SomeMessage e w)
-> SomeMessage e w
-> SomeMessage e w
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
   ASetter
  (SomeMessage e w) (SomeMessage e w) (Maybe Origin) (Maybe Origin)
-> Maybe Origin -> SomeMessage e w -> SomeMessage e w
forall s t a b. ASetter s t a b -> b -> s -> t
set ((LogMessage Text -> Identity (LogMessage Text))
-> SomeMessage e w -> Identity (SomeMessage e w)
forall e w. Prism' (SomeMessage e w) (LogMessage Text)
_MsgInfo  ((LogMessage Text -> Identity (LogMessage Text))
 -> SomeMessage e w -> Identity (SomeMessage e w))
-> ((Maybe Origin -> Identity (Maybe Origin))
    -> LogMessage Text -> Identity (LogMessage Text))
-> ASetter
     (SomeMessage e w) (SomeMessage e w) (Maybe Origin) (Maybe Origin)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Maybe Origin -> Identity (Maybe Origin))
-> LogMessage Text -> Identity (LogMessage Text)
forall a. Lens' (LogMessage a) (Maybe Origin)
lmOrigin) Maybe Origin
o (SomeMessage e w -> SomeMessage e w)
-> (SomeMessage e w -> SomeMessage e w)
-> SomeMessage e w
-> SomeMessage e w
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
   ASetter
  (SomeMessage e w) (SomeMessage e w) (Maybe Origin) (Maybe Origin)
-> Maybe Origin -> SomeMessage e w -> SomeMessage e w
forall s t a b. ASetter s t a b -> b -> s -> t
set ((LogMessage Text -> Identity (LogMessage Text))
-> SomeMessage e w -> Identity (SomeMessage e w)
forall e w. Prism' (SomeMessage e w) (LogMessage Text)
_MsgDebug ((LogMessage Text -> Identity (LogMessage Text))
 -> SomeMessage e w -> Identity (SomeMessage e w))
-> ((Maybe Origin -> Identity (Maybe Origin))
    -> LogMessage Text -> Identity (LogMessage Text))
-> ASetter
     (SomeMessage e w) (SomeMessage e w) (Maybe Origin) (Maybe Origin)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Maybe Origin -> Identity (Maybe Origin))
-> LogMessage Text -> Identity (LogMessage Text)
forall a. Lens' (LogMessage a) (Maybe Origin)
lmOrigin) Maybe Origin
o)


instance (Describe e, Describe w) => Describe (SomeMessage e w) where
  describeBuilder :: SomeMessage e w -> Builder
describeBuilder SomeMessage e w
msg = case SomeMessage e w
msg of
    MsgError LogMessage e
m -> Builder
"ERROR: " Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> LogMessage e -> Builder
forall a. Describe a => a -> Builder
describeBuilder LogMessage e
m
    MsgWarn  LogMessage w
m -> Builder
"WARN: "  Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> LogMessage w -> Builder
forall a. Describe a => a -> Builder
describeBuilder LogMessage w
m
    MsgInfo  LogMessage Text
m -> Builder
"INFO: "  Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> LogMessage Text -> Builder
forall a. Describe a => a -> Builder
describeBuilder LogMessage Text
m
    MsgDebug LogMessage Text
m -> Builder
"DEBUG: " Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> LogMessage Text -> Builder
forall a. Describe a => a -> Builder
describeBuilder LogMessage Text
m

--------------------------------------------------------------------------------
--  'MonadLogger' class
--------------------------------------------------------------------------------

-- | Make an origin at the source span of a piece of Fortran syntax, in the
-- current file.
atSpanned :: (MonadLogger e w m, F.Spanned a) => a -> m Origin
atSpanned :: a -> m Origin
atSpanned a
astElem = do
  String
sf <- m String
forall e w (m :: * -> *). MonadLogger e w m => m String
getDefaultSourceFile
  let sp :: SrcSpan
sp = a -> SrcSpan
forall a. Spanned a => a -> SrcSpan
F.getSpan a
astElem
  Origin -> m Origin
forall (m :: * -> *) a. Monad m => a -> m a
return (Origin -> m Origin) -> Origin -> m Origin
forall a b. (a -> b) -> a -> b
$ String -> SrcSpan -> Origin
Origin String
sf SrcSpan
sp

-- | Make an origin at the source span of a piece of Fortran syntax, in the given
-- file.
atSpannedInFile :: (F.Spanned a) => FilePath -> a -> Origin
atSpannedInFile :: String -> a -> Origin
atSpannedInFile String
sf = String -> SrcSpan -> Origin
Origin String
sf (SrcSpan -> Origin) -> (a -> SrcSpan) -> a -> Origin
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> SrcSpan
forall a. Spanned a => a -> SrcSpan
F.getSpan

-- | MTL-style type class for monads that support logging.
class Monad m => MonadLogger e w m | m -> e w where
  -- | Set the default source file, i.e. the file in which messages originate by
  -- default.
  setDefaultSourceFile :: FilePath -> m ()

  -- | Get the current default source file, i.e. the file in which messages
  -- originate by default.
  getDefaultSourceFile :: m FilePath

  -- | Record a log message. Output it based on the 'LogOutput' function used
  -- and store it in the collected logs.
  recordLogMessage :: SomeMessage e w -> m ()

  -- | Log an error message at the given 'Origin'.
  logError :: Origin -> e -> m ()
  logError = (LogMessage e -> SomeMessage e w) -> Origin -> e -> m ()
forall e w (m :: * -> *) a.
MonadLogger e w m =>
(LogMessage a -> SomeMessage e w) -> Origin -> a -> m ()
logGeneral LogMessage e -> SomeMessage e w
forall e w. LogMessage e -> SomeMessage e w
MsgError

  -- | Log an error message. The origin is the current default source file, with
  -- the source span of the given piece of Fortran syntax.
  logError' :: (F.Spanned a) => a -> e -> m ()
  logError' = (Origin -> e -> m ()) -> a -> e -> m ()
forall e w (m :: * -> *) a b c.
(MonadLogger e w m, Spanned a) =>
(Origin -> b -> m c) -> a -> b -> m c
withSpannedOrigin Origin -> e -> m ()
forall e w (m :: * -> *). MonadLogger e w m => Origin -> e -> m ()
logError


  -- | Log a warning message at the given 'Origin'.
  logWarn :: Origin -> w -> m ()
  logWarn = (LogMessage w -> SomeMessage e w) -> Origin -> w -> m ()
forall e w (m :: * -> *) a.
MonadLogger e w m =>
(LogMessage a -> SomeMessage e w) -> Origin -> a -> m ()
logGeneral LogMessage w -> SomeMessage e w
forall e w. LogMessage w -> SomeMessage e w
MsgWarn

  -- | Log a warning message. The origin is the current default source file, with
  -- the source span of the given piece of Fortran syntax.
  logWarn' :: (F.Spanned a) => a -> w -> m ()
  logWarn' = (Origin -> w -> m ()) -> a -> w -> m ()
forall e w (m :: * -> *) a b c.
(MonadLogger e w m, Spanned a) =>
(Origin -> b -> m c) -> a -> b -> m c
withSpannedOrigin Origin -> w -> m ()
forall e w (m :: * -> *). MonadLogger e w m => Origin -> w -> m ()
logWarn


  -- | Log an information message at the given 'Origin'.
  logInfo :: Origin -> Text -> m ()
  logInfo = (LogMessage Text -> SomeMessage e w) -> Origin -> Text -> m ()
forall e w (m :: * -> *) a.
MonadLogger e w m =>
(LogMessage a -> SomeMessage e w) -> Origin -> a -> m ()
logGeneral LogMessage Text -> SomeMessage e w
forall e w. LogMessage Text -> SomeMessage e w
MsgInfo

  -- | Log an information message. The origin is the current default source
  -- file, with the source span of the given piece of Fortran syntax.
  logInfo' :: (F.Spanned a) => a -> Text -> m ()
  logInfo' = (Origin -> Text -> m ()) -> a -> Text -> m ()
forall e w (m :: * -> *) a b c.
(MonadLogger e w m, Spanned a) =>
(Origin -> b -> m c) -> a -> b -> m c
withSpannedOrigin Origin -> Text -> m ()
forall e w (m :: * -> *).
MonadLogger e w m =>
Origin -> Text -> m ()
logInfo

  -- | Log an information message with no origin. For example, use this when
  -- printing output about the progress of an analysis which cannot be
  -- associated with a particular bit of source code.
  logInfoNoOrigin :: Text -> m ()
  logInfoNoOrigin Text
msg = SomeMessage e w -> m ()
forall e w (m :: * -> *).
MonadLogger e w m =>
SomeMessage e w -> m ()
recordLogMessage (LogMessage Text -> SomeMessage e w
forall e w. LogMessage Text -> SomeMessage e w
MsgInfo (Maybe Origin -> Text -> LogMessage Text
forall a. Maybe Origin -> a -> LogMessage a
LogMessage Maybe Origin
forall a. Maybe a
Nothing Text
msg))


  -- | Log a debugging message at the given 'Origin'.
  logDebug :: Origin -> Text -> m ()
  logDebug = (LogMessage Text -> SomeMessage e w) -> Origin -> Text -> m ()
forall e w (m :: * -> *) a.
MonadLogger e w m =>
(LogMessage a -> SomeMessage e w) -> Origin -> a -> m ()
logGeneral LogMessage Text -> SomeMessage e w
forall e w. LogMessage Text -> SomeMessage e w
MsgDebug

  -- | Log a debugging message. The origin is the current default source
  -- file, with the source span of the given piece of Fortran syntax.
  logDebug' :: (F.Spanned a) => a -> Text -> m ()
  logDebug' = (Origin -> Text -> m ()) -> a -> Text -> m ()
forall e w (m :: * -> *) a b c.
(MonadLogger e w m, Spanned a) =>
(Origin -> b -> m c) -> a -> b -> m c
withSpannedOrigin Origin -> Text -> m ()
forall e w (m :: * -> *).
MonadLogger e w m =>
Origin -> Text -> m ()
logDebug

  default recordLogMessage
    :: (MonadTrans t, MonadLogger e w m', m ~ t m') => SomeMessage e w -> m ()
  default setDefaultSourceFile
    :: (MonadTrans t, MonadLogger e w m', m ~ t m') => FilePath -> m ()
  default getDefaultSourceFile
    :: (MonadTrans t, MonadLogger e w m', m ~ t m') => m FilePath

  recordLogMessage = m' () -> t m' ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m' () -> t m' ())
-> (SomeMessage e w -> m' ()) -> SomeMessage e w -> t m' ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SomeMessage e w -> m' ()
forall e w (m :: * -> *).
MonadLogger e w m =>
SomeMessage e w -> m ()
recordLogMessage
  setDefaultSourceFile = m' () -> t m' ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m' () -> t m' ()) -> (String -> m' ()) -> String -> t m' ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> m' ()
forall e w (m :: * -> *). MonadLogger e w m => String -> m ()
setDefaultSourceFile
  getDefaultSourceFile = m' String -> t m' String
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m' String
forall e w (m :: * -> *). MonadLogger e w m => m String
getDefaultSourceFile

logGeneral :: (MonadLogger e w m) => (LogMessage a -> SomeMessage e w) -> Origin -> a -> m ()
logGeneral :: (LogMessage a -> SomeMessage e w) -> Origin -> a -> m ()
logGeneral LogMessage a -> SomeMessage e w
mkMsg Origin
origin a
msg =
  SomeMessage e w -> m ()
forall e w (m :: * -> *).
MonadLogger e w m =>
SomeMessage e w -> m ()
recordLogMessage (LogMessage a -> SomeMessage e w
mkMsg (Maybe Origin -> a -> LogMessage a
forall a. Maybe Origin -> a -> LogMessage a
LogMessage (Origin -> Maybe Origin
forall a. a -> Maybe a
Just Origin
origin) a
msg))

withSpannedOrigin
  :: (MonadLogger e w m, F.Spanned a)
  => (Origin -> b -> m c) -> a -> b -> m c
withSpannedOrigin :: (Origin -> b -> m c) -> a -> b -> m c
withSpannedOrigin Origin -> b -> m c
f a
x b
m = do
  Origin
origin <- a -> m Origin
forall e w (m :: * -> *) a.
(MonadLogger e w m, Spanned a) =>
a -> m Origin
atSpanned a
x
  Origin -> b -> m c
f Origin
origin b
m

instance MonadLogger e w m => MonadLogger e w (ReaderT r m)
instance MonadLogger e w m => MonadLogger e w (ExceptT e' m)
instance MonadLogger e w m => MonadLogger e w (StateT s m)
instance (MonadLogger e w m, Monoid w') => MonadLogger e w (WriterT w' m)
instance MonadLogger e w m => MonadLogger e w (Lazy.StateT s m)
-- instance (MonadLogger e w m, Monoid w') => MonadLogger e w (Lazy.WriterT w' m)
instance (MonadLogger e w m, Monoid w') => MonadLogger e w (RWST r w' s m)
-- instance (MonadLogger e w m, Monoid w') => MonadLogger e w (Lazy.RWST r w' s m)

--------------------------------------------------------------------------------
--  'LoggerT' monad
--------------------------------------------------------------------------------

data LoggerState =
  LoggerState
  { LoggerState -> LogLevel
_lsLogLevel          :: !LogLevel
  , LoggerState -> String
_lsDefaultSourceFile :: !FilePath
  , LoggerState -> Maybe Origin
_lsPreviousOrigin    :: !(Maybe Origin)
  }

data OpMonoid a = OpMonoid { OpMonoid a -> a
getOpMonoid :: a }

makeWrapped ''OpMonoid

instance SG.Semigroup a => SG.Semigroup (OpMonoid a) where
  OpMonoid a
x <> :: OpMonoid a -> OpMonoid a -> OpMonoid a
<> OpMonoid a
y = a -> OpMonoid a
forall a. a -> OpMonoid a
OpMonoid (a
y a -> a -> a
forall a. Semigroup a => a -> a -> a
SG.<> a
x)

instance (SG.Semigroup a, Monoid a) => Monoid (OpMonoid a) where
  mempty :: OpMonoid a
mempty = a -> OpMonoid a
forall a. a -> OpMonoid a
OpMonoid a
forall a. Monoid a => a
mempty
  mappend :: OpMonoid a -> OpMonoid a -> OpMonoid a
mappend = OpMonoid a -> OpMonoid a -> OpMonoid a
forall a. Semigroup a => a -> a -> a
(SG.<>)

data LoggerEnv m =
  LoggerEnv
  { LoggerEnv m -> Bool -> LogLevel -> LogLevel -> Text -> Text -> m ()
_leLogFunc :: !(Bool -> LogLevel -> LogLevel -> Text -> Text -> m ())
  }

makeLenses ''LoggerState
makeLenses ''LoggerEnv

hoistEnv :: (m () -> n ()) -> LoggerEnv m -> LoggerEnv n
hoistEnv :: (m () -> n ()) -> LoggerEnv m -> LoggerEnv n
hoistEnv m () -> n ()
f = ((Bool -> LogLevel -> LogLevel -> Text -> Text -> m ())
 -> Identity (Bool -> LogLevel -> LogLevel -> Text -> Text -> n ()))
-> LoggerEnv m -> Identity (LoggerEnv n)
forall (m :: * -> *) (m :: * -> *).
Iso
  (LoggerEnv m)
  (LoggerEnv m)
  (Bool -> LogLevel -> LogLevel -> Text -> Text -> m ())
  (Bool -> LogLevel -> LogLevel -> Text -> Text -> m ())
leLogFunc (((Bool -> LogLevel -> LogLevel -> Text -> Text -> m ())
  -> Identity (Bool -> LogLevel -> LogLevel -> Text -> Text -> n ()))
 -> LoggerEnv m -> Identity (LoggerEnv n))
-> ((Bool -> LogLevel -> LogLevel -> Text -> Text -> m ())
    -> Bool -> LogLevel -> LogLevel -> Text -> Text -> n ())
-> LoggerEnv m
-> LoggerEnv n
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ \Bool -> LogLevel -> LogLevel -> Text -> Text -> m ()
logFunc Bool
b LogLevel
l1 LogLevel
l2 Text
m1 Text
m2 -> m () -> n ()
f (m () -> n ()) -> m () -> n ()
forall a b. (a -> b) -> a -> b
$ Bool -> LogLevel -> LogLevel -> Text -> Text -> m ()
logFunc Bool
b LogLevel
l1 LogLevel
l2 Text
m1 Text
m2

-- | The logging monad transformer, containing errors of type @e@ and warnings
-- of type @w@.
newtype LoggerT e w m a =
  LoggerT (RWST (LoggerEnv m) (OpMonoid [SomeMessage e w]) LoggerState m a)
  deriving
    ( a -> LoggerT e w m b -> LoggerT e w m a
(a -> b) -> LoggerT e w m a -> LoggerT e w m b
(forall a b. (a -> b) -> LoggerT e w m a -> LoggerT e w m b)
-> (forall a b. a -> LoggerT e w m b -> LoggerT e w m a)
-> Functor (LoggerT e w m)
forall a b. a -> LoggerT e w m b -> LoggerT e w m a
forall a b. (a -> b) -> LoggerT e w m a -> LoggerT e w m b
forall e w (m :: * -> *) a b.
Functor m =>
a -> LoggerT e w m b -> LoggerT e w m a
forall e w (m :: * -> *) a b.
Functor m =>
(a -> b) -> LoggerT e w m a -> LoggerT e w m b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> LoggerT e w m b -> LoggerT e w m a
$c<$ :: forall e w (m :: * -> *) a b.
Functor m =>
a -> LoggerT e w m b -> LoggerT e w m a
fmap :: (a -> b) -> LoggerT e w m a -> LoggerT e w m b
$cfmap :: forall e w (m :: * -> *) a b.
Functor m =>
(a -> b) -> LoggerT e w m a -> LoggerT e w m b
Functor
    , Functor (LoggerT e w m)
a -> LoggerT e w m a
Functor (LoggerT e w m)
-> (forall a. a -> LoggerT e w m a)
-> (forall a b.
    LoggerT e w m (a -> b) -> LoggerT e w m a -> LoggerT e w m b)
-> (forall a b c.
    (a -> b -> c)
    -> LoggerT e w m a -> LoggerT e w m b -> LoggerT e w m c)
-> (forall a b.
    LoggerT e w m a -> LoggerT e w m b -> LoggerT e w m b)
-> (forall a b.
    LoggerT e w m a -> LoggerT e w m b -> LoggerT e w m a)
-> Applicative (LoggerT e w m)
LoggerT e w m a -> LoggerT e w m b -> LoggerT e w m b
LoggerT e w m a -> LoggerT e w m b -> LoggerT e w m a
LoggerT e w m (a -> b) -> LoggerT e w m a -> LoggerT e w m b
(a -> b -> c)
-> LoggerT e w m a -> LoggerT e w m b -> LoggerT e w m c
forall a. a -> LoggerT e w m a
forall a b. LoggerT e w m a -> LoggerT e w m b -> LoggerT e w m a
forall a b. LoggerT e w m a -> LoggerT e w m b -> LoggerT e w m b
forall a b.
LoggerT e w m (a -> b) -> LoggerT e w m a -> LoggerT e w m b
forall a b c.
(a -> b -> c)
-> LoggerT e w m a -> LoggerT e w m b -> LoggerT e w m c
forall e w (m :: * -> *). Monad m => Functor (LoggerT e w m)
forall e w (m :: * -> *) a. Monad m => a -> LoggerT e w m a
forall e w (m :: * -> *) a b.
Monad m =>
LoggerT e w m a -> LoggerT e w m b -> LoggerT e w m a
forall e w (m :: * -> *) a b.
Monad m =>
LoggerT e w m a -> LoggerT e w m b -> LoggerT e w m b
forall e w (m :: * -> *) a b.
Monad m =>
LoggerT e w m (a -> b) -> LoggerT e w m a -> LoggerT e w m b
forall e w (m :: * -> *) a b c.
Monad m =>
(a -> b -> c)
-> LoggerT e w m a -> LoggerT e w m b -> LoggerT e w m c
forall (f :: * -> *).
Functor f
-> (forall a. a -> f a)
-> (forall a b. f (a -> b) -> f a -> f b)
-> (forall a b c. (a -> b -> c) -> f a -> f b -> f c)
-> (forall a b. f a -> f b -> f b)
-> (forall a b. f a -> f b -> f a)
-> Applicative f
<* :: LoggerT e w m a -> LoggerT e w m b -> LoggerT e w m a
$c<* :: forall e w (m :: * -> *) a b.
Monad m =>
LoggerT e w m a -> LoggerT e w m b -> LoggerT e w m a
*> :: LoggerT e w m a -> LoggerT e w m b -> LoggerT e w m b
$c*> :: forall e w (m :: * -> *) a b.
Monad m =>
LoggerT e w m a -> LoggerT e w m b -> LoggerT e w m b
liftA2 :: (a -> b -> c)
-> LoggerT e w m a -> LoggerT e w m b -> LoggerT e w m c
$cliftA2 :: forall e w (m :: * -> *) a b c.
Monad m =>
(a -> b -> c)
-> LoggerT e w m a -> LoggerT e w m b -> LoggerT e w m c
<*> :: LoggerT e w m (a -> b) -> LoggerT e w m a -> LoggerT e w m b
$c<*> :: forall e w (m :: * -> *) a b.
Monad m =>
LoggerT e w m (a -> b) -> LoggerT e w m a -> LoggerT e w m b
pure :: a -> LoggerT e w m a
$cpure :: forall e w (m :: * -> *) a. Monad m => a -> LoggerT e w m a
$cp1Applicative :: forall e w (m :: * -> *). Monad m => Functor (LoggerT e w m)
Applicative
    , Applicative (LoggerT e w m)
a -> LoggerT e w m a
Applicative (LoggerT e w m)
-> (forall a b.
    LoggerT e w m a -> (a -> LoggerT e w m b) -> LoggerT e w m b)
-> (forall a b.
    LoggerT e w m a -> LoggerT e w m b -> LoggerT e w m b)
-> (forall a. a -> LoggerT e w m a)
-> Monad (LoggerT e w m)
LoggerT e w m a -> (a -> LoggerT e w m b) -> LoggerT e w m b
LoggerT e w m a -> LoggerT e w m b -> LoggerT e w m b
forall a. a -> LoggerT e w m a
forall a b. LoggerT e w m a -> LoggerT e w m b -> LoggerT e w m b
forall a b.
LoggerT e w m a -> (a -> LoggerT e w m b) -> LoggerT e w m b
forall e w (m :: * -> *). Monad m => Applicative (LoggerT e w m)
forall e w (m :: * -> *) a. Monad m => a -> LoggerT e w m a
forall e w (m :: * -> *) a b.
Monad m =>
LoggerT e w m a -> LoggerT e w m b -> LoggerT e w m b
forall e w (m :: * -> *) a b.
Monad m =>
LoggerT e w m a -> (a -> LoggerT e w m b) -> LoggerT e w m b
forall (m :: * -> *).
Applicative m
-> (forall a b. m a -> (a -> m b) -> m b)
-> (forall a b. m a -> m b -> m b)
-> (forall a. a -> m a)
-> Monad m
return :: a -> LoggerT e w m a
$creturn :: forall e w (m :: * -> *) a. Monad m => a -> LoggerT e w m a
>> :: LoggerT e w m a -> LoggerT e w m b -> LoggerT e w m b
$c>> :: forall e w (m :: * -> *) a b.
Monad m =>
LoggerT e w m a -> LoggerT e w m b -> LoggerT e w m b
>>= :: LoggerT e w m a -> (a -> LoggerT e w m b) -> LoggerT e w m b
$c>>= :: forall e w (m :: * -> *) a b.
Monad m =>
LoggerT e w m a -> (a -> LoggerT e w m b) -> LoggerT e w m b
$cp1Monad :: forall e w (m :: * -> *). Monad m => Applicative (LoggerT e w m)
Monad
    , Monad (LoggerT e w m)
Monad (LoggerT e w m)
-> (forall a. IO a -> LoggerT e w m a) -> MonadIO (LoggerT e w m)
IO a -> LoggerT e w m a
forall a. IO a -> LoggerT e w m a
forall e w (m :: * -> *). MonadIO m => Monad (LoggerT e w m)
forall e w (m :: * -> *) a. MonadIO m => IO a -> LoggerT e w m a
forall (m :: * -> *).
Monad m -> (forall a. IO a -> m a) -> MonadIO m
liftIO :: IO a -> LoggerT e w m a
$cliftIO :: forall e w (m :: * -> *) a. MonadIO m => IO a -> LoggerT e w m a
$cp1MonadIO :: forall e w (m :: * -> *). MonadIO m => Monad (LoggerT e w m)
MonadIO
    , MonadError e'
    , Monad (LoggerT e w m)
Monad (LoggerT e w m)
-> (forall a. String -> LoggerT e w m a)
-> MonadFail (LoggerT e w m)
String -> LoggerT e w m a
forall a. String -> LoggerT e w m a
forall e w (m :: * -> *). MonadFail m => Monad (LoggerT e w m)
forall e w (m :: * -> *) a.
MonadFail m =>
String -> LoggerT e w m a
forall (m :: * -> *).
Monad m -> (forall a. String -> m a) -> MonadFail m
fail :: String -> LoggerT e w m a
$cfail :: forall e w (m :: * -> *) a.
MonadFail m =>
String -> LoggerT e w m a
$cp1MonadFail :: forall e w (m :: * -> *). MonadFail m => Monad (LoggerT e w m)
MonadFail
    )

instance MonadTrans (LoggerT e w) where
  lift :: m a -> LoggerT e w m a
lift = RWST (LoggerEnv m) (OpMonoid [SomeMessage e w]) LoggerState m a
-> LoggerT e w m a
forall e w (m :: * -> *) a.
RWST (LoggerEnv m) (OpMonoid [SomeMessage e w]) LoggerState m a
-> LoggerT e w m a
LoggerT (RWST (LoggerEnv m) (OpMonoid [SomeMessage e w]) LoggerState m a
 -> LoggerT e w m a)
-> (m a
    -> RWST (LoggerEnv m) (OpMonoid [SomeMessage e w]) LoggerState m a)
-> m a
-> LoggerT e w m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. m a
-> RWST (LoggerEnv m) (OpMonoid [SomeMessage e w]) LoggerState m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift

instance (MonadState s m) => MonadState s (LoggerT e w m) where
  get :: LoggerT e w m s
get = m s -> LoggerT e w m s
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m s
forall s (m :: * -> *). MonadState s m => m s
get
  put :: s -> LoggerT e w m ()
put = m () -> LoggerT e w m ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> LoggerT e w m ()) -> (s -> m ()) -> s -> LoggerT e w m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. s -> m ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put
  state :: (s -> (a, s)) -> LoggerT e w m a
state = m a -> LoggerT e w m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m a -> LoggerT e w m a)
-> ((s -> (a, s)) -> m a) -> (s -> (a, s)) -> LoggerT e w m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (s -> (a, s)) -> m a
forall s (m :: * -> *) a. MonadState s m => (s -> (a, s)) -> m a
state

instance (MonadReader r m) => MonadReader r (LoggerT e w m) where
  ask :: LoggerT e w m r
ask = m r -> LoggerT e w m r
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m r
forall r (m :: * -> *). MonadReader r m => m r
ask
  local :: (r -> r) -> LoggerT e w m a -> LoggerT e w m a
local r -> r
f (LoggerT (RWST LoggerEnv m
-> LoggerState -> m (a, LoggerState, OpMonoid [SomeMessage e w])
k)) = RWST (LoggerEnv m) (OpMonoid [SomeMessage e w]) LoggerState m a
-> LoggerT e w m a
forall e w (m :: * -> *) a.
RWST (LoggerEnv m) (OpMonoid [SomeMessage e w]) LoggerState m a
-> LoggerT e w m a
LoggerT (RWST (LoggerEnv m) (OpMonoid [SomeMessage e w]) LoggerState m a
 -> LoggerT e w m a)
-> RWST (LoggerEnv m) (OpMonoid [SomeMessage e w]) LoggerState m a
-> LoggerT e w m a
forall a b. (a -> b) -> a -> b
$ (LoggerEnv m
 -> LoggerState -> m (a, LoggerState, OpMonoid [SomeMessage e w]))
-> RWST (LoggerEnv m) (OpMonoid [SomeMessage e w]) LoggerState m a
forall r w s (m :: * -> *) a.
(r -> s -> m (a, s, w)) -> RWST r w s m a
RWST ((LoggerEnv m
  -> LoggerState -> m (a, LoggerState, OpMonoid [SomeMessage e w]))
 -> RWST (LoggerEnv m) (OpMonoid [SomeMessage e w]) LoggerState m a)
-> (LoggerEnv m
    -> LoggerState -> m (a, LoggerState, OpMonoid [SomeMessage e w]))
-> RWST (LoggerEnv m) (OpMonoid [SomeMessage e w]) LoggerState m a
forall a b. (a -> b) -> a -> b
$ \LoggerEnv m
e -> (r -> r)
-> m (a, LoggerState, OpMonoid [SomeMessage e w])
-> m (a, LoggerState, OpMonoid [SomeMessage e w])
forall r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a
local r -> r
f (m (a, LoggerState, OpMonoid [SomeMessage e w])
 -> m (a, LoggerState, OpMonoid [SomeMessage e w]))
-> (LoggerState -> m (a, LoggerState, OpMonoid [SomeMessage e w]))
-> LoggerState
-> m (a, LoggerState, OpMonoid [SomeMessage e w])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LoggerEnv m
-> LoggerState -> m (a, LoggerState, OpMonoid [SomeMessage e w])
k LoggerEnv m
e

instance (MonadWriter w' m) => MonadWriter w' (LoggerT e w m) where
  tell :: w' -> LoggerT e w m ()
tell = m () -> LoggerT e w m ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> LoggerT e w m ())
-> (w' -> m ()) -> w' -> LoggerT e w m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. w' -> m ()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell

  listen :: LoggerT e w m a -> LoggerT e w m (a, w')
listen (LoggerT (RWST LoggerEnv m
-> LoggerState -> m (a, LoggerState, OpMonoid [SomeMessage e w])
k)) = RWST
  (LoggerEnv m) (OpMonoid [SomeMessage e w]) LoggerState m (a, w')
-> LoggerT e w m (a, w')
forall e w (m :: * -> *) a.
RWST (LoggerEnv m) (OpMonoid [SomeMessage e w]) LoggerState m a
-> LoggerT e w m a
LoggerT (RWST
   (LoggerEnv m) (OpMonoid [SomeMessage e w]) LoggerState m (a, w')
 -> LoggerT e w m (a, w'))
-> RWST
     (LoggerEnv m) (OpMonoid [SomeMessage e w]) LoggerState m (a, w')
-> LoggerT e w m (a, w')
forall a b. (a -> b) -> a -> b
$ (LoggerEnv m
 -> LoggerState
 -> m ((a, w'), LoggerState, OpMonoid [SomeMessage e w]))
-> RWST
     (LoggerEnv m) (OpMonoid [SomeMessage e w]) LoggerState m (a, w')
forall r w s (m :: * -> *) a.
(r -> s -> m (a, s, w)) -> RWST r w s m a
RWST ((LoggerEnv m
  -> LoggerState
  -> m ((a, w'), LoggerState, OpMonoid [SomeMessage e w]))
 -> RWST
      (LoggerEnv m) (OpMonoid [SomeMessage e w]) LoggerState m (a, w'))
-> (LoggerEnv m
    -> LoggerState
    -> m ((a, w'), LoggerState, OpMonoid [SomeMessage e w]))
-> RWST
     (LoggerEnv m) (OpMonoid [SomeMessage e w]) LoggerState m (a, w')
forall a b. (a -> b) -> a -> b
$ \LoggerEnv m
e LoggerState
s -> do
    ((a
x, LoggerState
w, OpMonoid [SomeMessage e w]
s'), w'
w') <- m (a, LoggerState, OpMonoid [SomeMessage e w])
-> m ((a, LoggerState, OpMonoid [SomeMessage e w]), w')
forall w (m :: * -> *) a. MonadWriter w m => m a -> m (a, w)
listen (LoggerEnv m
-> LoggerState -> m (a, LoggerState, OpMonoid [SomeMessage e w])
k LoggerEnv m
e LoggerState
s)
    ((a, w'), LoggerState, OpMonoid [SomeMessage e w])
-> m ((a, w'), LoggerState, OpMonoid [SomeMessage e w])
forall (m :: * -> *) a. Monad m => a -> m a
return ((a
x, w'
w'), LoggerState
w, OpMonoid [SomeMessage e w]
s')

  pass :: LoggerT e w m (a, w' -> w') -> LoggerT e w m a
pass (LoggerT (RWST LoggerEnv m
-> LoggerState
-> m ((a, w' -> w'), LoggerState, OpMonoid [SomeMessage e w])
k)) = RWST (LoggerEnv m) (OpMonoid [SomeMessage e w]) LoggerState m a
-> LoggerT e w m a
forall e w (m :: * -> *) a.
RWST (LoggerEnv m) (OpMonoid [SomeMessage e w]) LoggerState m a
-> LoggerT e w m a
LoggerT (RWST (LoggerEnv m) (OpMonoid [SomeMessage e w]) LoggerState m a
 -> LoggerT e w m a)
-> RWST (LoggerEnv m) (OpMonoid [SomeMessage e w]) LoggerState m a
-> LoggerT e w m a
forall a b. (a -> b) -> a -> b
$ (LoggerEnv m
 -> LoggerState -> m (a, LoggerState, OpMonoid [SomeMessage e w]))
-> RWST (LoggerEnv m) (OpMonoid [SomeMessage e w]) LoggerState m a
forall r w s (m :: * -> *) a.
(r -> s -> m (a, s, w)) -> RWST r w s m a
RWST ((LoggerEnv m
  -> LoggerState -> m (a, LoggerState, OpMonoid [SomeMessage e w]))
 -> RWST (LoggerEnv m) (OpMonoid [SomeMessage e w]) LoggerState m a)
-> (LoggerEnv m
    -> LoggerState -> m (a, LoggerState, OpMonoid [SomeMessage e w]))
-> RWST (LoggerEnv m) (OpMonoid [SomeMessage e w]) LoggerState m a
forall a b. (a -> b) -> a -> b
$ \LoggerEnv m
e LoggerState
s ->
    m ((a, LoggerState, OpMonoid [SomeMessage e w]), w' -> w')
-> m (a, LoggerState, OpMonoid [SomeMessage e w])
forall w (m :: * -> *) a. MonadWriter w m => m (a, w -> w) -> m a
pass (m ((a, LoggerState, OpMonoid [SomeMessage e w]), w' -> w')
 -> m (a, LoggerState, OpMonoid [SomeMessage e w]))
-> m ((a, LoggerState, OpMonoid [SomeMessage e w]), w' -> w')
-> m (a, LoggerState, OpMonoid [SomeMessage e w])
forall a b. (a -> b) -> a -> b
$ (\((a
x, w' -> w'
f), LoggerState
w, OpMonoid [SomeMessage e w]
s') -> ((a
x, LoggerState
w, OpMonoid [SomeMessage e w]
s'), w' -> w'
f)) (((a, w' -> w'), LoggerState, OpMonoid [SomeMessage e w])
 -> ((a, LoggerState, OpMonoid [SomeMessage e w]), w' -> w'))
-> m ((a, w' -> w'), LoggerState, OpMonoid [SomeMessage e w])
-> m ((a, LoggerState, OpMonoid [SomeMessage e w]), w' -> w')
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> LoggerEnv m
-> LoggerState
-> m ((a, w' -> w'), LoggerState, OpMonoid [SomeMessage e w])
k LoggerEnv m
e LoggerState
s

instance (Monad m, Describe e, Describe w) =>
         MonadLogger e w (LoggerT e w m) where
  setDefaultSourceFile :: String -> LoggerT e w m ()
setDefaultSourceFile = RWST (LoggerEnv m) (OpMonoid [SomeMessage e w]) LoggerState m ()
-> LoggerT e w m ()
forall e w (m :: * -> *) a.
RWST (LoggerEnv m) (OpMonoid [SomeMessage e w]) LoggerState m a
-> LoggerT e w m a
LoggerT (RWST (LoggerEnv m) (OpMonoid [SomeMessage e w]) LoggerState m ()
 -> LoggerT e w m ())
-> (String
    -> RWST
         (LoggerEnv m) (OpMonoid [SomeMessage e w]) LoggerState m ())
-> String
-> LoggerT e w m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((String -> Identity String) -> LoggerState -> Identity LoggerState
Lens' LoggerState String
lsDefaultSourceFile ((String -> Identity String)
 -> LoggerState -> Identity LoggerState)
-> String
-> RWST (LoggerEnv m) (OpMonoid [SomeMessage e w]) LoggerState m ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.=)
  getDefaultSourceFile :: LoggerT e w m String
getDefaultSourceFile = RWST
  (LoggerEnv m) (OpMonoid [SomeMessage e w]) LoggerState m String
-> LoggerT e w m String
forall e w (m :: * -> *) a.
RWST (LoggerEnv m) (OpMonoid [SomeMessage e w]) LoggerState m a
-> LoggerT e w m a
LoggerT (Getting String LoggerState String
-> RWST
     (LoggerEnv m) (OpMonoid [SomeMessage e w]) LoggerState m String
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use Getting String LoggerState String
Lens' LoggerState String
lsDefaultSourceFile)

  recordLogMessage :: SomeMessage e w -> LoggerT e w m ()
recordLogMessage SomeMessage e w
msg = do
    RWST (LoggerEnv m) (OpMonoid [SomeMessage e w]) LoggerState m ()
-> LoggerT e w m ()
forall e w (m :: * -> *) a.
RWST (LoggerEnv m) (OpMonoid [SomeMessage e w]) LoggerState m a
-> LoggerT e w m a
LoggerT (RWST (LoggerEnv m) (OpMonoid [SomeMessage e w]) LoggerState m ()
 -> LoggerT e w m ())
-> RWST (LoggerEnv m) (OpMonoid [SomeMessage e w]) LoggerState m ()
-> LoggerT e w m ()
forall a b. (a -> b) -> a -> b
$ OpMonoid [SomeMessage e w]
-> RWST (LoggerEnv m) (OpMonoid [SomeMessage e w]) LoggerState m ()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell ([SomeMessage e w] -> OpMonoid [SomeMessage e w]
forall a. a -> OpMonoid a
OpMonoid [SomeMessage e w
msg])
    SomeMessage e w -> LoggerT e w m ()
forall (m :: * -> *) e w.
(Monad m, Describe e, Describe w) =>
SomeMessage e w -> LoggerT e w m ()
logSomeMessage SomeMessage e w
msg


-- | This doesn't behave quite as you may think. When a 'LoggerT' is hoisted,
-- the resulting 'LoggerT' cannot output as it goes. It still collects logs to
-- be inspected when it finishes.
instance MFunctor (LoggerT e w) where
  hoist :: (forall a. m a -> n a) -> LoggerT e w m b -> LoggerT e w n b
hoist forall a. m a -> n a
f (LoggerT (RWST LoggerEnv m
-> LoggerState -> m (b, LoggerState, OpMonoid [SomeMessage e w])
k)) = RWST (LoggerEnv n) (OpMonoid [SomeMessage e w]) LoggerState n b
-> LoggerT e w n b
forall e w (m :: * -> *) a.
RWST (LoggerEnv m) (OpMonoid [SomeMessage e w]) LoggerState m a
-> LoggerT e w m a
LoggerT (RWST (LoggerEnv n) (OpMonoid [SomeMessage e w]) LoggerState n b
 -> LoggerT e w n b)
-> RWST (LoggerEnv n) (OpMonoid [SomeMessage e w]) LoggerState n b
-> LoggerT e w n b
forall a b. (a -> b) -> a -> b
$ (LoggerEnv n
 -> LoggerState -> n (b, LoggerState, OpMonoid [SomeMessage e w]))
-> RWST (LoggerEnv n) (OpMonoid [SomeMessage e w]) LoggerState n b
forall r w s (m :: * -> *) a.
(r -> s -> m (a, s, w)) -> RWST r w s m a
RWST ((LoggerEnv n
  -> LoggerState -> n (b, LoggerState, OpMonoid [SomeMessage e w]))
 -> RWST (LoggerEnv n) (OpMonoid [SomeMessage e w]) LoggerState n b)
-> (LoggerEnv n
    -> LoggerState -> n (b, LoggerState, OpMonoid [SomeMessage e w]))
-> RWST (LoggerEnv n) (OpMonoid [SomeMessage e w]) LoggerState n b
forall a b. (a -> b) -> a -> b
$ \LoggerEnv n
e LoggerState
s ->
    let e' :: LoggerEnv m
e' = (n () -> m ()) -> LoggerEnv n -> LoggerEnv m
forall (m :: * -> *) (n :: * -> *).
(m () -> n ()) -> LoggerEnv m -> LoggerEnv n
hoistEnv (m () -> n () -> m ()
forall a b. a -> b -> a
const (() -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ())) LoggerEnv n
e
    in m (b, LoggerState, OpMonoid [SomeMessage e w])
-> n (b, LoggerState, OpMonoid [SomeMessage e w])
forall a. m a -> n a
f (LoggerEnv m
-> LoggerState -> m (b, LoggerState, OpMonoid [SomeMessage e w])
k LoggerEnv m
e' LoggerState
s)


-- | A function to output logs in a particular monad @m@.
data LogOutput m = LogOutput
  { LogOutput m -> Bool
_loConciseOutput :: Bool
  , LogOutput m -> Text -> m ()
_loPrintFunc     :: Text -> m ()
  }


-- | Output logs to standard output (i.e. the console).
logOutputStd
  :: MonadIO m
  => Bool
  -- ^ If 'True', print more concise output when message origin is repeated.
  -> LogOutput m
logOutputStd :: Bool -> LogOutput m
logOutputStd Bool
b = LogOutput :: forall (m :: * -> *). Bool -> (Text -> m ()) -> LogOutput m
LogOutput
  { _loConciseOutput :: Bool
_loConciseOutput = Bool
b
  , _loPrintFunc :: Text -> m ()
_loPrintFunc = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> (Text -> IO ()) -> Text -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> IO ()
Text.putStrLn
  }


-- | Output no logs.
logOutputNone
  :: Monad m
  => Bool
  -- ^ If 'True', print more concise output when message origin is repeated.
  -> LogOutput m
logOutputNone :: Bool -> LogOutput m
logOutputNone Bool
b = LogOutput :: forall (m :: * -> *). Bool -> (Text -> m ()) -> LogOutput m
LogOutput
  { _loConciseOutput :: Bool
_loConciseOutput = Bool
b
  , _loPrintFunc :: Text -> m ()
_loPrintFunc = m () -> Text -> m ()
forall a b. a -> b -> a
const (() -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ())
  }


-- | Run the logging monad transformer. Returns the action's result value and a
-- list of logs which were collected as it ran.
runLoggerT
  :: (Monad m, Describe e, Describe w)
  => FilePath
  -- ^ The initial default source file. This is only used for displaying message
  -- origins.
  -> LogOutput m
  -- ^ The logging output function. E.g. 'logOutputStd' or 'logOutputNone'.
  -> LogLevel
  -- ^ The log level for on-the-fly logging. Doesn't affect which logs are
  -- collected at the end.
  -> LoggerT e w m a
  -- ^ The logging action to run.
  -> m (a, [SomeMessage e w])
runLoggerT :: String
-> LogOutput m
-> LogLevel
-> LoggerT e w m a
-> m (a, [SomeMessage e w])
runLoggerT String
sourceFile LogOutput m
output LogLevel
logLevel (LoggerT RWST (LoggerEnv m) (OpMonoid [SomeMessage e w]) LoggerState m a
action) = do
  let st :: LoggerState
st = LoggerState :: LogLevel -> String -> Maybe Origin -> LoggerState
LoggerState
        { _lsLogLevel :: LogLevel
_lsLogLevel = LogLevel
logLevel
        , _lsDefaultSourceFile :: String
_lsDefaultSourceFile = String
sourceFile
        , _lsPreviousOrigin :: Maybe Origin
_lsPreviousOrigin = Maybe Origin
forall a. Maybe a
Nothing
        }

      env :: LoggerEnv m
env = LoggerEnv :: forall (m :: * -> *).
(Bool -> LogLevel -> LogLevel -> Text -> Text -> m ())
-> LoggerEnv m
LoggerEnv
        { _leLogFunc :: Bool -> LogLevel -> LogLevel -> Text -> Text -> m ()
_leLogFunc = LogOutput m -> Bool -> LogLevel -> LogLevel -> Text -> Text -> m ()
forall (m :: * -> *).
Monad m =>
LogOutput m -> Bool -> LogLevel -> LogLevel -> Text -> Text -> m ()
logFuncFrom LogOutput m
output
        }

  (a
x, LoggerState
_, OpMonoid [SomeMessage e w]
logs) <- RWST (LoggerEnv m) (OpMonoid [SomeMessage e w]) LoggerState m a
-> LoggerEnv m
-> LoggerState
-> m (a, LoggerState, OpMonoid [SomeMessage e w])
forall r w s (m :: * -> *) a.
RWST r w s m a -> r -> s -> m (a, s, w)
runRWST RWST (LoggerEnv m) (OpMonoid [SomeMessage e w]) LoggerState m a
action LoggerEnv m
env LoggerState
st

  (a, [SomeMessage e w]) -> m (a, [SomeMessage e w])
forall (m :: * -> *) a. Monad m => a -> m a
return (a
x, [SomeMessage e w] -> [SomeMessage e w]
forall a. [a] -> [a]
reverse (OpMonoid [SomeMessage e w] -> [SomeMessage e w]
forall a. OpMonoid a -> a
getOpMonoid OpMonoid [SomeMessage e w]
logs))


-- | Change the error and warning types in a logger computation. To change the
-- underlying monad use 'hoist'.
mapLoggerT
  :: (Functor m)
  => (e -> e') -> (w -> w')
  -> LoggerT e w m a -> LoggerT e' w' m a
mapLoggerT :: (e -> e') -> (w -> w') -> LoggerT e w m a -> LoggerT e' w' m a
mapLoggerT e -> e'
mapErr w -> w'
mapWarn (LoggerT RWST (LoggerEnv m) (OpMonoid [SomeMessage e w]) LoggerState m a
x) = RWST (LoggerEnv m) (OpMonoid [SomeMessage e' w']) LoggerState m a
-> LoggerT e' w' m a
forall e w (m :: * -> *) a.
RWST (LoggerEnv m) (OpMonoid [SomeMessage e w]) LoggerState m a
-> LoggerT e w m a
LoggerT ((m (a, LoggerState, OpMonoid [SomeMessage e w])
 -> m (a, LoggerState, OpMonoid [SomeMessage e' w']))
-> RWST (LoggerEnv m) (OpMonoid [SomeMessage e w]) LoggerState m a
-> RWST
     (LoggerEnv m) (OpMonoid [SomeMessage e' w']) LoggerState m a
forall (m :: * -> *) a s w (n :: * -> *) b w' r.
(m (a, s, w) -> n (b, s, w')) -> RWST r w s m a -> RWST r w' s n b
mapRWST m (a, LoggerState, OpMonoid [SomeMessage e w])
-> m (a, LoggerState, OpMonoid [SomeMessage e' w'])
mapInner RWST (LoggerEnv m) (OpMonoid [SomeMessage e w]) LoggerState m a
x)
  where
    mapInner :: m (a, LoggerState, OpMonoid [SomeMessage e w])
-> m (a, LoggerState, OpMonoid [SomeMessage e' w'])
mapInner =
      let messages :: ((LogMessage a -> f (LogMessage a)) -> a -> f b)
-> (a -> f a) -> s -> f t
messages (LogMessage a -> f (LogMessage a)) -> a -> f b
ty = (a -> f b) -> s -> f t
forall s t a b. Field3 s t a b => Lens s t a b
_3 ((a -> f b) -> s -> f t)
-> ((a -> f a) -> a -> f b) -> (a -> f a) -> s -> f t
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (t a -> f (t b)) -> a -> f b
forall s t. Rewrapping s t => Iso s t (Unwrapped s) (Unwrapped t)
_Wrapped ((t a -> f (t b)) -> a -> f b)
-> ((a -> f a) -> t a -> f (t b)) -> (a -> f a) -> a -> f b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> f b) -> t a -> f (t b)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse ((a -> f b) -> t a -> f (t b))
-> ((a -> f a) -> a -> f b) -> (a -> f a) -> t a -> f (t b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (LogMessage a -> f (LogMessage a)) -> a -> f b
ty ((LogMessage a -> f (LogMessage a)) -> a -> f b)
-> ((a -> f a) -> LogMessage a -> f (LogMessage a))
-> (a -> f a)
-> a
-> f b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> f a) -> LogMessage a -> f (LogMessage a)
forall a a. Lens (LogMessage a) (LogMessage a) a a
lmMsg
      in ((a, LoggerState, OpMonoid [SomeMessage e w])
 -> (a, LoggerState, OpMonoid [SomeMessage e' w']))
-> m (a, LoggerState, OpMonoid [SomeMessage e w])
-> m (a, LoggerState, OpMonoid [SomeMessage e' w'])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (ASetter
  (a, LoggerState, OpMonoid [SomeMessage e' w])
  (a, LoggerState, OpMonoid [SomeMessage e' w'])
  w
  w'
-> (w -> w')
-> (a, LoggerState, OpMonoid [SomeMessage e' w])
-> (a, LoggerState, OpMonoid [SomeMessage e' w'])
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over (((LogMessage w -> Identity (LogMessage w'))
 -> SomeMessage e' w -> Identity (SomeMessage e' w'))
-> ASetter
     (a, LoggerState, OpMonoid [SomeMessage e' w])
     (a, LoggerState, OpMonoid [SomeMessage e' w'])
     w
     w'
forall s t a b (t :: * -> *) (f :: * -> *) (f :: * -> *) b a a a.
(Field3 s t a b, Rewrapped a b, Rewrapped b a, Traversable t,
 Applicative f, Functor f, Unwrapped b ~ t b, Unwrapped a ~ t a) =>
((LogMessage a -> f (LogMessage a)) -> a -> f b)
-> (a -> f a) -> s -> f t
messages (LogMessage w -> Identity (LogMessage w'))
-> SomeMessage e' w -> Identity (SomeMessage e' w')
forall e w w.
Prism
  (SomeMessage e w) (SomeMessage e w) (LogMessage w) (LogMessage w)
_MsgWarn) w -> w'
mapWarn ((a, LoggerState, OpMonoid [SomeMessage e' w])
 -> (a, LoggerState, OpMonoid [SomeMessage e' w']))
-> ((a, LoggerState, OpMonoid [SomeMessage e w])
    -> (a, LoggerState, OpMonoid [SomeMessage e' w]))
-> (a, LoggerState, OpMonoid [SomeMessage e w])
-> (a, LoggerState, OpMonoid [SomeMessage e' w'])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ASetter
  (a, LoggerState, OpMonoid [SomeMessage e w])
  (a, LoggerState, OpMonoid [SomeMessage e' w])
  e
  e'
-> (e -> e')
-> (a, LoggerState, OpMonoid [SomeMessage e w])
-> (a, LoggerState, OpMonoid [SomeMessage e' w])
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over (((LogMessage e -> Identity (LogMessage e'))
 -> SomeMessage e w -> Identity (SomeMessage e' w))
-> ASetter
     (a, LoggerState, OpMonoid [SomeMessage e w])
     (a, LoggerState, OpMonoid [SomeMessage e' w])
     e
     e'
forall s t a b (t :: * -> *) (f :: * -> *) (f :: * -> *) b a a a.
(Field3 s t a b, Rewrapped a b, Rewrapped b a, Traversable t,
 Applicative f, Functor f, Unwrapped b ~ t b, Unwrapped a ~ t a) =>
((LogMessage a -> f (LogMessage a)) -> a -> f b)
-> (a -> f a) -> s -> f t
messages (LogMessage e -> Identity (LogMessage e'))
-> SomeMessage e w -> Identity (SomeMessage e' w)
forall e w e.
Prism
  (SomeMessage e w) (SomeMessage e w) (LogMessage e) (LogMessage e)
_MsgError) e -> e'
mapErr)

--------------------------------------------------------------------------------
--  Internal
--------------------------------------------------------------------------------

logFuncFrom
  :: (Monad m)
  => LogOutput m
  -> (Bool -> LogLevel -> LogLevel -> Text -> Text -> m ())
logFuncFrom :: LogOutput m -> Bool -> LogLevel -> LogLevel -> Text -> Text -> m ()
logFuncFrom LogOutput{ Bool
_loConciseOutput :: Bool
_loConciseOutput :: forall (m :: * -> *). LogOutput m -> Bool
_loConciseOutput, Text -> m ()
_loPrintFunc :: Text -> m ()
_loPrintFunc :: forall (m :: * -> *). LogOutput m -> Text -> m ()
_loPrintFunc } = Bool -> LogLevel -> LogLevel -> Text -> Text -> m ()
lf
  where
    lf :: Bool -> LogLevel -> LogLevel -> Text -> Text -> m ()
lf Bool
repeatedOrigin LogLevel
maxLevel LogLevel
level Text
originMsg Text
actualMsg
      | LogLevel
level LogLevel -> LogLevel -> Bool
forall a. Ord a => a -> a -> Bool
<= LogLevel
maxLevel =
        let outputMsg :: Builder
outputMsg =
              LogLevel -> Builder
forall a. Describe a => a -> Builder
describeBuilder LogLevel
level Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<>
              (if Bool -> Bool
not Bool
_loConciseOutput Bool -> Bool -> Bool
|| Bool -> Bool
not Bool
repeatedOrigin
               then Builder
" " Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Text -> Builder
forall a. Describe a => a -> Builder
describeBuilder Text
originMsg else Builder
"") Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
": " Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<>
              Text -> Builder
forall a. Describe a => a -> Builder
describeBuilder Text
actualMsg
        in Text -> m ()
_loPrintFunc (Builder -> Text
builderToStrict Builder
outputMsg)
      | Bool
otherwise = () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()


someLogLevel :: SomeMessage e w -> LogLevel
someLogLevel :: SomeMessage e w -> LogLevel
someLogLevel (MsgError LogMessage e
_) = LogLevel
LogError
someLogLevel (MsgWarn LogMessage w
_)  = LogLevel
LogWarn
someLogLevel (MsgInfo LogMessage Text
_)  = LogLevel
LogInfo
someLogLevel (MsgDebug LogMessage Text
_) = LogLevel
LogDebug

someMsgText :: (Describe e, Describe w) => SomeMessage e w -> Text
someMsgText :: SomeMessage e w -> Text
someMsgText (MsgError LogMessage e
msg) = e -> Text
forall a. Describe a => a -> Text
describe (LogMessage e
msg LogMessage e -> Getting e (LogMessage e) e -> e
forall s a. s -> Getting a s a -> a
^. Getting e (LogMessage e) e
forall a a. Lens (LogMessage a) (LogMessage a) a a
lmMsg)
someMsgText (MsgWarn LogMessage w
msg)  = w -> Text
forall a. Describe a => a -> Text
describe (LogMessage w
msg LogMessage w -> Getting w (LogMessage w) w -> w
forall s a. s -> Getting a s a -> a
^. Getting w (LogMessage w) w
forall a a. Lens (LogMessage a) (LogMessage a) a a
lmMsg)
someMsgText (MsgInfo LogMessage Text
msg)  = LogMessage Text
msg LogMessage Text -> Getting Text (LogMessage Text) Text -> Text
forall s a. s -> Getting a s a -> a
^. Getting Text (LogMessage Text) Text
forall a a. Lens (LogMessage a) (LogMessage a) a a
lmMsg
someMsgText (MsgDebug LogMessage Text
msg) = LogMessage Text
msg LogMessage Text -> Getting Text (LogMessage Text) Text -> Text
forall s a. s -> Getting a s a -> a
^. Getting Text (LogMessage Text) Text
forall a a. Lens (LogMessage a) (LogMessage a) a a
lmMsg


logSomeMessage
  :: (Monad m, Describe e, Describe w)
  => SomeMessage e w -> LoggerT e w m ()
logSomeMessage :: SomeMessage e w -> LoggerT e w m ()
logSomeMessage SomeMessage e w
msg = do
  let msgText :: Text
msgText = SomeMessage e w -> Text
forall e w. (Describe e, Describe w) => SomeMessage e w -> Text
someMsgText SomeMessage e w
msg
      msgLevel :: LogLevel
msgLevel = SomeMessage e w -> LogLevel
forall e w. SomeMessage e w -> LogLevel
someLogLevel SomeMessage e w
msg
      msgOrigin :: Maybe Origin
msgOrigin = SomeMessage e w
msg SomeMessage e w
-> Getting (Maybe Origin) (SomeMessage e w) (Maybe Origin)
-> Maybe Origin
forall s a. s -> Getting a s a -> a
^. Getting (Maybe Origin) (SomeMessage e w) (Maybe Origin)
forall e w. Lens' (SomeMessage e w) (Maybe Origin)
someMessageOrigin
      originText :: Text
originText = Text -> (Origin -> Text) -> Maybe Origin -> Text
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Text
"" Origin -> Text
forall a. Describe a => a -> Text
describe Maybe Origin
msgOrigin

  Maybe Origin
prevOrigin <- RWST
  (LoggerEnv m)
  (OpMonoid [SomeMessage e w])
  LoggerState
  m
  (Maybe Origin)
-> LoggerT e w m (Maybe Origin)
forall e w (m :: * -> *) a.
RWST (LoggerEnv m) (OpMonoid [SomeMessage e w]) LoggerState m a
-> LoggerT e w m a
LoggerT (RWST
   (LoggerEnv m)
   (OpMonoid [SomeMessage e w])
   LoggerState
   m
   (Maybe Origin)
 -> LoggerT e w m (Maybe Origin))
-> RWST
     (LoggerEnv m)
     (OpMonoid [SomeMessage e w])
     LoggerState
     m
     (Maybe Origin)
-> LoggerT e w m (Maybe Origin)
forall a b. (a -> b) -> a -> b
$ Getting (Maybe Origin) LoggerState (Maybe Origin)
-> RWST
     (LoggerEnv m)
     (OpMonoid [SomeMessage e w])
     LoggerState
     m
     (Maybe Origin)
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use Getting (Maybe Origin) LoggerState (Maybe Origin)
Lens' LoggerState (Maybe Origin)
lsPreviousOrigin
  RWST (LoggerEnv m) (OpMonoid [SomeMessage e w]) LoggerState m ()
-> LoggerT e w m ()
forall e w (m :: * -> *) a.
RWST (LoggerEnv m) (OpMonoid [SomeMessage e w]) LoggerState m a
-> LoggerT e w m a
LoggerT (RWST (LoggerEnv m) (OpMonoid [SomeMessage e w]) LoggerState m ()
 -> LoggerT e w m ())
-> RWST (LoggerEnv m) (OpMonoid [SomeMessage e w]) LoggerState m ()
-> LoggerT e w m ()
forall a b. (a -> b) -> a -> b
$ (Maybe Origin -> Identity (Maybe Origin))
-> LoggerState -> Identity LoggerState
Lens' LoggerState (Maybe Origin)
lsPreviousOrigin ((Maybe Origin -> Identity (Maybe Origin))
 -> LoggerState -> Identity LoggerState)
-> Maybe Origin
-> RWST (LoggerEnv m) (OpMonoid [SomeMessage e w]) LoggerState m ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= SomeMessage e w
msg SomeMessage e w
-> Getting (Maybe Origin) (SomeMessage e w) (Maybe Origin)
-> Maybe Origin
forall s a. s -> Getting a s a -> a
^. Getting (Maybe Origin) (SomeMessage e w) (Maybe Origin)
forall e w. Lens' (SomeMessage e w) (Maybe Origin)
someMessageOrigin

  let repeatedOrigin :: Bool
repeatedOrigin = Maybe Origin
msgOrigin Maybe Origin -> Maybe Origin -> Bool
forall a. Eq a => a -> a -> Bool
== Maybe Origin
prevOrigin

  Bool -> LogLevel -> LogLevel -> Text -> Text -> m ()
logFunc <- RWST
  (LoggerEnv m)
  (OpMonoid [SomeMessage e w])
  LoggerState
  m
  (Bool -> LogLevel -> LogLevel -> Text -> Text -> m ())
-> LoggerT
     e w m (Bool -> LogLevel -> LogLevel -> Text -> Text -> m ())
forall e w (m :: * -> *) a.
RWST (LoggerEnv m) (OpMonoid [SomeMessage e w]) LoggerState m a
-> LoggerT e w m a
LoggerT (RWST
   (LoggerEnv m)
   (OpMonoid [SomeMessage e w])
   LoggerState
   m
   (Bool -> LogLevel -> LogLevel -> Text -> Text -> m ())
 -> LoggerT
      e w m (Bool -> LogLevel -> LogLevel -> Text -> Text -> m ()))
-> RWST
     (LoggerEnv m)
     (OpMonoid [SomeMessage e w])
     LoggerState
     m
     (Bool -> LogLevel -> LogLevel -> Text -> Text -> m ())
-> LoggerT
     e w m (Bool -> LogLevel -> LogLevel -> Text -> Text -> m ())
forall a b. (a -> b) -> a -> b
$ Getting
  (Bool -> LogLevel -> LogLevel -> Text -> Text -> m ())
  (LoggerEnv m)
  (Bool -> LogLevel -> LogLevel -> Text -> Text -> m ())
-> RWST
     (LoggerEnv m)
     (OpMonoid [SomeMessage e w])
     LoggerState
     m
     (Bool -> LogLevel -> LogLevel -> Text -> Text -> m ())
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting
  (Bool -> LogLevel -> LogLevel -> Text -> Text -> m ())
  (LoggerEnv m)
  (Bool -> LogLevel -> LogLevel -> Text -> Text -> m ())
forall (m :: * -> *) (m :: * -> *).
Iso
  (LoggerEnv m)
  (LoggerEnv m)
  (Bool -> LogLevel -> LogLevel -> Text -> Text -> m ())
  (Bool -> LogLevel -> LogLevel -> Text -> Text -> m ())
leLogFunc
  LogLevel
logLevel <- RWST
  (LoggerEnv m) (OpMonoid [SomeMessage e w]) LoggerState m LogLevel
-> LoggerT e w m LogLevel
forall e w (m :: * -> *) a.
RWST (LoggerEnv m) (OpMonoid [SomeMessage e w]) LoggerState m a
-> LoggerT e w m a
LoggerT (RWST
   (LoggerEnv m) (OpMonoid [SomeMessage e w]) LoggerState m LogLevel
 -> LoggerT e w m LogLevel)
-> RWST
     (LoggerEnv m) (OpMonoid [SomeMessage e w]) LoggerState m LogLevel
-> LoggerT e w m LogLevel
forall a b. (a -> b) -> a -> b
$ Getting LogLevel LoggerState LogLevel
-> RWST
     (LoggerEnv m) (OpMonoid [SomeMessage e w]) LoggerState m LogLevel
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use Getting LogLevel LoggerState LogLevel
Lens' LoggerState LogLevel
lsLogLevel

  m () -> LoggerT e w m ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> LoggerT e w m ()) -> m () -> LoggerT e w m ()
forall a b. (a -> b) -> a -> b
$ Bool -> LogLevel -> LogLevel -> Text -> Text -> m ()
logFunc Bool
repeatedOrigin LogLevel
logLevel LogLevel
msgLevel Text
originText Text
msgText