{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE UndecidableInstances #-}

-- | A carrier for the 'Control.Effect.Trace' effect that aggregates and returns all traced values.
--
-- @since 1.0.0.0
module Control.Carrier.Trace.Returning
( -- * Trace carrier
  runTrace
, TraceC(..)
  -- * Trace effect
, module Control.Effect.Trace
) where

import           Control.Algebra
import           Control.Applicative (Alternative(..))
import           Control.Carrier.Writer.Strict
import           Control.Effect.Trace
import           Control.Monad (MonadPlus(..))
import qualified Control.Monad.Fail as Fail
import           Control.Monad.Fix
import           Control.Monad.IO.Class
import           Control.Monad.Trans.Class
import           Data.Bifunctor (first)
import           Data.Monoid (Endo(..))

-- | Run a 'Trace' effect, returning all traces as a list.
--
-- @
-- 'runTrace' ('pure' a) = 'pure' ([], a)
-- @
-- @
-- 'runTrace' ('trace' s) = 'pure' ([s], ())
-- @
--
-- @since 1.0.0.0
runTrace :: Functor m => TraceC m a -> m ([String], a)
runTrace :: TraceC m a -> m ([String], a)
runTrace (TraceC m :: WriterC (Endo [String]) m a
m) = (Endo [String] -> [String]) -> (Endo [String], a) -> ([String], a)
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first ((([String] -> [String]) -> [String] -> [String]
forall a b. (a -> b) -> a -> b
$[]) (([String] -> [String]) -> [String])
-> (Endo [String] -> [String] -> [String])
-> Endo [String]
-> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Endo [String] -> [String] -> [String]
forall a. Endo a -> a -> a
appEndo) ((Endo [String], a) -> ([String], a))
-> m (Endo [String], a) -> m ([String], a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> WriterC (Endo [String]) m a -> m (Endo [String], a)
forall w (m :: * -> *) a. Monoid w => WriterC w m a -> m (w, a)
runWriter WriterC (Endo [String]) m a
m

-- | @since 1.0.0.0
newtype TraceC m a = TraceC (WriterC (Endo [String]) m a)
  deriving (Applicative (TraceC m)
TraceC m a
Applicative (TraceC m) =>
(forall a. TraceC m a)
-> (forall a. TraceC m a -> TraceC m a -> TraceC m a)
-> (forall a. TraceC m a -> TraceC m [a])
-> (forall a. TraceC m a -> TraceC m [a])
-> Alternative (TraceC m)
TraceC m a -> TraceC m a -> TraceC m a
TraceC m a -> TraceC m [a]
TraceC m a -> TraceC m [a]
forall a. TraceC m a
forall a. TraceC m a -> TraceC m [a]
forall a. TraceC m a -> TraceC m a -> TraceC m a
forall (f :: * -> *).
Applicative f =>
(forall a. f a)
-> (forall a. f a -> f a -> f a)
-> (forall a. f a -> f [a])
-> (forall a. f a -> f [a])
-> Alternative f
forall (m :: * -> *).
(Alternative m, Monad m) =>
Applicative (TraceC m)
forall (m :: * -> *) a. (Alternative m, Monad m) => TraceC m a
forall (m :: * -> *) a.
(Alternative m, Monad m) =>
TraceC m a -> TraceC m [a]
forall (m :: * -> *) a.
(Alternative m, Monad m) =>
TraceC m a -> TraceC m a -> TraceC m a
many :: TraceC m a -> TraceC m [a]
$cmany :: forall (m :: * -> *) a.
(Alternative m, Monad m) =>
TraceC m a -> TraceC m [a]
some :: TraceC m a -> TraceC m [a]
$csome :: forall (m :: * -> *) a.
(Alternative m, Monad m) =>
TraceC m a -> TraceC m [a]
<|> :: TraceC m a -> TraceC m a -> TraceC m a
$c<|> :: forall (m :: * -> *) a.
(Alternative m, Monad m) =>
TraceC m a -> TraceC m a -> TraceC m a
empty :: TraceC m a
$cempty :: forall (m :: * -> *) a. (Alternative m, Monad m) => TraceC m a
$cp1Alternative :: forall (m :: * -> *).
(Alternative m, Monad m) =>
Applicative (TraceC m)
Alternative, Functor (TraceC m)
a -> TraceC m a
Functor (TraceC m) =>
(forall a. a -> TraceC m a)
-> (forall a b. TraceC m (a -> b) -> TraceC m a -> TraceC m b)
-> (forall a b c.
    (a -> b -> c) -> TraceC m a -> TraceC m b -> TraceC m c)
-> (forall a b. TraceC m a -> TraceC m b -> TraceC m b)
-> (forall a b. TraceC m a -> TraceC m b -> TraceC m a)
-> Applicative (TraceC m)
TraceC m a -> TraceC m b -> TraceC m b
TraceC m a -> TraceC m b -> TraceC m a
TraceC m (a -> b) -> TraceC m a -> TraceC m b
(a -> b -> c) -> TraceC m a -> TraceC m b -> TraceC m c
forall a. a -> TraceC m a
forall a b. TraceC m a -> TraceC m b -> TraceC m a
forall a b. TraceC m a -> TraceC m b -> TraceC m b
forall a b. TraceC m (a -> b) -> TraceC m a -> TraceC m b
forall a b c.
(a -> b -> c) -> TraceC m a -> TraceC m b -> TraceC m c
forall (m :: * -> *). Monad m => Functor (TraceC m)
forall (m :: * -> *) a. Monad m => a -> TraceC m a
forall (m :: * -> *) a b.
Monad m =>
TraceC m a -> TraceC m b -> TraceC m a
forall (m :: * -> *) a b.
Monad m =>
TraceC m a -> TraceC m b -> TraceC m b
forall (m :: * -> *) a b.
Monad m =>
TraceC m (a -> b) -> TraceC m a -> TraceC m b
forall (m :: * -> *) a b c.
Monad m =>
(a -> b -> c) -> TraceC m a -> TraceC m b -> TraceC m c
forall (f :: * -> *).
Functor f =>
(forall a. a -> f a)
-> (forall a b. f (a -> b) -> f a -> f b)
-> (forall a b c. (a -> b -> c) -> f a -> f b -> f c)
-> (forall a b. f a -> f b -> f b)
-> (forall a b. f a -> f b -> f a)
-> Applicative f
<* :: TraceC m a -> TraceC m b -> TraceC m a
$c<* :: forall (m :: * -> *) a b.
Monad m =>
TraceC m a -> TraceC m b -> TraceC m a
*> :: TraceC m a -> TraceC m b -> TraceC m b
$c*> :: forall (m :: * -> *) a b.
Monad m =>
TraceC m a -> TraceC m b -> TraceC m b
liftA2 :: (a -> b -> c) -> TraceC m a -> TraceC m b -> TraceC m c
$cliftA2 :: forall (m :: * -> *) a b c.
Monad m =>
(a -> b -> c) -> TraceC m a -> TraceC m b -> TraceC m c
<*> :: TraceC m (a -> b) -> TraceC m a -> TraceC m b
$c<*> :: forall (m :: * -> *) a b.
Monad m =>
TraceC m (a -> b) -> TraceC m a -> TraceC m b
pure :: a -> TraceC m a
$cpure :: forall (m :: * -> *) a. Monad m => a -> TraceC m a
$cp1Applicative :: forall (m :: * -> *). Monad m => Functor (TraceC m)
Applicative, a -> TraceC m b -> TraceC m a
(a -> b) -> TraceC m a -> TraceC m b
(forall a b. (a -> b) -> TraceC m a -> TraceC m b)
-> (forall a b. a -> TraceC m b -> TraceC m a)
-> Functor (TraceC m)
forall a b. a -> TraceC m b -> TraceC m a
forall a b. (a -> b) -> TraceC m a -> TraceC m b
forall (m :: * -> *) a b.
Functor m =>
a -> TraceC m b -> TraceC m a
forall (m :: * -> *) a b.
Functor m =>
(a -> b) -> TraceC m a -> TraceC m b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> TraceC m b -> TraceC m a
$c<$ :: forall (m :: * -> *) a b.
Functor m =>
a -> TraceC m b -> TraceC m a
fmap :: (a -> b) -> TraceC m a -> TraceC m b
$cfmap :: forall (m :: * -> *) a b.
Functor m =>
(a -> b) -> TraceC m a -> TraceC m b
Functor, Applicative (TraceC m)
a -> TraceC m a
Applicative (TraceC m) =>
(forall a b. TraceC m a -> (a -> TraceC m b) -> TraceC m b)
-> (forall a b. TraceC m a -> TraceC m b -> TraceC m b)
-> (forall a. a -> TraceC m a)
-> Monad (TraceC m)
TraceC m a -> (a -> TraceC m b) -> TraceC m b
TraceC m a -> TraceC m b -> TraceC m b
forall a. a -> TraceC m a
forall a b. TraceC m a -> TraceC m b -> TraceC m b
forall a b. TraceC m a -> (a -> TraceC m b) -> TraceC m b
forall (m :: * -> *). Monad m => Applicative (TraceC m)
forall (m :: * -> *) a. Monad m => a -> TraceC m a
forall (m :: * -> *) a b.
Monad m =>
TraceC m a -> TraceC m b -> TraceC m b
forall (m :: * -> *) a b.
Monad m =>
TraceC m a -> (a -> TraceC m b) -> TraceC m b
forall (m :: * -> *).
Applicative m =>
(forall a b. m a -> (a -> m b) -> m b)
-> (forall a b. m a -> m b -> m b)
-> (forall a. a -> m a)
-> Monad m
return :: a -> TraceC m a
$creturn :: forall (m :: * -> *) a. Monad m => a -> TraceC m a
>> :: TraceC m a -> TraceC m b -> TraceC m b
$c>> :: forall (m :: * -> *) a b.
Monad m =>
TraceC m a -> TraceC m b -> TraceC m b
>>= :: TraceC m a -> (a -> TraceC m b) -> TraceC m b
$c>>= :: forall (m :: * -> *) a b.
Monad m =>
TraceC m a -> (a -> TraceC m b) -> TraceC m b
$cp1Monad :: forall (m :: * -> *). Monad m => Applicative (TraceC m)
Monad, Monad (TraceC m)
Monad (TraceC m) =>
(forall a. String -> TraceC m a) -> MonadFail (TraceC m)
String -> TraceC m a
forall a. String -> TraceC m a
forall (m :: * -> *).
Monad m =>
(forall a. String -> m a) -> MonadFail m
forall (m :: * -> *). MonadFail m => Monad (TraceC m)
forall (m :: * -> *) a. MonadFail m => String -> TraceC m a
fail :: String -> TraceC m a
$cfail :: forall (m :: * -> *) a. MonadFail m => String -> TraceC m a
$cp1MonadFail :: forall (m :: * -> *). MonadFail m => Monad (TraceC m)
Fail.MonadFail, Monad (TraceC m)
Monad (TraceC m) =>
(forall a. (a -> TraceC m a) -> TraceC m a) -> MonadFix (TraceC m)
(a -> TraceC m a) -> TraceC m a
forall a. (a -> TraceC m a) -> TraceC m a
forall (m :: * -> *).
Monad m =>
(forall a. (a -> m a) -> m a) -> MonadFix m
forall (m :: * -> *). MonadFix m => Monad (TraceC m)
forall (m :: * -> *) a.
MonadFix m =>
(a -> TraceC m a) -> TraceC m a
mfix :: (a -> TraceC m a) -> TraceC m a
$cmfix :: forall (m :: * -> *) a.
MonadFix m =>
(a -> TraceC m a) -> TraceC m a
$cp1MonadFix :: forall (m :: * -> *). MonadFix m => Monad (TraceC m)
MonadFix, Monad (TraceC m)
Monad (TraceC m) =>
(forall a. IO a -> TraceC m a) -> MonadIO (TraceC m)
IO a -> TraceC m a
forall a. IO a -> TraceC m a
forall (m :: * -> *).
Monad m =>
(forall a. IO a -> m a) -> MonadIO m
forall (m :: * -> *). MonadIO m => Monad (TraceC m)
forall (m :: * -> *) a. MonadIO m => IO a -> TraceC m a
liftIO :: IO a -> TraceC m a
$cliftIO :: forall (m :: * -> *) a. MonadIO m => IO a -> TraceC m a
$cp1MonadIO :: forall (m :: * -> *). MonadIO m => Monad (TraceC m)
MonadIO, Monad (TraceC m)
Alternative (TraceC m)
TraceC m a
(Alternative (TraceC m), Monad (TraceC m)) =>
(forall a. TraceC m a)
-> (forall a. TraceC m a -> TraceC m a -> TraceC m a)
-> MonadPlus (TraceC m)
TraceC m a -> TraceC m a -> TraceC m a
forall a. TraceC m a
forall a. TraceC m a -> TraceC m a -> TraceC m a
forall (m :: * -> *). (Alternative m, Monad m) => Monad (TraceC m)
forall (m :: * -> *).
(Alternative m, Monad m) =>
Alternative (TraceC m)
forall (m :: * -> *).
(Alternative m, Monad m) =>
(forall a. m a) -> (forall a. m a -> m a -> m a) -> MonadPlus m
forall (m :: * -> *) a. (Alternative m, Monad m) => TraceC m a
forall (m :: * -> *) a.
(Alternative m, Monad m) =>
TraceC m a -> TraceC m a -> TraceC m a
mplus :: TraceC m a -> TraceC m a -> TraceC m a
$cmplus :: forall (m :: * -> *) a.
(Alternative m, Monad m) =>
TraceC m a -> TraceC m a -> TraceC m a
mzero :: TraceC m a
$cmzero :: forall (m :: * -> *) a. (Alternative m, Monad m) => TraceC m a
$cp2MonadPlus :: forall (m :: * -> *). (Alternative m, Monad m) => Monad (TraceC m)
$cp1MonadPlus :: forall (m :: * -> *).
(Alternative m, Monad m) =>
Alternative (TraceC m)
MonadPlus, m a -> TraceC m a
(forall (m :: * -> *) a. Monad m => m a -> TraceC m a)
-> MonadTrans TraceC
forall (m :: * -> *) a. Monad m => m a -> TraceC m a
forall (t :: (* -> *) -> * -> *).
(forall (m :: * -> *) a. Monad m => m a -> t m a) -> MonadTrans t
lift :: m a -> TraceC m a
$clift :: forall (m :: * -> *) a. Monad m => m a -> TraceC m a
MonadTrans)

instance (Algebra sig m, Effect sig) => Algebra (Trace :+: sig) (TraceC m) where
  alg :: (:+:) Trace sig (TraceC m) a -> TraceC m a
alg (L (Trace m :: String
m k :: TraceC m a
k)) = WriterC (Endo [String]) m () -> TraceC m ()
forall (m :: * -> *) a. WriterC (Endo [String]) m a -> TraceC m a
TraceC (Endo [String] -> WriterC (Endo [String]) m ()
forall w (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (Writer w) sig m =>
w -> m ()
tell (([String] -> [String]) -> Endo [String]
forall a. (a -> a) -> Endo a
Endo (String
m String -> [String] -> [String]
forall a. a -> [a] -> [a]
:))) TraceC m () -> TraceC m a -> TraceC m a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> TraceC m a
k
  alg (R other :: sig (TraceC m) a
other)       = WriterC (Endo [String]) m a -> TraceC m a
forall (m :: * -> *) a. WriterC (Endo [String]) m a -> TraceC m a
TraceC ((:+:) (Writer (Endo [String])) sig (WriterC (Endo [String]) m) a
-> WriterC (Endo [String]) m a
forall (sig :: (* -> *) -> * -> *) (m :: * -> *) a.
Algebra sig m =>
sig m a -> m a
alg (sig (WriterC (Endo [String]) m) a
-> (:+:) (Writer (Endo [String])) sig (WriterC (Endo [String]) m) a
forall (f :: (* -> *) -> * -> *) (g :: (* -> *) -> * -> *)
       (m :: * -> *) k.
g m k -> (:+:) f g m k
R (sig (TraceC m) a -> sig (WriterC (Endo [String]) m) a
forall (sig :: (* -> *) -> * -> *) (f :: * -> *) (g :: * -> *) a.
(HFunctor sig, Functor f, Coercible f g) =>
sig f a -> sig g a
handleCoercible sig (TraceC m) a
other)))