-- | Opaque type for an operations log that provides fast O(1)
-- appends.
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

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

-- | Transform a log into pretty.  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" 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

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

-- | Typeclass for monads that support logging.
class (Applicative m, Monad m) => MonadLogger m where
  -- | Add one log entry.
  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

  -- | Append an entire log.
  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