Skip to content
This repository has been archived by the owner on Dec 17, 2020. It is now read-only.

Commit

Permalink
Use handleRelay instead of explicit handling
Browse files Browse the repository at this point in the history
  • Loading branch information
xkollar committed May 11, 2017
1 parent cf4b479 commit 61762ed
Showing 1 changed file with 12 additions and 12 deletions.
24 changes: 12 additions & 12 deletions src/Control/Monad/Freer/Trace.hs
Original file line number Diff line number Diff line change
Expand Up @@ -38,14 +38,13 @@ module Control.Monad.Freer.Trace
)
where

import Control.Monad ((>>=), return)
import Data.Either (Either(Left, Right))
import Control.Applicative (pure)
import Control.Monad ((>>=))
import Data.Function ((.), const)
import Data.String (String)
import System.IO (IO, hPutStrLn, stderr)

import Control.Monad.Freer.Internal
(Eff(E, Val), Member, decomp, qApp, send, tsingleton)
import Control.Monad.Freer.Internal (Arr, Eff, Member, handleRelay, send)


-- | A Trace effect.
Expand All @@ -58,13 +57,14 @@ trace = send . Trace

-- | Generic handler for 'Trace' effect.
runTrace
:: (s -> Eff effs ())
-- ^ Function to trace @s@ in terms of effect stack with 'Trace' popped.
-> Eff (Trace s ': effs) a -> Eff effs a
runTrace _ (Val x) = return x
runTrace f (E u q) = case decomp u of
Right (Trace s) -> f s >>= runTrace f . qApp q
Left u' -> E u' (tsingleton (runTrace f . qApp q))
:: forall s effs a
. (s -> Eff effs ())
-- ^ Function to trace @s@ in terms of effect stack with 'Trace' popped.
-> Eff (Trace s ': effs) a -> Eff effs a
runTrace f = handleRelay pure handle
where
handle :: Trace s v -> Arr effs v a -> Eff effs a
handle (Trace s) = (f s >>=)

-- | Simple handler for 'Trace' 'String' that just writes it to stdout.
runTraceIO :: Member IO effs => Eff (Trace String ': effs) a -> Eff effs a
Expand All @@ -79,7 +79,7 @@ runTraceSilent
runTraceSilent p = runTrace (f p)
where
f :: proxy s -> s -> Eff effs ()
f _ = const (return ())
f _ = const (pure ())

-- $simpleLoggingFacility
--
Expand Down

0 comments on commit 61762ed

Please sign in to comment.