    -- | 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
    import Data.Text.IO qualified as T
    import System.IO (stderr)

    -- | 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 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" ([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 (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 (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 (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

    instance MonadLogger IO where
      addLog :: Log -> IO ()
    addLog = (Text -> IO ()) -> DList Text -> IO ()
    forall (t :: * -> *) (m :: * -> *) a b.
    (Foldable t, Monad m) =>
    (a -> m b) -> t a -> m ()
    mapM_ (Handle -> Text -> IO ()
    T.hPutStrLn Handle
    stderr) (DList Text -> IO ()) -> (Log -> DList Text) -> Log -> IO ()
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Log -> DList Text
    unLog