{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE BlockArguments #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE PolyKinds #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeOperators #-}
{-# OPTIONS_GHC -fplugin=Polysemy.Plugin #-}
module Polysemy.Methodology where

import Control.Monad
import Polysemy
import Polysemy.KVStore
import Polysemy.Input
import Polysemy.Output
import Polysemy.Several
import Polysemy.Trace

-- | A `Methodology` generalises a semantic process from `b` to `c`.
data Methodology b c m a where
  Process :: b -> Methodology b c m c

makeSem ''Methodology

-- | Run a `Methodology` using a pure function.
runMethodologyPure :: forall b c r a. (b -> c) -> Sem (Methodology b c ': r) a -> Sem r a 
runMethodologyPure :: (b -> c) -> Sem (Methodology b c : r) a -> Sem r a
runMethodologyPure b -> c
f = (forall x (m :: * -> *). Methodology b c m x -> Sem r x)
-> Sem (Methodology b c : r) a -> Sem r a
forall (e :: (* -> *) -> * -> *) (r :: [(* -> *) -> * -> *]) a.
FirstOrder e "interpret" =>
(forall x (m :: * -> *). e m x -> Sem r x)
-> Sem (e : r) a -> Sem r a
interpret \case
  Process b -> c -> Sem r c
forall (m :: * -> *) a. Monad m => a -> m a
return (c -> Sem r c) -> c -> Sem r c
forall a b. (a -> b) -> a -> b
$ b -> c
f b
b

-- | Run a `Methodology' using a monadic function with effects in `r`.
runMethodologySem :: forall b c r a. (b -> Sem r c) -> Sem (Methodology b c ': r) a -> Sem r a
runMethodologySem :: (b -> Sem r c) -> Sem (Methodology b c : r) a -> Sem r a
runMethodologySem b -> Sem r c
f = (forall x (m :: * -> *). Methodology b c m x -> Sem r x)
-> Sem (Methodology b c : r) a -> Sem r a
forall (e :: (* -> *) -> * -> *) (r :: [(* -> *) -> * -> *]) a.
FirstOrder e "interpret" =>
(forall x (m :: * -> *). e m x -> Sem r x)
-> Sem (e : r) a -> Sem r a
interpret \case
  Process b -> b -> Sem r c
f b
b

-- | Cut a `Methodology` into two pieces at a midpoint.
cutMethodology :: forall b c d r a.
                  Members '[ Methodology b c
                           , Methodology c d] r
               => Sem (Methodology b d ': r) a
               -> Sem r a
cutMethodology :: Sem (Methodology b d : r) a -> Sem r a
cutMethodology = (forall x (m :: * -> *). Methodology b d m x -> Sem r x)
-> Sem (Methodology b d : r) a -> Sem r a
forall (e :: (* -> *) -> * -> *) (r :: [(* -> *) -> * -> *]) a.
FirstOrder e "interpret" =>
(forall x (m :: * -> *). e m x -> Sem r x)
-> Sem (e : r) a -> Sem r a
interpret \case
  Process b -> b -> Sem r c
forall b c (r :: [(* -> *) -> * -> *]).
MemberWithError (Methodology b c) r =>
b -> Sem r c
process @b @c b
b Sem r c -> (c -> Sem r d) -> Sem r d
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall (r :: [(* -> *) -> * -> *]).
MemberWithError (Methodology c d) r =>
c -> Sem r d
forall b c (r :: [(* -> *) -> * -> *]).
MemberWithError (Methodology b c) r =>
b -> Sem r c
process @c @d

-- | Cut a `Methodology` into three pieces using two cuts.
cutMethodology3 :: forall b c d e r a.
                   Members '[ Methodology b c
                            , Methodology c d
                            , Methodology d e] r
               => Sem (Methodology b e ': r) a
               -> Sem r a
cutMethodology3 :: Sem (Methodology b e : r) a -> Sem r a
cutMethodology3 = (forall x (m :: * -> *). Methodology b e m x -> Sem r x)
-> Sem (Methodology b e : r) a -> Sem r a
forall (e :: (* -> *) -> * -> *) (r :: [(* -> *) -> * -> *]) a.
FirstOrder e "interpret" =>
(forall x (m :: * -> *). e m x -> Sem r x)
-> Sem (e : r) a -> Sem r a
interpret \case
  Process b -> b -> Sem r c
forall b c (r :: [(* -> *) -> * -> *]).
MemberWithError (Methodology b c) r =>
b -> Sem r c
process @b @c b
b Sem r c -> (c -> Sem r d) -> Sem r d
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall (r :: [(* -> *) -> * -> *]).
MemberWithError (Methodology c d) r =>
c -> Sem r d
forall b c (r :: [(* -> *) -> * -> *]).
MemberWithError (Methodology b c) r =>
b -> Sem r c
process @c @d Sem r d -> (d -> Sem r e) -> Sem r e
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall (r :: [(* -> *) -> * -> *]).
MemberWithError (Methodology d e) r =>
d -> Sem r e
forall b c (r :: [(* -> *) -> * -> *]).
MemberWithError (Methodology b c) r =>
b -> Sem r c
process @d @e

-- | Divide a `Methodology` into two components using a `Methodology` that accepts a pair.`
divideMethodology :: forall b c c' d r a.
                     Members '[ Methodology b c
                              , Methodology b c'
                              , Methodology (c, c') d] r
                  => Sem (Methodology b d ': r) a
                  -> Sem r a
divideMethodology :: Sem (Methodology b d : r) a -> Sem r a
divideMethodology = (forall x (m :: * -> *). Methodology b d m x -> Sem r x)
-> Sem (Methodology b d : r) a -> Sem r a
forall (e :: (* -> *) -> * -> *) (r :: [(* -> *) -> * -> *]) a.
FirstOrder e "interpret" =>
(forall x (m :: * -> *). e m x -> Sem r x)
-> Sem (e : r) a -> Sem r a
interpret \case
  Process b -> do
    c
c  <- b -> Sem r c
forall b c (r :: [(* -> *) -> * -> *]).
MemberWithError (Methodology b c) r =>
b -> Sem r c
process @b @c  b
b
    c'
c' <- b -> Sem r c'
forall b c (r :: [(* -> *) -> * -> *]).
MemberWithError (Methodology b c) r =>
b -> Sem r c
process @b @c' b
b
    (c, c') -> Sem r d
forall b c (r :: [(* -> *) -> * -> *]).
MemberWithError (Methodology b c) r =>
b -> Sem r c
process @(c, c') @d (c
c, c'
c')

-- | Decide between two `Methodology`s using a `Methodology` that computes an `Either`.
decideMethodology :: forall b c c' d r a.
                     Members '[ Methodology b (Either c c')
                              , Methodology c  d
                              , Methodology c' d
                              ] r
                  => Sem (Methodology b d ': r) a
                  -> Sem r a
decideMethodology :: Sem (Methodology b d : r) a -> Sem r a
decideMethodology = (forall x (m :: * -> *). Methodology b d m x -> Sem r x)
-> Sem (Methodology b d : r) a -> Sem r a
forall (e :: (* -> *) -> * -> *) (r :: [(* -> *) -> * -> *]) a.
FirstOrder e "interpret" =>
(forall x (m :: * -> *). e m x -> Sem r x)
-> Sem (e : r) a -> Sem r a
interpret \case
  Process b -> do
    Either c c'
k <- b -> Sem r (Either c c')
forall b c (r :: [(* -> *) -> * -> *]).
MemberWithError (Methodology b c) r =>
b -> Sem r c
process @b @(Either c c') b
b
    case Either c c'
k of
      Left c
c   -> c -> Sem r d
forall b c (r :: [(* -> *) -> * -> *]).
MemberWithError (Methodology b c) r =>
b -> Sem r c
process @c  @d c
c
      Right c'
c' -> c' -> Sem r d
forall b c (r :: [(* -> *) -> * -> *]).
MemberWithError (Methodology b c) r =>
b -> Sem r c
process @c' @d c'
c'

-- | Tee the output of a `Methodology`, introducing a new `Output` effect to be handled.
teeMethodologyOutput :: forall b c r a.
                  Members '[Output c, Methodology b c] r
               => Sem r a
               -> Sem r a
teeMethodologyOutput :: Sem r a -> Sem r a
teeMethodologyOutput = (forall x (m :: * -> *). Methodology b c m x -> Sem r x)
-> Sem r a -> Sem r a
forall (e :: (* -> *) -> * -> *) (r :: [(* -> *) -> * -> *]) a.
(Member e r, FirstOrder e "intercept") =>
(forall x (m :: * -> *). e m x -> Sem r x) -> Sem r a -> Sem r a
intercept \case
  Process b -> do
    c
k <- b -> Sem r c
forall b c (r :: [(* -> *) -> * -> *]).
MemberWithError (Methodology b c) r =>
b -> Sem r c
process @b @c b
b
    c -> Sem r ()
forall o (r :: [(* -> *) -> * -> *]).
MemberWithError (Output o) r =>
o -> Sem r ()
output @c c
k
    c -> Sem r c
forall (m :: * -> *) a. Monad m => a -> m a
return c
k

-- | Make a `Methodology` depend on an additional input, introducing a new `Input` effect to be handled.
plugMethodologyInput :: forall b c d r a.
                        Members '[Input b, Methodology (b, c) d] r
                     => Sem (Methodology c d ': r) a
                     -> Sem r a
plugMethodologyInput :: Sem (Methodology c d : r) a -> Sem r a
plugMethodologyInput = (forall x (m :: * -> *). Methodology c d m x -> Sem r x)
-> Sem (Methodology c d : r) a -> Sem r a
forall (e :: (* -> *) -> * -> *) (r :: [(* -> *) -> * -> *]) a.
FirstOrder e "interpret" =>
(forall x (m :: * -> *). e m x -> Sem r x)
-> Sem (e : r) a -> Sem r a
interpret \case
  Process b -> do
    b
k <- forall (r :: [(* -> *) -> * -> *]).
MemberWithError (Input b) r =>
Sem r b
forall i (r :: [(* -> *) -> * -> *]).
MemberWithError (Input i) r =>
Sem r i
input @b
    (b, c) -> Sem r d
forall b c (r :: [(* -> *) -> * -> *]).
MemberWithError (Methodology b c) r =>
b -> Sem r c
process @(b, c) @d (b
k, c
b)

-- | Run a `Methodology` as a `KVStore`, using the input as a key and the output as the value.
runMethodologyAsKVStore :: forall k v r a.
                           Members '[KVStore k v] r
                        => Sem (Methodology k (Maybe v) ': r) a
                        -> Sem r a
runMethodologyAsKVStore :: Sem (Methodology k (Maybe v) : r) a -> Sem r a
runMethodologyAsKVStore = (forall x (m :: * -> *). Methodology k (Maybe v) m x -> Sem r x)
-> Sem (Methodology k (Maybe v) : r) a -> Sem r a
forall (e :: (* -> *) -> * -> *) (r :: [(* -> *) -> * -> *]) a.
FirstOrder e "interpret" =>
(forall x (m :: * -> *). e m x -> Sem r x)
-> Sem (e : r) a -> Sem r a
interpret \case
  Process k -> k -> Sem r (Maybe v)
forall k v (r :: [(* -> *) -> * -> *]).
MemberWithError (KVStore k v) r =>
k -> Sem r (Maybe v)
lookupKV k
k

-- | Run a `Methodology` as a `KVStore`, with a default value for lookup failure.
runMethodologyAsKVStoreWithDefault :: forall k v r a.
                                      Members '[KVStore k v] r
                                   => v
                                   -> Sem (Methodology k v ': r) a
                                   -> Sem r a
runMethodologyAsKVStoreWithDefault :: v -> Sem (Methodology k v : r) a -> Sem r a
runMethodologyAsKVStoreWithDefault v
d = (forall x (m :: * -> *). Methodology k v m x -> Sem r x)
-> Sem (Methodology k v : r) a -> Sem r a
forall (e :: (* -> *) -> * -> *) (r :: [(* -> *) -> * -> *]) a.
FirstOrder e "interpret" =>
(forall x (m :: * -> *). e m x -> Sem r x)
-> Sem (e : r) a -> Sem r a
interpret \case
  Process k -> do
    Maybe x
z <- k -> Sem r (Maybe x)
forall k v (r :: [(* -> *) -> * -> *]).
MemberWithError (KVStore k v) r =>
k -> Sem r (Maybe v)
lookupKV k
k
    case Maybe x
z of 
      Just x
a -> x -> Sem r x
forall (m :: * -> *) a. Monad m => a -> m a
return x
a
      Maybe x
Nothing -> v -> Sem r v
forall (m :: * -> *) a. Monad m => a -> m a
return v
d

-- | Decompose a `Methodology` into several components to be recombined. This is `cutMethodology` specialised to `HList`.
decomposeMethodology :: forall b f c r a.
                        Members ' [Methodology b (HList f)
                                 , Methodology (HList f) c] r
                     => Sem (Methodology b c ': r) a
                     -> Sem r a
decomposeMethodology :: Sem (Methodology b c : r) a -> Sem r a
decomposeMethodology = forall (r :: [(* -> *) -> * -> *]) a.
Members '[Methodology b (HList f), Methodology (HList f) c] r =>
Sem (Methodology b c : r) a -> Sem r a
forall b c d (r :: [(* -> *) -> * -> *]) a.
Members '[Methodology b c, Methodology c d] r =>
Sem (Methodology b d : r) a -> Sem r a
cutMethodology @b @(HList f) @c

-- | Decompose a `Methodology` into several components over three sections with two cuts.
decomposeMethodology3 :: forall b f g c r a.
                         Members '[ Methodology b (HList f)
                                  , Methodology (HList f) (HList g)
                                  , Methodology (HList g) c] r
                      => Sem (Methodology b c ': r) a
                      -> Sem r a
decomposeMethodology3 :: Sem (Methodology b c : r) a -> Sem r a
decomposeMethodology3 = forall (r :: [(* -> *) -> * -> *]) a.
Members
  '[Methodology b (HList f), Methodology (HList f) (HList g),
    Methodology (HList g) c]
  r =>
Sem (Methodology b c : r) a -> Sem r a
forall b c d e (r :: [(* -> *) -> * -> *]) a.
Members '[Methodology b c, Methodology c d, Methodology d e] r =>
Sem (Methodology b e : r) a -> Sem r a
cutMethodology3 @b @(HList f) @(HList g) @c

-- | Factor a `Methodology` decomposed over an `HList` in the result by a `Methodology` to the first variable.
separateMethodologyInitial :: forall b x xs r a.
                              Members '[ Methodology b (HList xs)
                                       , Methodology b x] r
                           => Sem (Methodology b (HList (x ': xs)) ': r) a
                           -> Sem r a
separateMethodologyInitial :: Sem (Methodology b (HList (x : xs)) : r) a -> Sem r a
separateMethodologyInitial = (forall x (m :: * -> *).
 Methodology b (HList (x : xs)) m x -> Sem r x)
-> Sem (Methodology b (HList (x : xs)) : r) a -> Sem r a
forall (e :: (* -> *) -> * -> *) (r :: [(* -> *) -> * -> *]) a.
FirstOrder e "interpret" =>
(forall x (m :: * -> *). e m x -> Sem r x)
-> Sem (e : r) a -> Sem r a
interpret \case
  Process b -> do
    x
k   <- b -> Sem r x
forall b c (r :: [(* -> *) -> * -> *]).
MemberWithError (Methodology b c) r =>
b -> Sem r c
process @b @x b
b
    HList xs
k'  <- b -> Sem r (HList xs)
forall b c (r :: [(* -> *) -> * -> *]).
MemberWithError (Methodology b c) r =>
b -> Sem r c
process @b @(HList xs) b
b
    HList (x : xs) -> Sem r (HList (x : xs))
forall (m :: * -> *) a. Monad m => a -> m a
return (HList (x : xs) -> Sem r (HList (x : xs)))
-> HList (x : xs) -> Sem r (HList (x : xs))
forall a b. (a -> b) -> a -> b
$ x
k x -> HList xs -> HList (x : xs)
forall a1 (b :: [*]). a1 -> HList b -> HList (a1 : b)
::: HList xs
k'

-- | Finish an `HList` separated `Methodology` by consuming it for no effect.
endMethodologyInitial :: Sem (Methodology b (HList '[]) ': r) a
                      -> Sem r a
endMethodologyInitial :: Sem (Methodology b (HList '[]) : r) a -> Sem r a
endMethodologyInitial = (forall x (m :: * -> *). Methodology b (HList '[]) m x -> Sem r x)
-> Sem (Methodology b (HList '[]) : r) a -> Sem r a
forall (e :: (* -> *) -> * -> *) (r :: [(* -> *) -> * -> *]) a.
FirstOrder e "interpret" =>
(forall x (m :: * -> *). e m x -> Sem r x)
-> Sem (e : r) a -> Sem r a
interpret \case
  Process _ -> HList '[] -> Sem r (HList '[])
forall (m :: * -> *) a. Monad m => a -> m a
return HList '[]
HNil

-- | Factor a `Methodology` decomposed over an `HList` in the source by a `Methodology` from the first variable. Assumes the result is a `Monoid`.
separateMethodologyTerminal :: forall x c xs r a.
                               (Monoid c,
                               Members '[ Methodology (HList xs) c
                                        , Methodology x c] r)
                            => Sem (Methodology (HList (x ': xs)) c ': r) a
                            -> Sem r a
separateMethodologyTerminal :: Sem (Methodology (HList (x : xs)) c : r) a -> Sem r a
separateMethodologyTerminal = (forall x (m :: * -> *).
 Methodology (HList (x : xs)) c m x -> Sem r x)
-> Sem (Methodology (HList (x : xs)) c : r) a -> Sem r a
forall (e :: (* -> *) -> * -> *) (r :: [(* -> *) -> * -> *]) a.
FirstOrder e "interpret" =>
(forall x (m :: * -> *). e m x -> Sem r x)
-> Sem (e : r) a -> Sem r a
interpret \case
  Process (b ::: bs) -> do
    c
k   <- x -> Sem r c
forall b c (r :: [(* -> *) -> * -> *]).
MemberWithError (Methodology b c) r =>
b -> Sem r c
process @x @c x
a1
b
    c
k'  <- HList xs -> Sem r c
forall b c (r :: [(* -> *) -> * -> *]).
MemberWithError (Methodology b c) r =>
b -> Sem r c
process @(HList xs) @c HList xs
HList b
bs
    c -> Sem r c
forall (m :: * -> *) a. Monad m => a -> m a
return (c -> Sem r c) -> c -> Sem r c
forall a b. (a -> b) -> a -> b
$ c
k c -> c -> c
forall a. Semigroup a => a -> a -> a
<> c
k'

-- | Finalise an `HList` separated `Methodology` in the source by returning the `Monoid` unit.
endMethodologyTerminal :: Monoid c
                       => Sem (Methodology (HList '[]) c ': r) a
                       -> Sem r a
endMethodologyTerminal :: Sem (Methodology (HList '[]) c : r) a -> Sem r a
endMethodologyTerminal = (forall x (m :: * -> *). Methodology (HList '[]) c m x -> Sem r x)
-> Sem (Methodology (HList '[]) c : r) a -> Sem r a
forall (e :: (* -> *) -> * -> *) (r :: [(* -> *) -> * -> *]) a.
FirstOrder e "interpret" =>
(forall x (m :: * -> *). e m x -> Sem r x)
-> Sem (e : r) a -> Sem r a
interpret \case
  Process _ -> x -> Sem r x
forall (m :: * -> *) a. Monad m => a -> m a
return x
forall a. Monoid a => a
mempty

-- | Run a `Methodology (f b) (f c)` by way of a `Methodology b c`. Note that
-- `f` must be `Traversable`.
fmapMethodology :: forall f b c r a.
                 ( Members '[Methodology b c] r
                 , Traversable f)
                => Sem (Methodology (f b) (f c) ': r) a
                -> Sem r a
fmapMethodology :: Sem (Methodology (f b) (f c) : r) a -> Sem r a
fmapMethodology = (forall x (m :: * -> *). Methodology (f b) (f c) m x -> Sem r x)
-> Sem (Methodology (f b) (f c) : r) a -> Sem r a
forall (e :: (* -> *) -> * -> *) (r :: [(* -> *) -> * -> *]) a.
FirstOrder e "interpret" =>
(forall x (m :: * -> *). e m x -> Sem r x)
-> Sem (e : r) a -> Sem r a
interpret \case
  Process b -> (b -> Sem r c) -> f b -> Sem r (f c)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (forall (r :: [(* -> *) -> * -> *]).
MemberWithError (Methodology b c) r =>
b -> Sem r c
forall b c (r :: [(* -> *) -> * -> *]).
MemberWithError (Methodology b c) r =>
b -> Sem r c
process @b @c) f b
b

-- | Run a `Methodology (f (g b)) (f (g c))` by way of a `Methodology b c`. Note that
-- `f` and `g` must be `Traversable`.
fmap2Methodology :: forall f g b c r a.
                  ( Members '[Methodology b c] r
                  , Traversable f, Traversable g)
                 => Sem (Methodology (f (g b)) (f (g c)) ': Methodology (g b) (g c) ': r) a
                 -> Sem r a
fmap2Methodology :: Sem
  (Methodology (f (g b)) (f (g c)) : Methodology (g b) (g c) : r) a
-> Sem r a
fmap2Methodology = forall (r :: [(* -> *) -> * -> *]) a.
(Members '[Methodology b c] r, Traversable g) =>
Sem (Methodology (g b) (g c) : r) a -> Sem r a
forall (f :: * -> *) b c (r :: [(* -> *) -> * -> *]) a.
(Members '[Methodology b c] r, Traversable f) =>
Sem (Methodology (f b) (f c) : r) a -> Sem r a
fmapMethodology @g @b @c (Sem (Methodology (g b) (g c) : r) a -> Sem r a)
-> (Sem
      (Methodology (f (g b)) (f (g c)) : Methodology (g b) (g c) : r) a
    -> Sem (Methodology (g b) (g c) : r) a)
-> Sem
     (Methodology (f (g b)) (f (g c)) : Methodology (g b) (g c) : r) a
-> Sem r a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (r :: [(* -> *) -> * -> *]) a.
(Members '[Methodology (g b) (g c)] r, Traversable f) =>
Sem (Methodology (f (g b)) (f (g c)) : r) a -> Sem r a
forall (f :: * -> *) b c (r :: [(* -> *) -> * -> *]) a.
(Members '[Methodology b c] r, Traversable f) =>
Sem (Methodology (f b) (f c) : r) a -> Sem r a
fmapMethodology @f @(g b) @(g c)

-- | Run a `Methodology (f b) (f c)` by way of a `Methodology b (f c)`. Note that
-- `f` must be both `Traversable` and `Monad`.
bindMethodology :: forall f b c r a.
                 ( Members '[Methodology b (f c)] r
                 , Traversable f, Monad f)
                => Sem (Methodology (f b) (f c) ': r) a
                -> Sem r a
bindMethodology :: Sem (Methodology (f b) (f c) : r) a -> Sem r a
bindMethodology = (forall x (m :: * -> *). Methodology (f b) (f c) m x -> Sem r x)
-> Sem (Methodology (f b) (f c) : r) a -> Sem r a
forall (e :: (* -> *) -> * -> *) (r :: [(* -> *) -> * -> *]) a.
FirstOrder e "interpret" =>
(forall x (m :: * -> *). e m x -> Sem r x)
-> Sem (e : r) a -> Sem r a
interpret \case
  Process b -> f (f c) -> f c
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join (f (f c) -> f c) -> Sem r (f (f c)) -> Sem r (f c)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (b -> Sem r (f c)) -> f b -> Sem r (f (f c))
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (forall (r :: [(* -> *) -> * -> *]).
MemberWithError (Methodology b (f c)) r =>
b -> Sem r (f c)
forall b c (r :: [(* -> *) -> * -> *]).
MemberWithError (Methodology b c) r =>
b -> Sem r c
process @b @(f c)) f b
b

-- | Run a `Methodology (t b) (f (t b))` by way of a `Methodology b (f c)`. Note that
-- `t` must be `Traversable` and `f` must be `Applicative`.
traverseMethodology :: forall t f b c r a.
                     ( Members '[Methodology b (f c)] r
                     , Traversable t, Applicative f)
                    => Sem (Methodology (t b) (f (t c)) ': r) a
                    -> Sem r a
traverseMethodology :: Sem (Methodology (t b) (f (t c)) : r) a -> Sem r a
traverseMethodology = (forall x (m :: * -> *).
 Methodology (t b) (f (t c)) m x -> Sem r x)
-> Sem (Methodology (t b) (f (t c)) : r) a -> Sem r a
forall (e :: (* -> *) -> * -> *) (r :: [(* -> *) -> * -> *]) a.
FirstOrder e "interpret" =>
(forall x (m :: * -> *). e m x -> Sem r x)
-> Sem (e : r) a -> Sem r a
interpret \case
  Process b -> t (f c) -> f (t c)
forall (t :: * -> *) (f :: * -> *) a.
(Traversable t, Applicative f) =>
t (f a) -> f (t a)
sequenceA (t (f c) -> f (t c)) -> Sem r (t (f c)) -> Sem r (f (t c))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (b -> Sem r (f c)) -> t b -> Sem r (t (f c))
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (forall (r :: [(* -> *) -> * -> *]).
MemberWithError (Methodology b (f c)) r =>
b -> Sem r (f c)
forall b c (r :: [(* -> *) -> * -> *]).
MemberWithError (Methodology b c) r =>
b -> Sem r c
process @b @(f c)) t b
b

-- | `Trace` a `String` based on the input to a `Methodology`.
traceMethodologyStart :: forall b c r a.
                         Members '[Methodology b c,
                                   Trace] r
                       => (b -> String)
                       -> Sem r a
                       -> Sem r a
traceMethodologyStart :: (b -> String) -> Sem r a -> Sem r a
traceMethodologyStart b -> String
f = (forall x (m :: * -> *). Methodology b c m x -> Sem r x)
-> Sem r a -> Sem r a
forall (e :: (* -> *) -> * -> *) (r :: [(* -> *) -> * -> *]) a.
(Member e r, FirstOrder e "intercept") =>
(forall x (m :: * -> *). e m x -> Sem r x) -> Sem r a -> Sem r a
intercept \case
  Process b -> String -> Sem r ()
forall (r :: [(* -> *) -> * -> *]).
MemberWithError Trace r =>
String -> Sem r ()
trace (b -> String
f b
b) Sem r () -> Sem r c -> Sem r c
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> b -> Sem r c
forall b c (r :: [(* -> *) -> * -> *]).
MemberWithError (Methodology b c) r =>
b -> Sem r c
process @b @c b
b

-- | `Trace` a `String` based on the output to a `Methodology`.
traceMethodologyEnd :: forall b c r a.
                       Members '[Methodology b c,
                                Trace] r
                       => (c -> String)
                       -> Sem r a
                       -> Sem r a
traceMethodologyEnd :: (c -> String) -> Sem r a -> Sem r a
traceMethodologyEnd c -> String
f = (forall x (m :: * -> *). Methodology b c m x -> Sem r x)
-> Sem r a -> Sem r a
forall (e :: (* -> *) -> * -> *) (r :: [(* -> *) -> * -> *]) a.
(Member e r, FirstOrder e "intercept") =>
(forall x (m :: * -> *). e m x -> Sem r x) -> Sem r a -> Sem r a
intercept \case
  Process b -> do
    c
c <- b -> Sem r c
forall b c (r :: [(* -> *) -> * -> *]).
MemberWithError (Methodology b c) r =>
b -> Sem r c
process @b @c b
b
    String -> Sem r ()
forall (r :: [(* -> *) -> * -> *]).
MemberWithError Trace r =>
String -> Sem r ()
trace (String -> Sem r ()) -> String -> Sem r ()
forall a b. (a -> b) -> a -> b
$ c -> String
f c
c
    c -> Sem r c
forall (m :: * -> *) a. Monad m => a -> m a
return c
c

-- | `Trace` both the start and the end of a `Methodology`.
traceMethodologyAround :: forall b c r a.
                           Members '[Methodology b c,
                                     Trace] r
                       => (b -> String)
                       -> (c -> String)
                       -> Sem r a
                       -> Sem r a
traceMethodologyAround :: (b -> String) -> (c -> String) -> Sem r a -> Sem r a
traceMethodologyAround b -> String
f c -> String
g = (forall x (m :: * -> *). Methodology b c m x -> Sem r x)
-> Sem r a -> Sem r a
forall (e :: (* -> *) -> * -> *) (r :: [(* -> *) -> * -> *]) a.
(Member e r, FirstOrder e "intercept") =>
(forall x (m :: * -> *). e m x -> Sem r x) -> Sem r a -> Sem r a
intercept \case
  Process b -> do
    String -> Sem r ()
forall (r :: [(* -> *) -> * -> *]).
MemberWithError Trace r =>
String -> Sem r ()
trace (String -> Sem r ()) -> String -> Sem r ()
forall a b. (a -> b) -> a -> b
$ b -> String
f b
b
    c
c <- b -> Sem r c
forall b c (r :: [(* -> *) -> * -> *]).
MemberWithError (Methodology b c) r =>
b -> Sem r c
process @b @c b
b
    String -> Sem r ()
forall (r :: [(* -> *) -> * -> *]).
MemberWithError Trace r =>
String -> Sem r ()
trace (String -> Sem r ()) -> String -> Sem r ()
forall a b. (a -> b) -> a -> b
$ c -> String
g c
c
    c -> Sem r c
forall (m :: * -> *) a. Monad m => a -> m a
return c
c