module Futhark.Util.Log
( Log,
toText,
ToLog (..),
MonadLogger (..),
)
where
import Control.Monad.RWS.Lazy qualified
import Control.Monad.RWS.Strict qualified
import Control.Monad.Writer
import Data.DList qualified as DL
import Data.Text qualified as T
newtype Log = Log {Log -> DList Text
unLog :: DL.DList T.Text}
instance Semigroup Log where
Log DList Text
l1 <> :: Log -> Log -> Log
<> Log DList Text
l2 = DList Text -> Log
Log forall a b. (a -> b) -> a -> b
$ DList Text
l1 forall a. Semigroup a => a -> a -> a
<> DList Text
l2
instance Monoid Log where
mempty :: Log
mempty = DList Text -> Log
Log forall a. Monoid a => a
mempty
toText :: Log -> T.Text
toText :: Log -> Text
toText = Text -> [Text] -> Text
T.intercalate Text
"\n" forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. DList a -> [a]
DL.toList forall b c a. (b -> c) -> (a -> b) -> a -> c
. Log -> DList Text
unLog
class ToLog a where
toLog :: a -> Log
instance ToLog String where
toLog :: String -> Log
toLog = DList Text -> Log
Log forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> DList a
DL.singleton forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
T.pack
instance ToLog T.Text where
toLog :: Text -> Log
toLog = DList Text -> Log
Log forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> DList a
DL.singleton
class (Applicative m, Monad m) => MonadLogger m where
logMsg :: ToLog a => a -> m ()
logMsg = forall (m :: * -> *). MonadLogger m => Log -> m ()
addLog forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. ToLog a => a -> Log
toLog
addLog :: Log -> m ()
instance Monad m => MonadLogger (WriterT Log m) where
addLog :: Log -> WriterT Log m ()
addLog = forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell
instance Monad m => MonadLogger (Control.Monad.RWS.Lazy.RWST r Log s m) where
addLog :: Log -> RWST r Log s m ()
addLog = forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell
instance Monad m => MonadLogger (Control.Monad.RWS.Strict.RWST r Log s m) where
addLog :: Log -> RWST r Log s m ()
addLog = forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell