{-# LANGUAGE Trustworthy #-}
-- |
-- Copyright: (c) 2021 Xy Ren
-- License: BSD3
-- Maintainer: xy.r@outlook.com
-- Stability: experimental
-- Portability: non-portable (GHC only)
module Cleff.Trace
  ( -- * Effect
    Trace (..)
    -- * Operations
  , trace
    -- * Interpretations
  , runTraceHandle
  , runTraceStdout
  , runTraceStderr
  , ignoreTrace
  , traceToOutput
  ) where

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

-- * Effect

-- | An effect capable of logging messages, mostly for debugging purposes.
data Trace :: Effect where
  Trace :: String -> Trace m ()

-- * Operations

makeEffect_ ''Trace

-- | Output a trace message.
trace :: Trace :> es => String -> Eff es ()

-- * Interpretations

-- | Run the 'Trace' effect by writing to a 'Handle'.
runTraceHandle :: IOE :> es => Handle -> Eff (Trace ': es) a -> Eff es a
runTraceHandle :: Handle -> Eff (Trace : es) a -> Eff es a
runTraceHandle Handle
h = HandlerIO Trace es -> Eff (Trace : es) ~> Eff es
forall (es :: [(Type -> Type) -> Type -> Type])
       (e :: (Type -> Type) -> Type -> Type).
(IOE :> es) =>
HandlerIO e es -> Eff (e : es) ~> Eff es
interpretIO \case
  Trace s -> Handle -> String -> IO ()
hPutStrLn Handle
h String
s
{-# INLINE runTraceHandle #-}

-- | Run the 'Trace' effect by writing to 'stdout'.
runTraceStdout :: IOE :> es => Eff (Trace ': es) ~> Eff es
runTraceStdout :: Eff (Trace : es) ~> Eff es
runTraceStdout = Handle -> Eff (Trace : es) a -> Eff es a
forall (es :: [(Type -> Type) -> Type -> Type]) a.
(IOE :> es) =>
Handle -> Eff (Trace : es) a -> Eff es a
runTraceHandle Handle
stdout
{-# INLINE runTraceStdout #-}

-- | Run the 'Trace' effect by writing to 'stderr'.
runTraceStderr :: IOE :> es => Eff (Trace ': es) ~> Eff es
runTraceStderr :: Eff (Trace : es) ~> Eff es
runTraceStderr = Handle -> Eff (Trace : es) a -> Eff es a
forall (es :: [(Type -> Type) -> Type -> Type]) a.
(IOE :> es) =>
Handle -> Eff (Trace : es) a -> Eff es a
runTraceHandle Handle
stderr
{-# INLINE runTraceStderr #-}

-- | Run the 'Trace' effect by ignoring all outputs altogether.
ignoreTrace :: Eff (Trace ': es) ~> Eff es
ignoreTrace :: Eff (Trace : es) a -> Eff es a
ignoreTrace = Handler Trace es -> Eff (Trace : es) ~> Eff es
forall (e :: (Type -> Type) -> Type -> Type)
       (es :: [(Type -> Type) -> Type -> Type]).
Handler e es -> Eff (e : es) ~> Eff es
interpret \case
  Trace _ -> () -> Eff es ()
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure ()
{-# INLINE ignoreTrace #-}

-- | Transform the 'Trace' effect into an @'Output' 'String'@ effect.
traceToOutput :: Eff (Trace ': es) ~> Eff (Output String ': es)
traceToOutput :: Eff (Trace : es) a -> Eff (Output String : es) a
traceToOutput = Handler Trace (Output String : es)
-> Eff (Trace : es) ~> Eff (Output String : es)
forall (e' :: (Type -> Type) -> Type -> Type)
       (e :: (Type -> Type) -> Type -> Type)
       (es :: [(Type -> Type) -> Type -> Type]).
Handler e (e' : es) -> Eff (e : es) ~> Eff (e' : es)
reinterpret \case
  Trace s -> String -> Eff (Output String : es) ()
forall o (es :: [(Type -> Type) -> Type -> Type]).
(Output o :> es) =>
o -> Eff es ()
output String
s
{-# INLINE traceToOutput #-}