{-# LANGUAGE AllowAmbiguousTypes      #-}
{-# LANGUAGE BlockArguments           #-}
{-# LANGUAGE DataKinds                #-}
{-# LANGUAGE FlexibleContexts         #-}
{-# LANGUAGE GADTs                    #-}
{-# LANGUAGE LambdaCase               #-}
{-# LANGUAGE PolyKinds                #-}
{-# LANGUAGE ScopedTypeVariables      #-}
{-# LANGUAGE StandaloneKindSignatures #-}
{-# LANGUAGE TemplateHaskell          #-}
{-# LANGUAGE TypeApplications         #-}
{-# LANGUAGE TypeOperators            #-}

-- |
--   Module     : Polysemy.Methodology
--   License    : MIT
--   Stability  : experimental
--
-- Domain modelling algebra for polysemy.
module Polysemy.Methodology
  ( -- * Definition
    Methodology (..),
    process,

    -- * Eliminators
    runMethodologyPure,
    runMethodologySem,

    -- * Decomposition
    cutMethodology,
    cutMethodology',
    cutMethodology3,
    cutMethodology3',
    divideMethodology,
    divideMethodology',
    decideMethodology,
    decideMethodology',
    decomposeMethodology,
    decomposeMethodology',
    decomposeMethodology3,
    separateMethodologyInitial,
    endMethodologyInitial,
    separateMethodologyTerminal,
    endMethodologyTerminal,

    -- * Simplifcation
    fmapMethodology,
    fmapMethodology',
    fmap2Methodology,
    fmap2Methodology',
    pureMethodology,
    pureMethodology',
    bindMethodology,
    bindMethodology',
    traverseMethodology,
    traverseMethodology',
    mconcatMethodology,
    mconcatMethodology',

    -- * Other Effects
    teeMethodologyOutput,
    plugMethodologyInput,
    runMethodologyAsKVStore,
    runMethodologyAsKVStoreWithDefault,
    runMethodologyMappendPure,
    runMethodologyMappendSem,

    -- * Tracing
    traceMethodologyStart,
    traceMethodologyEnd,
    traceMethodologyAround,
  )
where

import           Control.Applicative (liftA2)
import           Control.Arrow       ((>>>))
import           Control.Monad       (join)
import           Data.Foldable       (fold)
import           Data.Functor        ((<&>))
import           Data.Kind           (Type)
import           Polysemy            (Members, Sem, intercept, interpret,
                                      makeSem, raise, raiseUnder, reinterpret2,
                                      reinterpret3)
import           Polysemy.Input      (Input, input)
import           Polysemy.KVStore    (KVStore, lookupKV)
import           Polysemy.Output     (Output, output)
import           Polysemy.Several    (HList (HNil, (:::)))
import           Polysemy.Trace      (Trace, trace)

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

makeSem ''Methodology

-- | Run a `Methodology` using a pure function.
--
-- @since 0.1.0.0
runMethodologyPure ::
  forall b c r a.
  -- | A function from b to c.
  (b -> c) ->
  Sem (Methodology b c ': r) a ->
  Sem r a
runMethodologyPure :: forall b c (r :: EffectRow) a.
(b -> c) -> Sem (Methodology b c : r) a -> Sem r a
runMethodologyPure b -> c
f = forall (e :: Effect) (r :: EffectRow) a.
FirstOrder e "interpret" =>
(forall (rInitial :: EffectRow) x. e (Sem rInitial) x -> Sem r x)
-> Sem (e : r) a -> Sem r a
interpret \case
  Process b
b -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ b -> c
f b
b
{-# INLINE runMethodologyPure #-}

-- | Run a `Methodology' using a monadic function with effects in `r`.
--
-- @since 0.1.0.0
runMethodologySem ::
  forall b c r a.
  -- | A monadic function from b to c using effects in r.
  (b -> Sem r c) ->
  Sem (Methodology b c ': r) a ->
  Sem r a
runMethodologySem :: forall b c (r :: EffectRow) a.
(b -> Sem r c) -> Sem (Methodology b c : r) a -> Sem r a
runMethodologySem b -> Sem r c
f = forall (e :: Effect) (r :: EffectRow) a.
FirstOrder e "interpret" =>
(forall (rInitial :: EffectRow) x. e (Sem rInitial) x -> Sem r x)
-> Sem (e : r) a -> Sem r a
interpret \case
  Process b
b -> b -> Sem r c
f b
b
{-# INLINE runMethodologySem #-}

-- | Cut a `Methodology` into two pieces at a midpoint.
--
-- @since 0.1.0.0
cutMethodology ::
  forall b c d r a.
  Members
    '[ Methodology b c,
       Methodology c d
     ]
    r =>
  -- | Methodology effect to decompose.
  Sem (Methodology b d ': r) a ->
  Sem r a
cutMethodology :: forall b c d (r :: EffectRow) a.
Members '[Methodology b c, Methodology c d] r =>
Sem (Methodology b d : r) a -> Sem r a
cutMethodology = forall (e :: Effect) (r :: EffectRow) a.
FirstOrder e "interpret" =>
(forall (rInitial :: EffectRow) x. e (Sem rInitial) x -> Sem r x)
-> Sem (e : r) a -> Sem r a
interpret \case
  Process b
b -> forall b c (r :: EffectRow).
Member (Methodology b c) r =>
b -> Sem r c
process @b @c b
b forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall b c (r :: EffectRow).
Member (Methodology b c) r =>
b -> Sem r c
process @c @d
{-# INLINE cutMethodology #-}

-- | Reinterpreting version of `cutMethodology`.
--
-- @since 0.1.6.0
cutMethodology' ::
  forall b c d r a.
  -- | Methodology effect to decompose.
  Sem (Methodology b d ': r) a ->
  Sem (Methodology b c ': Methodology c d ': r) a
cutMethodology' :: forall b c d (r :: EffectRow) a.
Sem (Methodology b d : r) a
-> Sem (Methodology b c : Methodology c d : r) a
cutMethodology' = forall (e1 :: Effect) (e2 :: Effect) (e3 :: Effect)
       (r :: EffectRow) a.
FirstOrder e1 "reinterpret2" =>
(forall (rInitial :: EffectRow) x.
 e1 (Sem rInitial) x -> Sem (e2 : e3 : r) x)
-> Sem (e1 : r) a -> Sem (e2 : e3 : r) a
reinterpret2 \case
  Process b
b -> forall b c (r :: EffectRow).
Member (Methodology b c) r =>
b -> Sem r c
process @b @c b
b forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall (e :: Effect) (r :: EffectRow) a. Sem r a -> Sem (e : r) a
raise forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall b c (r :: EffectRow).
Member (Methodology b c) r =>
b -> Sem r c
process @c @d
{-# INLINE cutMethodology' #-}

-- | Cut a `Methodology` into three pieces using two cuts.
--
-- @since 0.1.0.0
cutMethodology3 ::
  forall b c d e r a.
  Members
    '[ Methodology b c,
       Methodology c d,
       Methodology d e
     ]
    r =>
  -- | Methodology effect to decompose.
  Sem (Methodology b e ': r) a ->
  Sem r a
cutMethodology3 :: forall b c d e (r :: EffectRow) a.
Members '[Methodology b c, Methodology c d, Methodology d e] r =>
Sem (Methodology b e : r) a -> Sem r a
cutMethodology3 = forall (e :: Effect) (r :: EffectRow) a.
FirstOrder e "interpret" =>
(forall (rInitial :: EffectRow) x. e (Sem rInitial) x -> Sem r x)
-> Sem (e : r) a -> Sem r a
interpret \case
  Process b
b -> forall b c (r :: EffectRow).
Member (Methodology b c) r =>
b -> Sem r c
process @b @c b
b forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall b c (r :: EffectRow).
Member (Methodology b c) r =>
b -> Sem r c
process @c @d forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall b c (r :: EffectRow).
Member (Methodology b c) r =>
b -> Sem r c
process @d @e
{-# INLINE cutMethodology3 #-}

-- | Reinterpreting version of `cutMethodology`.
--
-- @since 0.1.6.0
cutMethodology3' ::
  forall b c d e r a.
  -- | Methodology effect to decompose.
  Sem (Methodology b d ': r) a ->
  Sem (Methodology b c ': Methodology c d ': Methodology d e ': r) a
cutMethodology3' :: forall b c d e (r :: EffectRow) a.
Sem (Methodology b d : r) a
-> Sem (Methodology b c : Methodology c d : Methodology d e : r) a
cutMethodology3' = forall (e1 :: Effect) (e2 :: Effect) (e3 :: Effect) (e4 :: Effect)
       (r :: EffectRow) a.
FirstOrder e1 "reinterpret3" =>
(forall (rInitial :: EffectRow) x.
 e1 (Sem rInitial) x -> Sem (e2 : e3 : e4 : r) x)
-> Sem (e1 : r) a -> Sem (e2 : e3 : e4 : r) a
reinterpret3 \case
  Process b
b -> forall b c (r :: EffectRow).
Member (Methodology b c) r =>
b -> Sem r c
process @b @c b
b forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall (e :: Effect) (r :: EffectRow) a. Sem r a -> Sem (e : r) a
raise forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall b c (r :: EffectRow).
Member (Methodology b c) r =>
b -> Sem r c
process @c @d
{-# INLINE cutMethodology3' #-}

-- | Divide a `Methodology` into two components using a `Methodology` that accepts a pair.`
--
-- @since 0.1.0.0
divideMethodology ::
  forall b c c' d r a.
  Members
    '[ Methodology b c,
       Methodology b c',
       Methodology (c, c') d
     ]
    r =>
  -- | Methodology effect to decompose.
  Sem (Methodology b d ': r) a ->
  Sem r a
divideMethodology :: forall b c c' d (r :: EffectRow) a.
Members
  '[Methodology b c, Methodology b c', Methodology (c, c') d] r =>
Sem (Methodology b d : r) a -> Sem r a
divideMethodology = forall (e :: Effect) (r :: EffectRow) a.
FirstOrder e "interpret" =>
(forall (rInitial :: EffectRow) x. e (Sem rInitial) x -> Sem r x)
-> Sem (e : r) a -> Sem r a
interpret \case
  Process b
b -> do
    c
c <- forall b c (r :: EffectRow).
Member (Methodology b c) r =>
b -> Sem r c
process @b @c b
b
    c'
c' <- forall b c (r :: EffectRow).
Member (Methodology b c) r =>
b -> Sem r c
process @b @c' b
b
    forall b c (r :: EffectRow).
Member (Methodology b c) r =>
b -> Sem r c
process @(c, c') @d (c
c, c'
c')
{-# INLINE divideMethodology #-}

-- | Reinterpreting version of `divideMethodology`.
--
-- @since 0.1.6.0
divideMethodology' ::
  forall b c c' d r a.
  Sem (Methodology b d ': r) a ->
  Sem (Methodology b c ': Methodology b c' ': Methodology (c, c') d ': r) a
divideMethodology' :: forall b c c' d (r :: EffectRow) a.
Sem (Methodology b d : r) a
-> Sem
     (Methodology b c : Methodology b c' : Methodology (c, c') d : r) a
divideMethodology' = forall (e1 :: Effect) (e2 :: Effect) (e3 :: Effect) (e4 :: Effect)
       (r :: EffectRow) a.
FirstOrder e1 "reinterpret3" =>
(forall (rInitial :: EffectRow) x.
 e1 (Sem rInitial) x -> Sem (e2 : e3 : e4 : r) x)
-> Sem (e1 : r) a -> Sem (e2 : e3 : e4 : r) a
reinterpret3 \case
  Process b
b -> do
    c
c <- forall b c (r :: EffectRow).
Member (Methodology b c) r =>
b -> Sem r c
process @b @c b
b
    c'
c' <- forall (e :: Effect) (r :: EffectRow) a. Sem r a -> Sem (e : r) a
raise forall a b. (a -> b) -> a -> b
$ forall b c (r :: EffectRow).
Member (Methodology b c) r =>
b -> Sem r c
process @b @c' b
b
    forall (e :: Effect) (r :: EffectRow) a. Sem r a -> Sem (e : r) a
raise forall a b. (a -> b) -> a -> b
$ forall (e :: Effect) (r :: EffectRow) a. Sem r a -> Sem (e : r) a
raise forall a b. (a -> b) -> a -> b
$ forall b c (r :: EffectRow).
Member (Methodology b c) r =>
b -> Sem r c
process @(c, c') @d (c
c, c'
c')
{-# INLINE divideMethodology' #-}

-- | Decide between two `Methodology`s using a `Methodology` that computes an `Either`.
--
-- @since 0.1.0.0
decideMethodology ::
  forall b c c' d r a.
  Members
    '[ Methodology b (Either c c'),
       Methodology c d,
       Methodology c' d
     ]
    r =>
  -- | `Methodology effect to decompose.
  Sem (Methodology b d ': r) a ->
  Sem r a
decideMethodology :: forall b c c' d (r :: EffectRow) a.
Members
  '[Methodology b (Either c c'), Methodology c d, Methodology c' d]
  r =>
Sem (Methodology b d : r) a -> Sem r a
decideMethodology = forall (e :: Effect) (r :: EffectRow) a.
FirstOrder e "interpret" =>
(forall (rInitial :: EffectRow) x. e (Sem rInitial) x -> Sem r x)
-> Sem (e : r) a -> Sem r a
interpret \case
  Process b
b -> do
    Either c c'
k <- forall b c (r :: EffectRow).
Member (Methodology b c) r =>
b -> Sem r c
process @b @(Either c c') b
b
    case Either c c'
k of
      Left c
c   -> forall b c (r :: EffectRow).
Member (Methodology b c) r =>
b -> Sem r c
process @c @d c
c
      Right c'
c' -> forall b c (r :: EffectRow).
Member (Methodology b c) r =>
b -> Sem r c
process @c' @d c'
c'
{-# INLINE decideMethodology #-}

-- | Reinterpreting version of `decideMethodology`.
--
-- @since 0.1.6.0
decideMethodology' ::
  forall b c c' d r a.
  Sem (Methodology b d ': r) a ->
  Sem (Methodology b (Either c c') ': Methodology c d ': Methodology c' d ': r) a
decideMethodology' :: forall b c c' d (r :: EffectRow) a.
Sem (Methodology b d : r) a
-> Sem
     (Methodology b (Either c c')
        : Methodology c d : Methodology c' d : r)
     a
decideMethodology' = forall (e1 :: Effect) (e2 :: Effect) (e3 :: Effect) (e4 :: Effect)
       (r :: EffectRow) a.
FirstOrder e1 "reinterpret3" =>
(forall (rInitial :: EffectRow) x.
 e1 (Sem rInitial) x -> Sem (e2 : e3 : e4 : r) x)
-> Sem (e1 : r) a -> Sem (e2 : e3 : e4 : r) a
reinterpret3 \case
  Process b
b -> do
    Either c c'
k <- forall b c (r :: EffectRow).
Member (Methodology b c) r =>
b -> Sem r c
process @b @(Either c c') b
b
    case Either c c'
k of
      Left c
c   -> forall (e :: Effect) (r :: EffectRow) a. Sem r a -> Sem (e : r) a
raise forall a b. (a -> b) -> a -> b
$ forall b c (r :: EffectRow).
Member (Methodology b c) r =>
b -> Sem r c
process @c @d c
c
      Right c'
c' -> forall (e :: Effect) (r :: EffectRow) a. Sem r a -> Sem (e : r) a
raise forall a b. (a -> b) -> a -> b
$ forall (e :: Effect) (r :: EffectRow) a. Sem r a -> Sem (e : r) a
raise forall a b. (a -> b) -> a -> b
$ forall b c (r :: EffectRow).
Member (Methodology b c) r =>
b -> Sem r c
process @c' @d c'
c'
{-# INLINE decideMethodology' #-}

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

-- | Make a `Methodology` depend on an additional input, introducing a new `Input` effect to be handled.
--
-- @since 0.1.0.0
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 :: forall b c d (r :: EffectRow) a.
Members '[Input b, Methodology (b, c) d] r =>
Sem (Methodology c d : r) a -> Sem r a
plugMethodologyInput = forall (e :: Effect) (r :: EffectRow) a.
FirstOrder e "interpret" =>
(forall (rInitial :: EffectRow) x. e (Sem rInitial) x -> Sem r x)
-> Sem (e : r) a -> Sem r a
interpret \case
  Process c
b -> do
    b
k <- forall i (r :: EffectRow). Member (Input i) r => Sem r i
input @b
    forall b c (r :: EffectRow).
Member (Methodology b c) r =>
b -> Sem r c
process @(b, c) @d (b
k, c
b)
{-# INLINE plugMethodologyInput #-}

-- | Run a `Methodology` as a `KVStore`, using the input as a key and the output as the value.
--
-- @since 0.1.0.0
runMethodologyAsKVStore ::
  forall k v r a.
  Members '[KVStore k v] r =>
  Sem (Methodology k (Maybe v) ': r) a ->
  Sem r a
runMethodologyAsKVStore :: forall k v (r :: EffectRow) a.
Members '[KVStore k v] r =>
Sem (Methodology k (Maybe v) : r) a -> Sem r a
runMethodologyAsKVStore = forall (e :: Effect) (r :: EffectRow) a.
FirstOrder e "interpret" =>
(forall (rInitial :: EffectRow) x. e (Sem rInitial) x -> Sem r x)
-> Sem (e : r) a -> Sem r a
interpret \case
  Process k
k -> forall k v (r :: EffectRow).
Member (KVStore k v) r =>
k -> Sem r (Maybe v)
lookupKV k
k
{-# INLINE runMethodologyAsKVStore #-}

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

-- | Run a `Methodology` targetting a `Monoid` without consuming it, pure version. This should probably be considered an
-- anti-pattern, and it's probably better to decompose the inputs fully, but is otherwise sound.
--
-- @since 0.1.8.0
runMethodologyMappendPure ::
  forall b c r a.
  ( Monoid c,
    Members '[Methodology b c] r
  ) =>
  (b -> c) ->
  Sem r a ->
  Sem r a
runMethodologyMappendPure :: forall b c (r :: EffectRow) a.
(Monoid c, Members '[Methodology b c] r) =>
(b -> c) -> Sem r a -> Sem r a
runMethodologyMappendPure b -> c
f = forall (e :: Effect) (r :: EffectRow) a.
(Member e r, FirstOrder e "intercept") =>
(forall x (rInitial :: EffectRow). e (Sem rInitial) x -> Sem r x)
-> Sem r a -> Sem r a
intercept @(Methodology b c) \case
  Process b
b -> (b -> c
f b
b forall a. Semigroup a => a -> a -> a
<>) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall b c (r :: EffectRow).
Member (Methodology b c) r =>
b -> Sem r c
process @b @c b
b
{-# INLINE runMethodologyMappendPure #-}

-- | Run a `Methodology` targetting a `Monoid` without consuming it, `Sem` version. This should probably be considered an
-- anti-pattern, and it's probably better to decompose the inputs fully, but is otherwise sound.
--
-- @since 0.1.8.0
runMethodologyMappendSem ::
  forall b c r a.
  ( Monoid c,
    Members '[Methodology b c] r
  ) =>
  (b -> Sem r c) ->
  Sem r a ->
  Sem r a
runMethodologyMappendSem :: forall b c (r :: EffectRow) a.
(Monoid c, Members '[Methodology b c] r) =>
(b -> Sem r c) -> Sem r a -> Sem r a
runMethodologyMappendSem b -> Sem r c
f = forall (e :: Effect) (r :: EffectRow) a.
(Member e r, FirstOrder e "intercept") =>
(forall x (rInitial :: EffectRow). e (Sem rInitial) x -> Sem r x)
-> Sem r a -> Sem r a
intercept @(Methodology b c) \case
  Process b
b -> forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 forall a. Semigroup a => a -> a -> a
(<>) (b -> Sem r c
f b
b) (forall b c (r :: EffectRow).
Member (Methodology b c) r =>
b -> Sem r c
process @b @c b
b)
{-# INLINE runMethodologyMappendSem #-}

-- | Decompose a `Methodology` into several components to be recombined. This is `cutMethodology` specialised to `HList`.
--
-- @since 0.1.0.0
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 :: forall b (f :: [*]) c (r :: EffectRow) a.
Members '[Methodology b (HList f), Methodology (HList f) c] r =>
Sem (Methodology b c : r) a -> Sem r a
decomposeMethodology = forall b c d (r :: EffectRow) a.
Members '[Methodology b c, Methodology c d] r =>
Sem (Methodology b d : r) a -> Sem r a
cutMethodology @b @(HList f) @c
{-# INLINE decomposeMethodology #-}

-- | Reinterpreting version of `decomposeMethodology`.
--
-- @since 0.1.6.0
decomposeMethodology' ::
  forall b f c r a.
  Sem (Methodology b c ': r) a ->
  Sem (Methodology b (HList f) ': Methodology (HList f) c ': r) a
decomposeMethodology' :: forall b (f :: [*]) c (r :: EffectRow) a.
Sem (Methodology b c : r) a
-> Sem (Methodology b (HList f) : Methodology (HList f) c : r) a
decomposeMethodology' = forall b c d (r :: EffectRow) a.
Sem (Methodology b d : r) a
-> Sem (Methodology b c : Methodology c d : r) a
cutMethodology' @b @(HList f) @c
{-# INLINE decomposeMethodology' #-}

-- | Decompose a `Methodology` into several components over three sections with two cuts.
--
-- @since 0.1.0.0
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 :: forall b (f :: [*]) (g :: [*]) c (r :: EffectRow) 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 = forall b c d e (r :: EffectRow) 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
{-# INLINE decomposeMethodology3 #-}

-- | Factor a `Methodology` decomposed over an `HList` in the result by a `Methodology` to the first variable.
--
-- @since 0.1.0.0
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 :: forall b x (xs :: [*]) (r :: EffectRow) a.
Members '[Methodology b (HList xs), Methodology b x] r =>
Sem (Methodology b (HList (x : xs)) : r) a -> Sem r a
separateMethodologyInitial = forall (e :: Effect) (r :: EffectRow) a.
FirstOrder e "interpret" =>
(forall (rInitial :: EffectRow) x. e (Sem rInitial) x -> Sem r x)
-> Sem (e : r) a -> Sem r a
interpret \case
  Process b
b -> do
    x
k <- forall b c (r :: EffectRow).
Member (Methodology b c) r =>
b -> Sem r c
process @b @x b
b
    HList xs
k' <- forall b c (r :: EffectRow).
Member (Methodology b c) r =>
b -> Sem r c
process @b @(HList xs) b
b
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ x
k forall a1 (b :: [*]). a1 -> HList b -> HList (a1 : b)
::: HList xs
k'
{-# INLINE separateMethodologyInitial #-}

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

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

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

-- | Run a `Methodology` (f b) (f c) by way of a `Methodology` b c. Note that
-- `f` must be `Traversable`.
--
-- @since 0.1.2.0
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 :: forall (f :: * -> *) b c (r :: EffectRow) a.
(Members '[Methodology b c] r, Traversable f) =>
Sem (Methodology (f b) (f c) : r) a -> Sem r a
fmapMethodology = forall (e :: Effect) (r :: EffectRow) a.
FirstOrder e "interpret" =>
(forall (rInitial :: EffectRow) x. e (Sem rInitial) x -> Sem r x)
-> Sem (e : r) a -> Sem r a
interpret \case
  Process f b
b -> forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (forall b c (r :: EffectRow).
Member (Methodology b c) r =>
b -> Sem r c
process @b @c) f b
b
{-# INLINE fmapMethodology #-}

-- | Reinterpreting version of `fmapMethodology`.
--
-- @since 0.1.6.0
fmapMethodology' ::
  forall f b c r a.
  Traversable f =>
  Sem (Methodology (f b) (f c) ': r) a ->
  Sem (Methodology b c ': r) a
fmapMethodology' :: forall (f :: * -> *) b c (r :: EffectRow) a.
Traversable f =>
Sem (Methodology (f b) (f c) : r) a -> Sem (Methodology b c : r) a
fmapMethodology' = forall (e2 :: Effect) (e1 :: Effect) (r :: EffectRow) a.
Sem (e1 : r) a -> Sem (e1 : e2 : r) a
raiseUnder forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> forall (f :: * -> *) b c (r :: EffectRow) a.
(Members '[Methodology b c] r, Traversable f) =>
Sem (Methodology (f b) (f c) : r) a -> Sem r a
fmapMethodology
{-# INLINE fmapMethodology' #-}

-- | Run a `Methodology` (f (g b)) (f (g c))) by way of a `Methodology` b c. Note that
-- `f` and `g` must be `Traversable`.
--
-- @since 0.1.2.0
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)) ': r) a ->
  Sem r a
fmap2Methodology :: forall (f :: * -> *) (g :: * -> *) b c (r :: EffectRow) a.
(Members '[Methodology b c] r, Traversable f, Traversable g) =>
Sem (Methodology (f (g b)) (f (g c)) : r) a -> Sem r a
fmap2Methodology = forall (f :: * -> *) b c (r :: EffectRow) a.
Traversable f =>
Sem (Methodology (f b) (f c) : r) a -> Sem (Methodology b c : r) a
fmapMethodology' @f @(g b) @(g c) forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> forall (f :: * -> *) b c (r :: EffectRow) a.
(Members '[Methodology b c] r, Traversable f) =>
Sem (Methodology (f b) (f c) : r) a -> Sem r a
fmapMethodology @g @b @c
{-# INLINE fmap2Methodology #-}

-- | Reinterpreting version of `fmap2Methodology`.
--
-- @since 0.1.6.0
fmap2Methodology' ::
  forall f g b c r a.
  (Traversable f, Traversable g) =>
  Sem (Methodology (f (g b)) (f (g c)) ': r) a ->
  Sem (Methodology b c ': r) a
fmap2Methodology' :: forall (f :: * -> *) (g :: * -> *) b c (r :: EffectRow) a.
(Traversable f, Traversable g) =>
Sem (Methodology (f (g b)) (f (g c)) : r) a
-> Sem (Methodology b c : r) a
fmap2Methodology' = forall (e2 :: Effect) (e1 :: Effect) (r :: EffectRow) a.
Sem (e1 : r) a -> Sem (e1 : e2 : r) a
raiseUnder forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> forall (f :: * -> *) (g :: * -> *) b c (r :: EffectRow) a.
(Members '[Methodology b c] r, Traversable f, Traversable g) =>
Sem (Methodology (f (g b)) (f (g c)) : r) a -> Sem r a
fmap2Methodology
{-# INLINE fmap2Methodology' #-}

-- | Run a `Methodology` b (f c) in terms of a `Methodology` b c.
--
-- @since 0.1.7.0
pureMethodology ::
  forall f b c r a.
  (Members '[Methodology b c] r, Applicative f) =>
  Sem (Methodology b (f c) ': r) a ->
  Sem r a
pureMethodology :: forall (f :: * -> *) b c (r :: EffectRow) a.
(Members '[Methodology b c] r, Applicative f) =>
Sem (Methodology b (f c) : r) a -> Sem r a
pureMethodology = forall (e :: Effect) (r :: EffectRow) a.
FirstOrder e "interpret" =>
(forall (rInitial :: EffectRow) x. e (Sem rInitial) x -> Sem r x)
-> Sem (e : r) a -> Sem r a
interpret \case
  Process b
b -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall b c (r :: EffectRow).
Member (Methodology b c) r =>
b -> Sem r c
process @b @c b
b
{-# INLINE pureMethodology #-}

-- | Reinterpreting version of `pureMethodology`.
--
-- @since 0.1.7.0
pureMethodology' ::
  forall f b c r a.
  Applicative f =>
  Sem (Methodology b (f c) ': r) a ->
  Sem (Methodology b c ': r) a
pureMethodology' :: forall (f :: * -> *) b c (r :: EffectRow) a.
Applicative f =>
Sem (Methodology b (f c) : r) a -> Sem (Methodology b c : r) a
pureMethodology' = forall (e2 :: Effect) (e1 :: Effect) (r :: EffectRow) a.
Sem (e1 : r) a -> Sem (e1 : e2 : r) a
raiseUnder forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> forall (f :: * -> *) b c (r :: EffectRow) a.
(Members '[Methodology b c] r, Applicative f) =>
Sem (Methodology b (f c) : r) a -> Sem r a
pureMethodology
{-# INLINE pureMethodology' #-}

-- | Run a `Methodology` (f b) (f c) by way of a `Methodology` b (f c). Note that
-- `f` must be both `Traversable` and `Monad`.
--
-- @since 0.1.2.0
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 :: forall (f :: * -> *) b c (r :: EffectRow) a.
(Members '[Methodology b (f c)] r, Traversable f, Monad f) =>
Sem (Methodology (f b) (f c) : r) a -> Sem r a
bindMethodology = forall (e :: Effect) (r :: EffectRow) a.
FirstOrder e "interpret" =>
(forall (rInitial :: EffectRow) x. e (Sem rInitial) x -> Sem r x)
-> Sem (e : r) a -> Sem r a
interpret \case
  Process f b
b -> forall (m :: * -> *) a. Monad m => m (m a) -> m a
join forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (forall b c (r :: EffectRow).
Member (Methodology b c) r =>
b -> Sem r c
process @b @(f c)) f b
b
{-# INLINE bindMethodology #-}

-- | Reinterpreting version of `bindMethodology`.
--
-- @since 0.1.6.0
bindMethodology' ::
  forall f b c r a.
  (Traversable f, Monad f) =>
  Sem (Methodology (f b) (f c) ': r) a ->
  Sem (Methodology b (f c) ': r) a
bindMethodology' :: forall (f :: * -> *) b c (r :: EffectRow) a.
(Traversable f, Monad f) =>
Sem (Methodology (f b) (f c) : r) a
-> Sem (Methodology b (f c) : r) a
bindMethodology' = forall (e2 :: Effect) (e1 :: Effect) (r :: EffectRow) a.
Sem (e1 : r) a -> Sem (e1 : e2 : r) a
raiseUnder forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> forall (f :: * -> *) b c (r :: EffectRow) a.
(Members '[Methodology b (f c)] r, Traversable f, Monad f) =>
Sem (Methodology (f b) (f c) : r) a -> Sem r a
bindMethodology
{-# INLINE bindMethodology' #-}

-- | 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`.
--
-- @since 0.1.2.0
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 :: forall (t :: * -> *) (f :: * -> *) b c (r :: EffectRow) a.
(Members '[Methodology b (f c)] r, Traversable t, Applicative f) =>
Sem (Methodology (t b) (f (t c)) : r) a -> Sem r a
traverseMethodology = forall (e :: Effect) (r :: EffectRow) a.
FirstOrder e "interpret" =>
(forall (rInitial :: EffectRow) x. e (Sem rInitial) x -> Sem r x)
-> Sem (e : r) a -> Sem r a
interpret \case
  Process t b
b -> forall (t :: * -> *) (f :: * -> *) a.
(Traversable t, Applicative f) =>
t (f a) -> f (t a)
sequenceA forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (forall b c (r :: EffectRow).
Member (Methodology b c) r =>
b -> Sem r c
process @b @(f c)) t b
b
{-# INLINE traverseMethodology #-}

-- | Reinterpreting version of `traverseMethodology`.
--
-- @since 0.1.6.0
traverseMethodology' ::
  forall t f b c r a.
  (Traversable t, Applicative f) =>
  Sem (Methodology (t b) (f (t c)) ': r) a ->
  Sem (Methodology b (f c) ': r) a
traverseMethodology' :: forall (t :: * -> *) (f :: * -> *) b c (r :: EffectRow) a.
(Traversable t, Applicative f) =>
Sem (Methodology (t b) (f (t c)) : r) a
-> Sem (Methodology b (f c) : r) a
traverseMethodology' = forall (e2 :: Effect) (e1 :: Effect) (r :: EffectRow) a.
Sem (e1 : r) a -> Sem (e1 : e2 : r) a
raiseUnder forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> forall (t :: * -> *) (f :: * -> *) b c (r :: EffectRow) a.
(Members '[Methodology b (f c)] r, Traversable t, Applicative f) =>
Sem (Methodology (t b) (f (t c)) : r) a -> Sem r a
traverseMethodology
{-# INLINE traverseMethodology' #-}

-- | Run a `Methodology` concatenating the results as a monoid.
--
-- @since 0.1.5.0
mconcatMethodology ::
  forall f b c r a.
  ( Members '[Methodology b c] r,
    Monoid c,
    Traversable f
  ) =>
  Sem (Methodology (f b) c ': r) a ->
  Sem r a
mconcatMethodology :: forall (f :: * -> *) b c (r :: EffectRow) a.
(Members '[Methodology b c] r, Monoid c, Traversable f) =>
Sem (Methodology (f b) c : r) a -> Sem r a
mconcatMethodology = forall (e :: Effect) (r :: EffectRow) a.
FirstOrder e "interpret" =>
(forall (rInitial :: EffectRow) x. e (Sem rInitial) x -> Sem r x)
-> Sem (e : r) a -> Sem r a
interpret \case
  Process f b
b -> forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (forall b c (r :: EffectRow).
Member (Methodology b c) r =>
b -> Sem r c
process @b @c) f b
b forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> forall (t :: * -> *) m. (Foldable t, Monoid m) => t m -> m
fold 
{-# INLINE mconcatMethodology #-}

-- | Reinterpreting version of `mconcatMethodology`.
--
-- @since 0.1.6.0
mconcatMethodology' ::
  forall f b c r a.
  (Monoid c, Traversable f) =>
  Sem (Methodology (f b) c ': r) a ->
  Sem (Methodology b c ': r) a
mconcatMethodology' :: forall (f :: * -> *) b c (r :: EffectRow) a.
(Monoid c, Traversable f) =>
Sem (Methodology (f b) c : r) a -> Sem (Methodology b c : r) a
mconcatMethodology' = forall (e2 :: Effect) (e1 :: Effect) (r :: EffectRow) a.
Sem (e1 : r) a -> Sem (e1 : e2 : r) a
raiseUnder forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> forall (f :: * -> *) b c (r :: EffectRow) a.
(Members '[Methodology b c] r, Monoid c, Traversable f) =>
Sem (Methodology (f b) c : r) a -> Sem r a
mconcatMethodology
{-# INLINE mconcatMethodology' #-}

-- | `Trace` a `String` based on the input to a `Methodology`.
--
-- @since 0.1.3.0
traceMethodologyStart ::
  forall b c r a.
  Members
    '[ Methodology b c,
       Trace
     ]
    r =>
  -- | A function from the input type b to a `String`.
  (b -> String) ->
  Sem r a ->
  Sem r a
traceMethodologyStart :: forall b c (r :: EffectRow) a.
Members '[Methodology b c, Trace] r =>
(b -> String) -> Sem r a -> Sem r a
traceMethodologyStart b -> String
f = forall (e :: Effect) (r :: EffectRow) a.
(Member e r, FirstOrder e "intercept") =>
(forall x (rInitial :: EffectRow). e (Sem rInitial) x -> Sem r x)
-> Sem r a -> Sem r a
intercept @(Methodology b c) \case
  Process b
b -> forall (r :: EffectRow). Member Trace r => String -> Sem r ()
trace (b -> String
f b
b) forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall b c (r :: EffectRow).
Member (Methodology b c) r =>
b -> Sem r c
process @b @c b
b
{-# INLINE traceMethodologyStart #-}

-- | `Trace` a `String` based on the output to a `Methodology`.
--
-- @since 0.1.3.0
traceMethodologyEnd ::
  forall b c r a.
  Members
    '[ Methodology b c,
       Trace
     ]
    r =>
  -- | A function from the output type c to a `String`.
  (c -> String) ->
  Sem r a ->
  Sem r a
traceMethodologyEnd :: forall b c (r :: EffectRow) a.
Members '[Methodology b c, Trace] r =>
(c -> String) -> Sem r a -> Sem r a
traceMethodologyEnd c -> String
f = forall (e :: Effect) (r :: EffectRow) a.
(Member e r, FirstOrder e "intercept") =>
(forall x (rInitial :: EffectRow). e (Sem rInitial) x -> Sem r x)
-> Sem r a -> Sem r a
intercept @(Methodology b c) \case
  Process b
b -> do
    c
c <- forall b c (r :: EffectRow).
Member (Methodology b c) r =>
b -> Sem r c
process @b @c b
b
    forall (r :: EffectRow). Member Trace r => String -> Sem r ()
trace forall a b. (a -> b) -> a -> b
$ c -> String
f c
c
    forall (m :: * -> *) a. Monad m => a -> m a
return c
c
{-# INLINE traceMethodologyEnd #-}

-- | `Trace` both the start and the end of a `Methodology`.
--
-- @since 0.1.3.0
traceMethodologyAround ::
  forall b c r a.
  Members
    '[ Methodology b c,
       Trace
     ]
    r =>
  -- | A function from the input type b to a `String`.
  (b -> String) ->
  -- | A function from the output type c to a `String`.
  (c -> String) ->
  Sem r a ->
  Sem r a
traceMethodologyAround :: forall b c (r :: EffectRow) a.
Members '[Methodology b c, Trace] r =>
(b -> String) -> (c -> String) -> Sem r a -> Sem r a
traceMethodologyAround b -> String
f c -> String
g = forall (e :: Effect) (r :: EffectRow) a.
(Member e r, FirstOrder e "intercept") =>
(forall x (rInitial :: EffectRow). e (Sem rInitial) x -> Sem r x)
-> Sem r a -> Sem r a
intercept @(Methodology b c) \case
  Process b
b -> do
    forall (r :: EffectRow). Member Trace r => String -> Sem r ()
trace forall a b. (a -> b) -> a -> b
$ b -> String
f b
b
    c
c <- forall b c (r :: EffectRow).
Member (Methodology b c) r =>
b -> Sem r c
process @b @c b
b
    forall (r :: EffectRow). Member Trace r => String -> Sem r ()
trace forall a b. (a -> b) -> a -> b
$ c -> String
g c
c
    forall (m :: * -> *) a. Monad m => a -> m a
return c
c
{-# INLINE traceMethodologyAround #-}