{-# 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 qualified Control.Monad.RWS.Lazy
import qualified Control.Monad.RWS.Strict
import Control.Monad.Writer
import qualified Data.DList as DL
import qualified Data.Text as T

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