From 08a216df8c9986029b279eea674820e3a31a2836 Mon Sep 17 00:00:00 2001
From: Matej Kollar <208115@mail.muni.cz>
Date: Tue, 21 Mar 2017 22:27:08 +0100
Subject: [PATCH 1/9] Generalize Trace effect

Make Trace effect composable and make it possible to trace any value,
not just String.

Some convenient handlers provided.
---
 src/Control/Monad/Freer/Trace.hs | 48 ++++++++++++++++++++++++--------
 1 file changed, 36 insertions(+), 12 deletions(-)

diff --git a/src/Control/Monad/Freer/Trace.hs b/src/Control/Monad/Freer/Trace.hs
index d617732..fcc34c3 100644
--- a/src/Control/Monad/Freer/Trace.hs
+++ b/src/Control/Monad/Freer/Trace.hs
@@ -2,6 +2,7 @@
 {-# LANGUAGE FlexibleContexts #-}
 {-# LANGUAGE GADTs #-}
 {-# LANGUAGE NoImplicitPrelude #-}
+{-# LANGUAGE ScopedTypeVariables #-}
 {-# LANGUAGE TypeOperators #-}
 -- |
 -- Module:       Control.Monad.Freer.Trace
@@ -20,27 +21,50 @@ module Control.Monad.Freer.Trace
     ( Trace(..)
     , trace
     , runTrace
+    , runTraceIO
+    , runTraceSilent
     )
   where
 
-import Control.Monad ((>>), return)
-import Data.Function ((.))
+import Control.Monad ((>>=), return)
+import Data.Either (Either(Left, Right))
+import Data.Function ((.), const)
 import Data.String (String)
 import System.IO (IO, putStrLn)
 
-import Control.Monad.Freer.Internal (Eff(E, Val), Member, extract, qApp, send)
+import Control.Monad.Freer.Internal
+    (Eff(E, Val), Member, decomp, qApp, send, tsingleton)
 
 
--- | A Trace effect; takes a 'String' and performs output.
-data Trace a where
-    Trace :: String -> Trace ()
+-- | A Trace effect.
+data Trace s a where
+    Trace :: s -> Trace s ()
 
 -- | Printing a string in a trace.
-trace :: Member Trace effs => String -> Eff effs ()
+trace :: Member (Trace s) effs => s -> Eff effs ()
 trace = send . Trace
 
--- | An 'IO' handler for 'Trace' effects.
-runTrace :: Eff '[Trace] a -> IO a
-runTrace (Val x) = return x
-runTrace (E u q) = case extract u of
-    Trace s -> putStrLn s >> runTrace (qApp q ())
+-- | Generic runner for 'Trace' effect.
+runTrace
+    :: (s -> Eff effs ())
+    -- ^ Function to trace 's' in terms of effect stack without 'Trace'.
+    -> 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))
+
+-- | Simple runner for 'Trace String'.
+runTraceIO :: Member IO effs => Eff (Trace String ': effs) a -> Eff effs a
+runTraceIO = runTrace (send . putStrLn)
+
+-- | Ignore traces.
+runTraceSilent
+    :: forall proxy effs s a
+    . proxy s
+    -- ^ Proxy for what traces to throw away.
+    -> Eff (Trace s ': effs) a -> Eff effs a
+runTraceSilent p = runTrace (f p)
+  where
+    f :: proxy s -> s -> Eff effs ()
+    f _ = const (return ())

From c4cb0779737da123b671952a87d22a5ff0f6f643 Mon Sep 17 00:00:00 2001
From: Matej Kollar <208115@mail.muni.cz>
Date: Wed, 22 Mar 2017 01:04:10 +0100
Subject: [PATCH 2/9] Fixing tests after breaking changes

---
 freer-effects.cabal  |  1 +
 tests/Tests.hs       |  4 +++-
 tests/Tests/Trace.hs | 35 +++++++++++++++++++++++++++++++++++
 3 files changed, 39 insertions(+), 1 deletion(-)
 create mode 100644 tests/Tests/Trace.hs

diff --git a/freer-effects.cabal b/freer-effects.cabal
index 7874274..a7e8d03 100644
--- a/freer-effects.cabal
+++ b/freer-effects.cabal
@@ -150,6 +150,7 @@ test-suite unit
       Tests.NonDet
       Tests.Reader
       Tests.State
+      Tests.Trace
   default-language: Haskell2010
 
 benchmark core
diff --git a/tests/Tests.hs b/tests/Tests.hs
index 8ac4c77..977823e 100644
--- a/tests/Tests.hs
+++ b/tests/Tests.hs
@@ -18,10 +18,11 @@ import Control.Monad.Freer (run)
 import qualified Tests.Coroutine (tests)
 import qualified Tests.Exception (tests)
 import qualified Tests.Fresh (tests)
+import qualified Tests.Loop (tests)
 import qualified Tests.NonDet (tests)
 import qualified Tests.Reader (tests)
 import qualified Tests.State (tests)
-import qualified Tests.Loop (tests)
+import qualified Tests.Trace (tests)
 
 
 --------------------------------------------------------------------------------
@@ -49,4 +50,5 @@ main = defaultMain $ testGroup "Tests"
     , Tests.Reader.tests
     , Tests.State.tests
     , Tests.Loop.tests
+    , Tests.Trace.tests
     ]
diff --git a/tests/Tests/Trace.hs b/tests/Tests/Trace.hs
new file mode 100644
index 0000000..a374caa
--- /dev/null
+++ b/tests/Tests/Trace.hs
@@ -0,0 +1,35 @@
+{-# LANGUAGE NoImplicitPrelude #-}
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE IncoherentInstances #-}
+module Tests.Trace (tests)
+  where
+
+import Control.Monad (mapM_)
+import Data.Function (($), (.))
+import Data.Int (Int)
+import Data.Tuple (snd)
+
+import Test.Tasty (TestTree, testGroup)
+import Test.Tasty.HUnit ((@?=), testCase)
+
+import Control.Monad.Freer (Eff, Member, run)
+import Control.Monad.Freer.Trace (Trace, runTrace, trace)
+import Control.Monad.Freer.Writer (Writer, runWriter, tell)
+
+
+tests :: TestTree
+tests = testGroup "Trace tests"
+    [ testCase "Trace as Writer"
+        $ exampleRunned @?= [1..10]
+    ]
+
+type IntTrace = Trace Int
+
+example :: Member IntTrace r => Eff r ()
+example = mapM_ trace [1..10::Int]
+
+exampleRunned :: [Int]
+exampleRunned = snd $ run $ runWriter $ runTrace tracer example
+  where
+    tracer :: Member (Writer [Int]) effs => Int -> Eff effs ()
+    tracer = tell . (:[])

From d6d2675a972f7ed1ebd61112bb1af857378f76cd Mon Sep 17 00:00:00 2001
From: Matej Kollar <208115@mail.muni.cz>
Date: Wed, 22 Mar 2017 15:00:06 +0100
Subject: [PATCH 3/9] Fixing examples after breaking changes

---
 examples/src/Fresh.hs |  7 ++++---
 examples/src/Trace.hs | 13 +++++++------
 2 files changed, 11 insertions(+), 9 deletions(-)

diff --git a/examples/src/Fresh.hs b/examples/src/Fresh.hs
index 0dff9d2..e5dd287 100644
--- a/examples/src/Fresh.hs
+++ b/examples/src/Fresh.hs
@@ -1,13 +1,14 @@
 {-# LANGUAGE NoImplicitPrelude #-}
 module Fresh (module Fresh) where
 
-import Data.Function (($), flip)
+import Data.Function (($), (.), flip)
 import Data.Monoid ((<>))
 import System.IO (IO)
 import Text.Show (show)
 
+import Control.Monad.Freer (runM)
 import Control.Monad.Freer.Fresh (evalFresh, fresh)
-import Control.Monad.Freer.Trace (runTrace, trace)
+import Control.Monad.Freer.Trace (runTraceIO, trace)
 
 
 -- | Generate two fresh values.
@@ -16,7 +17,7 @@ import Control.Monad.Freer.Trace (runTrace, trace)
 -- Fresh 0
 -- Fresh 1
 traceFresh :: IO ()
-traceFresh = runTrace $ flip evalFresh 0 $ do
+traceFresh = runM . runTraceIO $ flip evalFresh 0 $ do
     n <- fresh
     trace $ "Fresh " <> show n
     n' <- fresh
diff --git a/examples/src/Trace.hs b/examples/src/Trace.hs
index 2add020..e7049e6 100644
--- a/examples/src/Trace.hs
+++ b/examples/src/Trace.hs
@@ -6,21 +6,22 @@ module Trace (module Trace) where
 import Prelude ((+))
 
 import Control.Applicative ((<$>), (<*>), pure)
-import Data.Function (($))
+import Data.Function (($), (.))
 import Data.Int (Int)
 import Data.Monoid ((<>))
+import Data.String (String)
 import System.IO (IO)
 import Text.Show (Show(show))
 
-import Control.Monad.Freer (Eff, Member)
+import Control.Monad.Freer (Eff, Member, runM)
 import Control.Monad.Freer.Reader (ask, runReader)
-import Control.Monad.Freer.Trace (Trace, runTrace, trace)
+import Control.Monad.Freer.Trace (Trace, runTraceIO, trace)
 
 
 -- Higher-order effectful function
 -- The inferred type shows that the Trace affect is added to the effects
 -- of r
-mapMdebug:: (Show a, Member Trace r) =>
+mapMdebug:: (Show a, Member (Trace String) r) =>
      (a -> Eff r b) -> [a] -> Eff r [b]
 mapMdebug _ [] = pure []
 mapMdebug f (h:t) = do
@@ -30,7 +31,7 @@ mapMdebug f (h:t) = do
   pure (h':t')
 
 tMd :: IO [Int]
-tMd = runTrace $ runReader (mapMdebug f [1..5]) (10::Int)
+tMd = runM . runTraceIO $ runReader (mapMdebug f [1..5]) (10::Int)
  where f x = (+) <$> ask <*> pure x
 {-
 mapMdebug: 1
@@ -43,7 +44,7 @@ mapMdebug: 5
 
 -- duplicate layers
 tdup :: IO ()
-tdup = runTrace $ runReader m (10::Int)
+tdup = runM . runTraceIO $ runReader m (10::Int)
  where
  m = do
      runReader tr (20::Int)

From 3f561efdff915b92f4b82332afe4cdf4fe90b0dd Mon Sep 17 00:00:00 2001
From: Matej Kollar <208115@mail.muni.cz>
Date: Sun, 26 Mar 2017 12:26:06 +0200
Subject: [PATCH 4/9] Extend documentation of Trace effect a little

Structure similar to Reader effect.
(Hopefully) inspiring example.
---
 src/Control/Monad/Freer/Trace.hs | 82 +++++++++++++++++++++++++++++---
 1 file changed, 75 insertions(+), 7 deletions(-)

diff --git a/src/Control/Monad/Freer/Trace.hs b/src/Control/Monad/Freer/Trace.hs
index fcc34c3..df3d259 100644
--- a/src/Control/Monad/Freer/Trace.hs
+++ b/src/Control/Monad/Freer/Trace.hs
@@ -13,16 +13,25 @@
 -- Stability:    experimental
 -- Portability:  GHC specific language extensions.
 --
--- Composable handler for 'Trace' effects. Trace allows one to debug the
--- operation of sequences of effects by outputing to the console.
+-- Composable handler for 'Trace' effects. Trace allows one to debug/log the
+-- operation of sequences of effects.
 --
 -- Using <http://okmij.org/ftp/Haskell/extensible/Eff1.hs> as a starting point.
 module Control.Monad.Freer.Trace
-    ( Trace(..)
+    (
+    -- * Trace Effect
+      Trace(..)
+
+    -- * Trace Operations
     , trace
+
+    -- * Trace Handlers
     , runTrace
     , runTraceIO
     , runTraceSilent
+
+    -- * Example: Simple Logging Facility
+    -- $simpleLoggingFacility
     )
   where
 
@@ -40,21 +49,21 @@ import Control.Monad.Freer.Internal
 data Trace s a where
     Trace :: s -> Trace s ()
 
--- | Printing a string in a trace.
+-- | Trace a value.
 trace :: Member (Trace s) effs => s -> Eff effs ()
 trace = send . Trace
 
--- | Generic runner for 'Trace' effect.
+-- | Generic handler for 'Trace' effect.
 runTrace
     :: (s -> Eff effs ())
-    -- ^ Function to trace 's' in terms of effect stack without 'Trace'.
+    -- ^ 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))
 
--- | Simple runner for 'Trace String'.
+-- | Simple handler for 'Trace' 'String' that just writes it to stdout.
 runTraceIO :: Member IO effs => Eff (Trace String ': effs) a -> Eff effs a
 runTraceIO = runTrace (send . putStrLn)
 
@@ -68,3 +77,62 @@ runTraceSilent p = runTrace (f p)
   where
     f :: proxy s -> s -> Eff effs ()
     f _ = const (return ())
+
+-- $simpleLoggingFacility
+--
+-- In this example the 'Trace' effect is used to provide logging facility.
+-- Handler @runLogger@ provides user with ability to filter based
+-- on @LogLevel@ and is able to log to any 'Handle' provided.
+--
+-- As a simple exercise one can modify @runLogger@ handler so that it
+-- prefixes each log line with timestamp.
+--
+-- > {-# LANGUAGE DataKinds #-}
+-- > {-# LANGUAGE ExistentialQuantification #-}
+-- > {-# LANGUAGE FlexibleContexts #-}
+-- > {-# LANGUAGE RecordWildCards #-}
+-- > {-# LANGUAGE TypeOperators #-}
+-- > module SimpleLogging where
+-- >
+-- > import Control.Monad (when)
+-- > import System.IO (Handle, hPrint)
+-- >
+-- > import Control.Monad.Freer
+-- > import Control.Monad.Freer.Trace
+-- >
+-- > data LogLevel = Debug | Info | Warn | Error
+-- >   deriving (Eq, Show, Ord)
+-- >
+-- > data Log = forall a . Show a => Log
+-- >     { level :: LogLevel
+-- >     , item :: a
+-- >     }
+-- >
+-- > type Logger = Trace Log
+-- >
+-- > newtype Msg = Msg String
+-- >
+-- > instance Show Msg where
+-- >     show (Msg s) = s
+-- >
+-- > debug :: (Member Logger effs, Show a) => a -> Eff effs ()
+-- > debug = trace . Log Debug
+-- >
+-- > info :: (Member Logger effs, Show a) => a -> Eff effs ()
+-- > info = trace . Log Info
+-- >
+-- > -- ... warn, error
+-- >
+-- > debugMsg :: Member Logger effs => String -> Eff effs ()
+-- > debugMsg = debug . Msg
+-- >
+-- > -- ... infoMsg, warnMsg, errorMsg
+-- >
+-- > runLogger
+-- >     :: Member IO effs
+-- >     => Handle
+-- >     -> LogLevel
+-- >     -> Eff (Trace Log ': effs) a -> Eff effs a
+-- > runLogger h l = runTrace f
+-- >   where
+-- >     f Log{..} = when (l <= level) . send $ hPrint h item

From 95e63c75e3c60f4fc8986fbcddcee1fc0e699862 Mon Sep 17 00:00:00 2001
From: Matej Kollar <208115@mail.muni.cz>
Date: Sun, 26 Mar 2017 14:13:12 +0200
Subject: [PATCH 5/9] Example that shows how Trace effect can be used

---
 examples/src/Trace.hs | 146 ++++++++++++++++++++++++++++--------------
 1 file changed, 99 insertions(+), 47 deletions(-)

diff --git a/examples/src/Trace.hs b/examples/src/Trace.hs
index e7049e6..bf31134 100644
--- a/examples/src/Trace.hs
+++ b/examples/src/Trace.hs
@@ -1,58 +1,110 @@
+{-# LANGUAGE ConstraintKinds #-}
+{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE ExistentialQuantification #-}
 {-# LANGUAGE FlexibleContexts #-}
 {-# LANGUAGE NoImplicitPrelude #-}
 {-# LANGUAGE NoMonomorphismRestriction #-}
+{-# LANGUAGE RecordWildCards #-}
+{-# LANGUAGE TypeOperators #-}
 module Trace (module Trace) where
 
-import Prelude ((+))
+import Prelude (Bounded, Enum, Integer, (*), (-), (^), maxBound, minBound)
 
-import Control.Applicative ((<$>), (<*>), pure)
+import Control.Applicative (pure)
+import Control.Monad (forM_, void, when)
+import Data.Eq (Eq)
 import Data.Function (($), (.))
-import Data.Int (Int)
 import Data.Monoid ((<>))
+import Data.Ord (Ord, (<), (<=))
+import Data.Proxy (Proxy(Proxy))
 import Data.String (String)
-import System.IO (IO)
+import System.IO (IO, print, putStrLn)
 import Text.Show (Show(show))
 
-import Control.Monad.Freer (Eff, Member, runM)
-import Control.Monad.Freer.Reader (ask, runReader)
-import Control.Monad.Freer.Trace (Trace, runTraceIO, trace)
-
-
--- Higher-order effectful function
--- The inferred type shows that the Trace affect is added to the effects
--- of r
-mapMdebug:: (Show a, Member (Trace String) r) =>
-     (a -> Eff r b) -> [a] -> Eff r [b]
-mapMdebug _ [] = pure []
-mapMdebug f (h:t) = do
-  trace $ "mapMdebug: " <> show h
-  h' <- f h
-  t' <- mapMdebug f t
-  pure (h':t')
-
-tMd :: IO [Int]
-tMd = runM . runTraceIO $ runReader (mapMdebug f [1..5]) (10::Int)
- where f x = (+) <$> ask <*> pure x
-{-
-mapMdebug: 1
-mapMdebug: 2
-mapMdebug: 3
-mapMdebug: 4
-mapMdebug: 5
-[11,12,13,14,15]
--}
-
--- duplicate layers
-tdup :: IO ()
-tdup = runM . runTraceIO $ runReader m (10::Int)
- where
- m = do
-     runReader tr (20::Int)
-     tr
- tr = do
-      v <- ask
-      trace $ "Asked: " <> show (v::Int)
-{-
-Asked: 20
-Asked: 10
--}
+import Control.Monad.Freer (Eff, Member, Members, run, runM, send)
+import Control.Monad.Freer.State (State, execState, get, modify)
+import Control.Monad.Freer.Trace (Trace, runTrace, runTraceSilent, trace)
+
+
+data LogLevel = Debug | Info | Warn | Error
+  deriving (Bounded, Enum, Eq, Ord, Show)
+
+data LogItem = forall a . Show a => LogItem
+    { level :: LogLevel
+    , item :: a
+    }
+
+type Logger = Trace LogItem
+
+newtype Msg = Msg String
+
+instance Show Msg where
+    show (Msg s) = s
+
+debug :: (Member Logger effs, Show a) => a -> Eff effs ()
+debug = trace . LogItem Debug
+
+info :: (Member Logger effs, Show a) => a -> Eff effs ()
+info = trace . LogItem Info
+
+warn :: (Member Logger effs, Show a) => a -> Eff effs ()
+warn = trace . LogItem Warn
+
+debugMsg :: Member Logger effs => String -> Eff effs ()
+debugMsg = debug . Msg
+
+infoMsg :: Member Logger effs => String -> Eff effs ()
+infoMsg = info . Msg
+
+warnMsg :: Member Logger effs => String -> Eff effs ()
+warnMsg = warn . Msg
+
+runLogger
+    :: Member IO effs
+    => LogLevel -> Eff (Logger ': effs) a -> Eff effs a
+runLogger l = runTrace f
+  where
+    f LogItem{..} = when (l <= level) . send $ print item
+
+data FactState = FactState
+    { bits :: Integer
+    , currentValue :: Integer
+    }
+  deriving Show
+
+_bits :: (Integer -> Integer) -> FactState -> FactState
+_bits f s@FactState{..} = s{bits=f bits}
+
+_currentValue :: (Integer -> Integer) -> FactState -> FactState
+_currentValue f s@FactState{..} = s{currentValue=f currentValue}
+
+example :: IO ()
+example = do
+    forM_ [minBound..maxBound] $ \ ll -> do
+        putStrLn $ "Running `factDebug 10` with LogLevel = " <> show ll
+        void . runM . runLogger ll $ factDebug 10
+        putStrLn "Done...\n\n"
+    putStrLn "Fact as a pure function: "
+    print $ fact 10
+
+fact :: Integer -> Integer
+fact = purify . factDebug
+  where
+    purify = run . runTraceSilent (Proxy :: Proxy LogItem)
+
+factDebug :: Member Logger effs => Integer -> Eff effs Integer
+factDebug n = do
+    val@FactState{..} <- execState (factDebug' n) (FactState 8 1)
+    info (Msg "Result", val)
+    pure currentValue
+
+factDebug' :: Members [State FactState, Logger] effs => Integer -> Eff effs ()
+factDebug' n = forM_ [1..n] $ \m -> do
+    modify $ _currentValue (m*)
+    FactState{..} <- get
+    debug (Msg "current step", m, currentValue)
+    when (maxFromBits bits < currentValue) $ do
+        warnMsg $ "Value too large for " <> show bits <> " bit store"
+        modify $ _bits (2*)
+  where
+    maxFromBits b = 2^(b - 1) - 1

From 08501332f039f785cf7c27deb0433cdbbd9cd703 Mon Sep 17 00:00:00 2001
From: Matej Kollar <208115@mail.muni.cz>
Date: Sun, 26 Mar 2017 14:27:40 +0200
Subject: [PATCH 6/9] One more example in the documentation

---
 src/Control/Monad/Freer/Trace.hs | 57 +++++++++++++++++++++++++++++++-
 1 file changed, 56 insertions(+), 1 deletion(-)

diff --git a/src/Control/Monad/Freer/Trace.hs b/src/Control/Monad/Freer/Trace.hs
index df3d259..41117b8 100644
--- a/src/Control/Monad/Freer/Trace.hs
+++ b/src/Control/Monad/Freer/Trace.hs
@@ -30,8 +30,11 @@ module Control.Monad.Freer.Trace
     , runTraceIO
     , runTraceSilent
 
-    -- * Example: Simple Logging Facility
+    -- * Example 1: Simple Logging Facility
     -- $simpleLoggingFacility
+
+    -- * Example 2: Debugging Pure Functions
+    -- $debuggingPureFunctions
     )
   where
 
@@ -136,3 +139,55 @@ runTraceSilent p = runTrace (f p)
 -- > runLogger h l = runTrace f
 -- >   where
 -- >     f Log{..} = when (l <= level) . send $ hPrint h item
+--
+
+-- $debuggingPureFunctions
+--
+-- Even happened to you that you needed to trace pure function?
+-- Write your function using 'Trace' effect and then use 'runTraceSilent'.
+--
+-- Using code from previous example (for complete example look into @examples@
+-- directory in the source tree):
+--
+-- > data FactState = FactState
+-- >     { bits :: Integer
+-- >     , currentValue :: Integer
+-- >     }
+-- >   deriving Show
+-- >
+-- > _bits :: (Integer -> Integer) -> FactState -> FactState
+-- > _bits f s@FactState{..} = s{bits=f bits}
+-- >
+-- > _currentValue :: (Integer -> Integer) -> FactState -> FactState
+-- > _currentValue f s@FactState{..} = s{currentValue=f currentValue}
+-- >
+-- > example :: IO ()
+-- > example = do
+-- >     forM_ [minBound..maxBound] $ \ ll -> do
+-- >         putStrLn $ "Running `factDebug 10` with LogLevel = " <> show ll
+-- >         void . runM . runLogger ll $ factDebug 10
+-- >         putStrLn "Done...\n\n"
+-- >     putStrLn "Fact as a pure function: "
+-- >     print $ fact 10
+-- >
+-- > fact :: Integer -> Integer
+-- > fact = purify . factDebug
+-- >   where
+-- >     purify = run . runTraceSilent (Proxy :: Proxy LogItem)
+-- >
+-- > factDebug :: Member Logger effs => Integer -> Eff effs Integer
+-- > factDebug n = do
+-- >     val@FactState{..} <- execState (factDebug' n) (FactState 8 1)
+-- >     info (Msg "Result", val)
+-- >     pure currentValue
+-- >
+-- > factDebug' :: Members [State FactState, Logger] effs => Integer -> Eff effs ()
+-- > factDebug' n = forM_ [1..n] $ \m -> do
+-- >     modify $ _currentValue (m*)
+-- >     FactState{..} <- get
+-- >     debug (Msg "current step", m, currentValue)
+-- >     when (maxFromBits bits < currentValue) $ do
+-- >         warnMsg $ "Value too large for " <> show bits <> " bit store"
+-- >         modify $ _bits (2*)
+-- >   where
+-- >     maxFromBits b = 2^(b - 1) - 1

From 677aeb34e831951ee096fcf07fb82921f80ffd28 Mon Sep 17 00:00:00 2001
From: Matej Kollar <208115@mail.muni.cz>
Date: Sun, 26 Mar 2017 14:33:55 +0200
Subject: [PATCH 7/9] Changelog update

---
 changelog.md | 3 +++
 1 file changed, 3 insertions(+)

diff --git a/changelog.md b/changelog.md
index 5c49d24..6b0df02 100644
--- a/changelog.md
+++ b/changelog.md
@@ -29,6 +29,9 @@ All notable changes to this project will be documented in this file.
 * Introduced `raise` to weaken an effect stack.
   [PR #41](https://github.com/IxpertaSolutions/freer-effects/pull/41)
   (**new**)
+* Generalized `Trace` effect.
+  [PR #30](https://github.com/IxpertaSolutions/freer-effects/pull/30)
+  (**breaking-change**)
 
 ## [0.3.0.1] (April 16, 2017)
 

From cf4b479a99280c3f881bbb930fe00487891def1b Mon Sep 17 00:00:00 2001
From: Matej Kollar <208115@mail.muni.cz>
Date: Fri, 21 Apr 2017 15:27:47 +0200
Subject: [PATCH 8/9] Trace to stderr by default

---
 src/Control/Monad/Freer/Trace.hs | 4 ++--
 1 file changed, 2 insertions(+), 2 deletions(-)

diff --git a/src/Control/Monad/Freer/Trace.hs b/src/Control/Monad/Freer/Trace.hs
index 41117b8..6982dc9 100644
--- a/src/Control/Monad/Freer/Trace.hs
+++ b/src/Control/Monad/Freer/Trace.hs
@@ -42,7 +42,7 @@ import Control.Monad ((>>=), return)
 import Data.Either (Either(Left, Right))
 import Data.Function ((.), const)
 import Data.String (String)
-import System.IO (IO, putStrLn)
+import System.IO (IO, hPutStrLn, stderr)
 
 import Control.Monad.Freer.Internal
     (Eff(E, Val), Member, decomp, qApp, send, tsingleton)
@@ -68,7 +68,7 @@ runTrace f (E u q) = case decomp u of
 
 -- | Simple handler for 'Trace' 'String' that just writes it to stdout.
 runTraceIO :: Member IO effs => Eff (Trace String ': effs) a -> Eff effs a
-runTraceIO = runTrace (send . putStrLn)
+runTraceIO = runTrace (send . hPutStrLn stderr)
 
 -- | Ignore traces.
 runTraceSilent

From 61762edfa3a1f9b22484742535260e675533aa00 Mon Sep 17 00:00:00 2001
From: Matej Kollar <208115@mail.muni.cz>
Date: Thu, 11 May 2017 23:52:31 +0200
Subject: [PATCH 9/9] Use `handleRelay` instead of explicit handling

---
 src/Control/Monad/Freer/Trace.hs | 24 ++++++++++++------------
 1 file changed, 12 insertions(+), 12 deletions(-)

diff --git a/src/Control/Monad/Freer/Trace.hs b/src/Control/Monad/Freer/Trace.hs
index 6982dc9..c6cbb3b 100644
--- a/src/Control/Monad/Freer/Trace.hs
+++ b/src/Control/Monad/Freer/Trace.hs
@@ -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.
@@ -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
@@ -79,7 +79,7 @@ runTraceSilent
 runTraceSilent p = runTrace (f p)
   where
     f :: proxy s -> s -> Eff effs ()
-    f _ = const (return ())
+    f _ = const (pure ())
 
 -- $simpleLoggingFacility
 --