{-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE OverloadedStrings #-} -- | Opaque type for an operations log that provides fast O(1) -- appends. module Futhark.Util.Log ( Log , toText , ToLog (..) , MonadLogger (..) ) where import Control.Monad.Writer import qualified Control.Monad.RWS.Strict import qualified Control.Monad.RWS.Lazy import qualified Data.Text as T import qualified Data.DList as DL -- | An efficiently catenable sequence of log entries. 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 (DList Text -> Log) -> DList Text -> Log forall a b. (a -> b) -> a -> b $ DList Text l1 DList Text -> DList Text -> DList Text forall a. Semigroup a => a -> a -> a <> DList Text l2 instance Monoid Log where mempty :: Log mempty = DList Text -> Log Log DList Text forall a. Monoid a => a mempty -- | Transform a log into text. Every log entry becomes its own line -- (or possibly more, in case of multi-line entries). toText :: Log -> T.Text toText :: Log -> Text toText = Text -> [Text] -> Text T.intercalate Text "\n" ([Text] -> Text) -> (Log -> [Text]) -> Log -> Text forall b c a. (b -> c) -> (a -> b) -> a -> c . DList Text -> [Text] forall a. DList a -> [a] DL.toList (DList Text -> [Text]) -> (Log -> DList Text) -> Log -> [Text] forall b c a. (b -> c) -> (a -> b) -> a -> c . Log -> DList Text unLog -- | Typeclass for things that can be turned into a single-entry log. class ToLog a where toLog :: a -> Log instance ToLog String where toLog :: String -> Log toLog = DList Text -> Log Log (DList Text -> Log) -> (String -> DList Text) -> String -> Log forall b c a. (b -> c) -> (a -> b) -> a -> c . Text -> DList Text forall a. a -> DList a DL.singleton (Text -> DList Text) -> (String -> Text) -> String -> DList Text 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 (DList Text -> Log) -> (Text -> DList Text) -> Text -> Log forall b c a. (b -> c) -> (a -> b) -> a -> c . Text -> DList Text forall a. a -> DList a DL.singleton -- | Typeclass for monads that support logging. class (Applicative m, Monad m) => MonadLogger m where -- | Add one log entry. logMsg :: ToLog a => a -> m () logMsg = Log -> m () forall (m :: * -> *). MonadLogger m => Log -> m () addLog (Log -> m ()) -> (a -> Log) -> a -> m () forall b c a. (b -> c) -> (a -> b) -> a -> c . a -> Log forall a. ToLog a => a -> Log toLog -- | Append an entire log. addLog :: Log -> m () instance (Applicative m, Monad m) => MonadLogger (WriterT Log m) where addLog :: Log -> WriterT Log m () addLog = Log -> WriterT Log m () forall w (m :: * -> *). MonadWriter w m => w -> m () tell instance (Applicative m, Monad m) => MonadLogger (Control.Monad.RWS.Lazy.RWST r Log s m) where addLog :: Log -> RWST r Log s m () addLog = Log -> RWST r Log s m () forall w (m :: * -> *). MonadWriter w m => w -> m () tell instance (Applicative m, Monad m) => MonadLogger (Control.Monad.RWS.Strict.RWST r Log s m) where addLog :: Log -> RWST r Log s m () addLog = Log -> RWST r Log s m () forall w (m :: * -> *). MonadWriter w m => w -> m () tell