{-# LANGUAGE TemplateHaskell #-}

module Polysemy.Trace
  ( -- * Effect
    Trace (..)

    -- * Actions
  , trace

    -- * Interpretations
  , traceToHandle
  , traceToStdout
  , traceToStderr
  , traceToIO
  , runTraceList
  , ignoreTrace
  , traceToOutput

    -- * Interpretations for Other Effects
  , outputToTrace
  ) where

import Polysemy
import Polysemy.Output
import System.IO (stdout, stderr, hPutStrLn, Handle)


------------------------------------------------------------------------------
-- | An effect for logging strings.
data Trace m a where
  Trace :: String -> Trace m ()

makeSem ''Trace


------------------------------------------------------------------------------
-- | Run a 'Trace' effect by printing the messages to the provided 'Handle'.
--
-- @since 1.6.0.0
traceToHandle :: Member (Embed IO) r => Handle -> Sem (Trace ': r) a -> Sem r a
traceToHandle :: Handle -> Sem (Trace : r) a -> Sem r a
traceToHandle Handle
handle = (forall (rInitial :: EffectRow) x.
 Trace (Sem rInitial) x -> Sem r x)
-> Sem (Trace : r) a -> Sem r a
forall (e :: (* -> *) -> * -> *) (r :: EffectRow) a.
FirstOrder e "interpret" =>
(forall (rInitial :: EffectRow) x. e (Sem rInitial) x -> Sem r x)
-> Sem (e : r) a -> Sem r a
interpret ((forall (rInitial :: EffectRow) x.
  Trace (Sem rInitial) x -> Sem r x)
 -> Sem (Trace : r) a -> Sem r a)
-> (forall (rInitial :: EffectRow) x.
    Trace (Sem rInitial) x -> Sem r x)
-> Sem (Trace : r) a
-> Sem r a
forall a b. (a -> b) -> a -> b
$ \case
  Trace m -> IO () -> Sem r ()
forall (m :: * -> *) (r :: EffectRow) a.
Member (Embed m) r =>
m a -> Sem r a
embed (IO () -> Sem r ()) -> IO () -> Sem r ()
forall a b. (a -> b) -> a -> b
$ Handle -> String -> IO ()
hPutStrLn Handle
handle String
m
{-# INLINE traceToHandle #-}


------------------------------------------------------------------------------
-- | Run a 'Trace' effect by printing the messages to stdout.
--
-- @since 1.6.0.0
traceToStdout :: Member (Embed IO) r => Sem (Trace ': r) a -> Sem r a
traceToStdout :: Sem (Trace : r) a -> Sem r a
traceToStdout = Handle -> Sem (Trace : r) a -> Sem r a
forall (r :: EffectRow) a.
Member (Embed IO) r =>
Handle -> Sem (Trace : r) a -> Sem r a
traceToHandle Handle
stdout
{-# INLINE traceToStdout #-}


------------------------------------------------------------------------------
-- | Run a 'Trace' effect by printing the messages to stderr.
--
-- @since 1.6.0.0
traceToStderr :: Member (Embed IO) r => Sem (Trace ': r) a -> Sem r a
traceToStderr :: Sem (Trace : r) a -> Sem r a
traceToStderr = Handle -> Sem (Trace : r) a -> Sem r a
forall (r :: EffectRow) a.
Member (Embed IO) r =>
Handle -> Sem (Trace : r) a -> Sem r a
traceToHandle Handle
stderr
{-# INLINE traceToStderr #-}


------------------------------------------------------------------------------
-- | Run a 'Trace' effect by printing the messages to stdout.
--
-- @since 1.0.0.0
traceToIO :: Member (Embed IO) r => Sem (Trace ': r) a -> Sem r a
traceToIO :: Sem (Trace : r) a -> Sem r a
traceToIO = Sem (Trace : r) a -> Sem r a
forall (r :: EffectRow) a.
Member (Embed IO) r =>
Sem (Trace : r) a -> Sem r a
traceToStdout
{-# INLINE traceToIO #-}
{-# deprecated traceToIO "Use traceToStdout" #-}


------------------------------------------------------------------------------
-- | Run a 'Trace' effect by ignoring all of its messages.
--
-- @since 1.0.0.0
ignoreTrace :: Sem (Trace ': r) a -> Sem r a
ignoreTrace :: Sem (Trace : r) a -> Sem r a
ignoreTrace = (forall (rInitial :: EffectRow) x.
 Trace (Sem rInitial) x -> Sem r x)
-> Sem (Trace : r) a -> Sem r a
forall (e :: (* -> *) -> * -> *) (r :: EffectRow) a.
FirstOrder e "interpret" =>
(forall (rInitial :: EffectRow) x. e (Sem rInitial) x -> Sem r x)
-> Sem (e : r) a -> Sem r a
interpret ((forall (rInitial :: EffectRow) x.
  Trace (Sem rInitial) x -> Sem r x)
 -> Sem (Trace : r) a -> Sem r a)
-> (forall (rInitial :: EffectRow) x.
    Trace (Sem rInitial) x -> Sem r x)
-> Sem (Trace : r) a
-> Sem r a
forall a b. (a -> b) -> a -> b
$ \case
  Trace _ -> () -> Sem r ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
{-# INLINE ignoreTrace #-}


------------------------------------------------------------------------------
-- | Transform a 'Trace' effect into a 'Output' 'String' effect.
--
-- @since 1.0.0.0
traceToOutput
    :: Member (Output String) r
    => Sem (Trace ': r) a
    -> Sem r a
traceToOutput :: Sem (Trace : r) a -> Sem r a
traceToOutput = (forall (rInitial :: EffectRow) x.
 Trace (Sem rInitial) x -> Sem r x)
-> Sem (Trace : r) a -> Sem r a
forall (e :: (* -> *) -> * -> *) (r :: EffectRow) a.
FirstOrder e "interpret" =>
(forall (rInitial :: EffectRow) x. e (Sem rInitial) x -> Sem r x)
-> Sem (e : r) a -> Sem r a
interpret ((forall (rInitial :: EffectRow) x.
  Trace (Sem rInitial) x -> Sem r x)
 -> Sem (Trace : r) a -> Sem r a)
-> (forall (rInitial :: EffectRow) x.
    Trace (Sem rInitial) x -> Sem r x)
-> Sem (Trace : r) a
-> Sem r a
forall a b. (a -> b) -> a -> b
$ \case
  Trace m -> String -> Sem r ()
forall o (r :: EffectRow).
MemberWithError (Output o) r =>
o -> Sem r ()
output String
m
{-# INLINE traceToOutput #-}


------------------------------------------------------------------------------
-- | Get the result of a 'Trace' effect as a list of 'String's.
--
-- @since 1.0.0.0
runTraceList
    :: Sem (Trace ': r) a
    -> Sem r ([String], a)
runTraceList :: Sem (Trace : r) a -> Sem r ([String], a)
runTraceList = Sem (Output String : r) a -> Sem r ([String], a)
forall o (r :: EffectRow) a. Sem (Output o : r) a -> Sem r ([o], a)
runOutputList (Sem (Output String : r) a -> Sem r ([String], a))
-> (Sem (Trace : r) a -> Sem (Output String : r) a)
-> Sem (Trace : r) a
-> Sem r ([String], a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall (rInitial :: EffectRow) x.
 Trace (Sem rInitial) x -> Sem (Output String : r) x)
-> Sem (Trace : r) a -> Sem (Output String : r) a
forall (e1 :: (* -> *) -> * -> *) (e2 :: (* -> *) -> * -> *)
       (r :: EffectRow) a.
FirstOrder e1 "reinterpret" =>
(forall (rInitial :: EffectRow) x.
 e1 (Sem rInitial) x -> Sem (e2 : r) x)
-> Sem (e1 : r) a -> Sem (e2 : r) a
reinterpret (
  \case
    Trace m -> String -> Sem (Output String : r) ()
forall o (r :: EffectRow).
MemberWithError (Output o) r =>
o -> Sem r ()
output String
m
  )
{-# INLINE runTraceList #-}


------------------------------------------------------------------------------
-- | Transform an @'Output' w@ effect into a 'Trace' effect given a function
-- to transform each @w@ to a 'String'.
--
-- @since 1.0.0.0
outputToTrace
  :: forall w r a
   . Member Trace r
  => (w -> String)
  -> Sem (Output w ': r) a
  -> Sem r a
outputToTrace :: (w -> String) -> Sem (Output w : r) a -> Sem r a
outputToTrace w -> String
show' = (forall (rInitial :: EffectRow) x.
 Output w (Sem rInitial) x -> Sem r x)
-> Sem (Output w : r) a -> Sem r a
forall (e :: (* -> *) -> * -> *) (r :: EffectRow) a.
FirstOrder e "interpret" =>
(forall (rInitial :: EffectRow) x. e (Sem rInitial) x -> Sem r x)
-> Sem (e : r) a -> Sem r a
interpret ((forall (rInitial :: EffectRow) x.
  Output w (Sem rInitial) x -> Sem r x)
 -> Sem (Output w : r) a -> Sem r a)
-> (forall (rInitial :: EffectRow) x.
    Output w (Sem rInitial) x -> Sem r x)
-> Sem (Output w : r) a
-> Sem r a
forall a b. (a -> b) -> a -> b
$ \case
  Output m -> String -> Sem r ()
forall (r :: EffectRow).
MemberWithError Trace r =>
String -> Sem r ()
trace (String -> Sem r ()) -> String -> Sem r ()
forall a b. (a -> b) -> a -> b
$ w -> String
show' w
m
{-# INLINE outputToTrace #-}