{-# 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 (
Methodology(..)
, process
, runMethodologyPure
, runMethodologySem
, cutMethodology
, cutMethodology'
, cutMethodology3
, cutMethodology3'
, divideMethodology
, divideMethodology'
, decideMethodology
, decideMethodology'
, decomposeMethodology
, decomposeMethodology'
, decomposeMethodology3
, separateMethodologyInitial
, endMethodologyInitial
, separateMethodologyTerminal
, endMethodologyTerminal
, fmapMethodology
, fmapMethodology'
, fmap2Methodology
, fmap2Methodology'
, pureMethodology
, pureMethodology'
, bindMethodology
, bindMethodology'
, traverseMethodology
, traverseMethodology'
, mconcatMethodology
, mconcatMethodology'
, teeMethodologyOutput
, plugMethodologyInput
, runMethodologyAsKVStore
, runMethodologyAsKVStoreWithDefault
, traceMethodologyStart
, traceMethodologyEnd
, traceMethodologyAround
, logMethodologyStart
, logMethodologyEnd
, logMethodologyAround
) where
import Control.Arrow
import Control.Monad
import Colog.Polysemy as C
import Polysemy
import Polysemy.KVStore
import Polysemy.Input
import Polysemy.Output
import Polysemy.Several
import Polysemy.Trace
data Methodology b c m a where
Process :: b -> Methodology b c m c
makeSem ''Methodology
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
{-# INLINE runMethodologyPure #-}
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
{-# INLINE runMethodologySem #-}
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
{-# INLINE cutMethodology #-}
cutMethodology' :: forall b c d r a.
Sem (Methodology b d ': r) a
-> Sem (Methodology b c ': Methodology c d ': r) a
cutMethodology' :: Sem (Methodology b d : r) a
-> Sem (Methodology b c : Methodology c d : r) a
cutMethodology' = (forall (m :: * -> *) x.
Methodology b d m x
-> Sem (Methodology b c : Methodology c d : r) x)
-> Sem (Methodology b d : r) a
-> Sem (Methodology b c : Methodology c d : r) a
forall (e1 :: (* -> *) -> * -> *) (e2 :: (* -> *) -> * -> *)
(e3 :: (* -> *) -> * -> *) (r :: [(* -> *) -> * -> *]) a.
FirstOrder e1 "reinterpret2" =>
(forall (m :: * -> *) x. e1 m x -> Sem (e2 : e3 : r) x)
-> Sem (e1 : r) a -> Sem (e2 : e3 : r) a
reinterpret2 \case
Process b -> b -> Sem (Methodology b c : Methodology c d : r) c
forall b c (r :: [(* -> *) -> * -> *]).
MemberWithError (Methodology b c) r =>
b -> Sem r c
process @b @c b
b Sem (Methodology b c : Methodology c d : r) c
-> (c -> Sem (Methodology b c : Methodology c d : r) d)
-> Sem (Methodology b c : Methodology c d : r) d
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Sem (Methodology c d : r) d
-> Sem (Methodology b c : Methodology c d : r) d
forall (e :: (* -> *) -> * -> *) (r :: [(* -> *) -> * -> *]) a.
Sem r a -> Sem (e : r) a
raise (Sem (Methodology c d : r) d
-> Sem (Methodology b c : Methodology c d : r) d)
-> (c -> Sem (Methodology c d : r) d)
-> c
-> Sem (Methodology b c : Methodology c d : r) d
forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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
{-# INLINE cutMethodology' #-}
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
{-# INLINE cutMethodology3 #-}
cutMethodology3' :: forall b c d e r a.
Sem (Methodology b d ': r) a
-> Sem (Methodology b c ': Methodology c d ': Methodology d e ': r) a
cutMethodology3' :: Sem (Methodology b d : r) a
-> Sem (Methodology b c : Methodology c d : Methodology d e : r) a
cutMethodology3' = (forall (m :: * -> *) x.
Methodology b d m x
-> Sem (Methodology b c : Methodology c d : Methodology d e : r) x)
-> Sem (Methodology b d : r) a
-> Sem (Methodology b c : Methodology c d : Methodology d e : r) a
forall (e1 :: (* -> *) -> * -> *) (e2 :: (* -> *) -> * -> *)
(e3 :: (* -> *) -> * -> *) (e4 :: (* -> *) -> * -> *)
(r :: [(* -> *) -> * -> *]) a.
FirstOrder e1 "reinterpret3" =>
(forall (m :: * -> *) x. e1 m x -> Sem (e2 : e3 : e4 : r) x)
-> Sem (e1 : r) a -> Sem (e2 : e3 : e4 : r) a
reinterpret3 \case
Process b -> b
-> Sem (Methodology b c : Methodology c d : Methodology d e : r) c
forall b c (r :: [(* -> *) -> * -> *]).
MemberWithError (Methodology b c) r =>
b -> Sem r c
process @b @c b
b Sem (Methodology b c : Methodology c d : Methodology d e : r) c
-> (c
-> Sem (Methodology b c : Methodology c d : Methodology d e : r) d)
-> Sem (Methodology b c : Methodology c d : Methodology d e : r) d
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Sem (Methodology c d : Methodology d e : r) d
-> Sem (Methodology b c : Methodology c d : Methodology d e : r) d
forall (e :: (* -> *) -> * -> *) (r :: [(* -> *) -> * -> *]) a.
Sem r a -> Sem (e : r) a
raise (Sem (Methodology c d : Methodology d e : r) d
-> Sem (Methodology b c : Methodology c d : Methodology d e : r) d)
-> (c -> Sem (Methodology c d : Methodology d e : r) d)
-> c
-> Sem (Methodology b c : Methodology c d : Methodology d e : r) d
forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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
{-# INLINE cutMethodology3' #-}
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')
{-# INLINE divideMethodology #-}
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' :: Sem (Methodology b d : r) a
-> Sem
(Methodology b c : Methodology b c' : Methodology (c, c') d : r) a
divideMethodology' = (forall (m :: * -> *) x.
Methodology b d m x
-> Sem
(Methodology b c : Methodology b c' : Methodology (c, c') d : r) x)
-> Sem (Methodology b d : r) a
-> Sem
(Methodology b c : Methodology b c' : Methodology (c, c') d : r) a
forall (e1 :: (* -> *) -> * -> *) (e2 :: (* -> *) -> * -> *)
(e3 :: (* -> *) -> * -> *) (e4 :: (* -> *) -> * -> *)
(r :: [(* -> *) -> * -> *]) a.
FirstOrder e1 "reinterpret3" =>
(forall (m :: * -> *) x. e1 m x -> Sem (e2 : e3 : e4 : r) x)
-> Sem (e1 : r) a -> Sem (e2 : e3 : e4 : r) a
reinterpret3 \case
Process b -> do
c
c <- b
-> Sem
(Methodology b c : Methodology b c' : Methodology (c, c') d : r) c
forall b c (r :: [(* -> *) -> * -> *]).
MemberWithError (Methodology b c) r =>
b -> Sem r c
process @b @c b
b
c'
c' <- Sem (Methodology b c' : Methodology (c, c') d : r) c'
-> Sem
(Methodology b c : Methodology b c' : Methodology (c, c') d : r) c'
forall (e :: (* -> *) -> * -> *) (r :: [(* -> *) -> * -> *]) a.
Sem r a -> Sem (e : r) a
raise (Sem (Methodology b c' : Methodology (c, c') d : r) c'
-> Sem
(Methodology b c : Methodology b c' : Methodology (c, c') d : r)
c')
-> Sem (Methodology b c' : Methodology (c, c') d : r) c'
-> Sem
(Methodology b c : Methodology b c' : Methodology (c, c') d : r) c'
forall a b. (a -> b) -> a -> b
$ b -> Sem (Methodology b c' : Methodology (c, c') d : r) c'
forall b c (r :: [(* -> *) -> * -> *]).
MemberWithError (Methodology b c) r =>
b -> Sem r c
process @b @c' b
b
Sem (Methodology b c' : Methodology (c, c') d : r) d
-> Sem
(Methodology b c : Methodology b c' : Methodology (c, c') d : r) d
forall (e :: (* -> *) -> * -> *) (r :: [(* -> *) -> * -> *]) a.
Sem r a -> Sem (e : r) a
raise (Sem (Methodology b c' : Methodology (c, c') d : r) d
-> Sem
(Methodology b c : Methodology b c' : Methodology (c, c') d : r) d)
-> Sem (Methodology b c' : Methodology (c, c') d : r) d
-> Sem
(Methodology b c : Methodology b c' : Methodology (c, c') d : r) d
forall a b. (a -> b) -> a -> b
$ Sem (Methodology (c, c') d : r) d
-> Sem (Methodology b c' : Methodology (c, c') d : r) d
forall (e :: (* -> *) -> * -> *) (r :: [(* -> *) -> * -> *]) a.
Sem r a -> Sem (e : r) a
raise (Sem (Methodology (c, c') d : r) d
-> Sem (Methodology b c' : Methodology (c, c') d : r) d)
-> Sem (Methodology (c, c') d : r) d
-> Sem (Methodology b c' : Methodology (c, c') d : r) d
forall a b. (a -> b) -> a -> b
$ (c, c') -> Sem (Methodology (c, c') d : r) d
forall b c (r :: [(* -> *) -> * -> *]).
MemberWithError (Methodology b c) r =>
b -> Sem r c
process @(c, c') @d (c
c, c'
c')
{-# INLINE divideMethodology' #-}
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'
{-# INLINE decideMethodology #-}
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' :: Sem (Methodology b d : r) a
-> Sem
(Methodology b (Either c c')
: Methodology c d : Methodology c' d : r)
a
decideMethodology' = (forall (m :: * -> *) x.
Methodology b d m x
-> Sem
(Methodology b (Either c c')
: Methodology c d : Methodology c' d : r)
x)
-> Sem (Methodology b d : r) a
-> Sem
(Methodology b (Either c c')
: Methodology c d : Methodology c' d : r)
a
forall (e1 :: (* -> *) -> * -> *) (e2 :: (* -> *) -> * -> *)
(e3 :: (* -> *) -> * -> *) (e4 :: (* -> *) -> * -> *)
(r :: [(* -> *) -> * -> *]) a.
FirstOrder e1 "reinterpret3" =>
(forall (m :: * -> *) x. e1 m x -> Sem (e2 : e3 : e4 : r) x)
-> Sem (e1 : r) a -> Sem (e2 : e3 : e4 : r) a
reinterpret3 \case
Process b -> do
Either c c'
k <- b
-> Sem
(Methodology b (Either c c')
: Methodology c d : Methodology c' d : 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 -> Sem (Methodology c d : Methodology c' d : r) d
-> Sem
(Methodology b (Either c c')
: Methodology c d : Methodology c' d : r)
d
forall (e :: (* -> *) -> * -> *) (r :: [(* -> *) -> * -> *]) a.
Sem r a -> Sem (e : r) a
raise (Sem (Methodology c d : Methodology c' d : r) d
-> Sem
(Methodology b (Either c c')
: Methodology c d : Methodology c' d : r)
d)
-> Sem (Methodology c d : Methodology c' d : r) d
-> Sem
(Methodology b (Either c c')
: Methodology c d : Methodology c' d : r)
d
forall a b. (a -> b) -> a -> b
$ c -> Sem (Methodology c d : Methodology c' d : r) d
forall b c (r :: [(* -> *) -> * -> *]).
MemberWithError (Methodology b c) r =>
b -> Sem r c
process @c @d c
c
Right c'
c' -> Sem (Methodology c d : Methodology c' d : r) d
-> Sem
(Methodology b (Either c c')
: Methodology c d : Methodology c' d : r)
d
forall (e :: (* -> *) -> * -> *) (r :: [(* -> *) -> * -> *]) a.
Sem r a -> Sem (e : r) a
raise (Sem (Methodology c d : Methodology c' d : r) d
-> Sem
(Methodology b (Either c c')
: Methodology c d : Methodology c' d : r)
d)
-> Sem (Methodology c d : Methodology c' d : r) d
-> Sem
(Methodology b (Either c c')
: Methodology c d : Methodology c' d : r)
d
forall a b. (a -> b) -> a -> b
$ Sem (Methodology c' d : r) d
-> Sem (Methodology c d : Methodology c' d : r) d
forall (e :: (* -> *) -> * -> *) (r :: [(* -> *) -> * -> *]) a.
Sem r a -> Sem (e : r) a
raise (Sem (Methodology c' d : r) d
-> Sem (Methodology c d : Methodology c' d : r) d)
-> Sem (Methodology c' d : r) d
-> Sem (Methodology c d : Methodology c' d : r) d
forall a b. (a -> b) -> a -> b
$ c' -> Sem (Methodology c' d : r) d
forall b c (r :: [(* -> *) -> * -> *]).
MemberWithError (Methodology b c) r =>
b -> Sem r c
process @c' @d c'
c'
{-# INLINE decideMethodology' #-}
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
{-# INLINE teeMethodologyOutput #-}
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)
{-# INLINE plugMethodologyInput #-}
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
{-# INLINE runMethodologyAsKVStore #-}
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
{-# INLINE runMethodologyAsKVStoreWithDefault #-}
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
{-# INLINE decomposeMethodology #-}
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' :: Sem (Methodology b c : r) a
-> Sem (Methodology b (HList f) : Methodology (HList f) c : r) a
decomposeMethodology' = forall (r :: [(* -> *) -> * -> *]) a.
Sem (Methodology b c : r) a
-> Sem (Methodology b (HList f) : Methodology (HList f) c : r) a
forall b c d (r :: [(* -> *) -> * -> *]) a.
Sem (Methodology b d : r) a
-> Sem (Methodology b c : Methodology c d : r) a
cutMethodology' @b @(HList f) @c
{-# INLINE decomposeMethodology' #-}
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
{-# INLINE decomposeMethodology3 #-}
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'
{-# INLINE separateMethodologyInitial #-}
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
{-# INLINE endMethodologyInitial #-}
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'
{-# INLINE separateMethodologyTerminal #-}
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
{-# INLINE endMethodologyTerminal #-}
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
{-# INLINE fmapMethodology #-}
fmapMethodology' :: forall f b c r a.
Traversable f
=> Sem (Methodology (f b) (f c) ': r) a
-> Sem (Methodology b c ': r) a
fmapMethodology' :: Sem (Methodology (f b) (f c) : r) a -> Sem (Methodology b c : r) a
fmapMethodology' = Sem (Methodology (f b) (f c) : r) a
-> Sem (Methodology (f b) (f c) : Methodology b c : r) a
forall (e2 :: (* -> *) -> * -> *) (e1 :: (* -> *) -> * -> *)
(r :: [(* -> *) -> * -> *]) a.
Sem (e1 : r) a -> Sem (e1 : e2 : r) a
raiseUnder (Sem (Methodology (f b) (f c) : r) a
-> Sem (Methodology (f b) (f c) : Methodology b c : r) a)
-> (Sem (Methodology (f b) (f c) : Methodology b c : r) a
-> Sem (Methodology b c : r) a)
-> Sem (Methodology (f b) (f c) : r) a
-> Sem (Methodology b c : r) a
forall k (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> Sem (Methodology (f b) (f c) : Methodology b c : r) a
-> Sem (Methodology b c : 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
{-# INLINE fmapMethodology' #-}
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 :: Sem (Methodology (f (g b)) (f (g c)) : r) a -> Sem r a
fmap2Methodology = forall (r :: [(* -> *) -> * -> *]) a.
Traversable f =>
Sem (Methodology (f (g b)) (f (g c)) : r) a
-> Sem (Methodology (g b) (g c) : r) a
forall (f :: * -> *) b c (r :: [(* -> *) -> * -> *]) a.
Traversable f =>
Sem (Methodology (f b) (f c) : r) a -> Sem (Methodology b c : r) a
fmapMethodology' @f @(g b) @(g c) (Sem (Methodology (f (g b)) (f (g c)) : r) a
-> Sem (Methodology (g b) (g c) : r) a)
-> (Sem (Methodology (g b) (g c) : r) a -> Sem r a)
-> Sem (Methodology (f (g b)) (f (g c)) : r) a
-> Sem r a
forall k (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> 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
{-# INLINE fmap2Methodology #-}
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' :: Sem (Methodology (f (g b)) (f (g c)) : r) a
-> Sem (Methodology b c : r) a
fmap2Methodology' = Sem (Methodology (f (g b)) (f (g c)) : r) a
-> Sem (Methodology (f (g b)) (f (g c)) : Methodology b c : r) a
forall (e2 :: (* -> *) -> * -> *) (e1 :: (* -> *) -> * -> *)
(r :: [(* -> *) -> * -> *]) a.
Sem (e1 : r) a -> Sem (e1 : e2 : r) a
raiseUnder (Sem (Methodology (f (g b)) (f (g c)) : r) a
-> Sem (Methodology (f (g b)) (f (g c)) : Methodology b c : r) a)
-> (Sem (Methodology (f (g b)) (f (g c)) : Methodology b c : r) a
-> Sem (Methodology b c : r) a)
-> Sem (Methodology (f (g b)) (f (g c)) : r) a
-> Sem (Methodology b c : r) a
forall k (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> Sem (Methodology (f (g b)) (f (g c)) : Methodology b c : r) a
-> Sem (Methodology b c : r) a
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
{-# INLINE fmap2Methodology' #-}
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 :: Sem (Methodology b (f c) : r) a -> Sem r a
pureMethodology = (forall x (m :: * -> *). Methodology b (f c) m x -> Sem r x)
-> Sem (Methodology 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 -> c -> f c
forall (f :: * -> *) a. Applicative f => a -> f a
pure (c -> f c) -> Sem r c -> Sem r (f c)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> b -> Sem r c
forall b c (r :: [(* -> *) -> * -> *]).
MemberWithError (Methodology b c) r =>
b -> Sem r c
process @b @c b
b
{-# INLINE pureMethodology #-}
pureMethodology' :: forall f b c r a. Applicative f
=> Sem (Methodology b (f c) ': r) a
-> Sem (Methodology b c ': r) a
pureMethodology' :: Sem (Methodology b (f c) : r) a -> Sem (Methodology b c : r) a
pureMethodology' = Sem (Methodology b (f c) : r) a
-> Sem (Methodology b (f c) : Methodology b c : r) a
forall (e2 :: (* -> *) -> * -> *) (e1 :: (* -> *) -> * -> *)
(r :: [(* -> *) -> * -> *]) a.
Sem (e1 : r) a -> Sem (e1 : e2 : r) a
raiseUnder (Sem (Methodology b (f c) : r) a
-> Sem (Methodology b (f c) : Methodology b c : r) a)
-> (Sem (Methodology b (f c) : Methodology b c : r) a
-> Sem (Methodology b c : r) a)
-> Sem (Methodology b (f c) : r) a
-> Sem (Methodology b c : r) a
forall k (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> Sem (Methodology b (f c) : Methodology b c : r) a
-> Sem (Methodology b c : r) a
forall (f :: * -> *) b c (r :: [(* -> *) -> * -> *]) a.
(Members '[Methodology b c] r, Applicative f) =>
Sem (Methodology b (f c) : r) a -> Sem r a
pureMethodology
{-# INLINE pureMethodology' #-}
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
{-# INLINE bindMethodology #-}
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' :: Sem (Methodology (f b) (f c) : r) a
-> Sem (Methodology b (f c) : r) a
bindMethodology' = Sem (Methodology (f b) (f c) : r) a
-> Sem (Methodology (f b) (f c) : Methodology b (f c) : r) a
forall (e2 :: (* -> *) -> * -> *) (e1 :: (* -> *) -> * -> *)
(r :: [(* -> *) -> * -> *]) a.
Sem (e1 : r) a -> Sem (e1 : e2 : r) a
raiseUnder (Sem (Methodology (f b) (f c) : r) a
-> Sem (Methodology (f b) (f c) : Methodology b (f c) : r) a)
-> (Sem (Methodology (f b) (f c) : Methodology b (f c) : r) a
-> Sem (Methodology b (f c) : r) a)
-> Sem (Methodology (f b) (f c) : r) a
-> Sem (Methodology b (f c) : r) a
forall k (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> Sem (Methodology (f b) (f c) : Methodology b (f c) : r) a
-> Sem (Methodology b (f c) : r) a
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
{-# INLINE bindMethodology' #-}
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
{-# INLINE traverseMethodology #-}
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' :: Sem (Methodology (t b) (f (t c)) : r) a
-> Sem (Methodology b (f c) : r) a
traverseMethodology' = Sem (Methodology (t b) (f (t c)) : r) a
-> Sem (Methodology (t b) (f (t c)) : Methodology b (f c) : r) a
forall (e2 :: (* -> *) -> * -> *) (e1 :: (* -> *) -> * -> *)
(r :: [(* -> *) -> * -> *]) a.
Sem (e1 : r) a -> Sem (e1 : e2 : r) a
raiseUnder (Sem (Methodology (t b) (f (t c)) : r) a
-> Sem (Methodology (t b) (f (t c)) : Methodology b (f c) : r) a)
-> (Sem (Methodology (t b) (f (t c)) : Methodology b (f c) : r) a
-> Sem (Methodology b (f c) : r) a)
-> Sem (Methodology (t b) (f (t c)) : r) a
-> Sem (Methodology b (f c) : r) a
forall k (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> Sem (Methodology (t b) (f (t c)) : Methodology b (f c) : r) a
-> Sem (Methodology b (f c) : r) a
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
{-# INLINE traverseMethodology' #-}
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 :: Sem (Methodology (f b) c : r) a -> Sem r a
mconcatMethodology = (forall x (m :: * -> *). Methodology (f b) c m x -> Sem r x)
-> Sem (Methodology (f 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 -> 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 Sem r (f c) -> (f c -> Sem r c) -> Sem r c
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= c -> Sem r c
forall (m :: * -> *) a. Monad m => a -> m a
return (c -> Sem r c) -> (f c -> c) -> f c -> Sem r c
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (c -> c -> c) -> c -> f c -> c
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr c -> c -> c
forall a. Semigroup a => a -> a -> a
(<>) c
forall a. Monoid a => a
mempty
{-# INLINE mconcatMethodology #-}
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' :: Sem (Methodology (f b) c : r) a -> Sem (Methodology b c : r) a
mconcatMethodology' = Sem (Methodology (f b) c : r) a
-> Sem (Methodology (f b) c : Methodology b c : r) a
forall (e2 :: (* -> *) -> * -> *) (e1 :: (* -> *) -> * -> *)
(r :: [(* -> *) -> * -> *]) a.
Sem (e1 : r) a -> Sem (e1 : e2 : r) a
raiseUnder (Sem (Methodology (f b) c : r) a
-> Sem (Methodology (f b) c : Methodology b c : r) a)
-> (Sem (Methodology (f b) c : Methodology b c : r) a
-> Sem (Methodology b c : r) a)
-> Sem (Methodology (f b) c : r) a
-> Sem (Methodology b c : r) a
forall k (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> Sem (Methodology (f b) c : Methodology b c : r) a
-> Sem (Methodology b c : r) a
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
{-# INLINE mconcatMethodology' #-}
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
{-# INLINE traceMethodologyStart #-}
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
{-# INLINE traceMethodologyEnd #-}
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
{-# INLINE traceMethodologyAround #-}
logMethodologyStart :: forall b c p r a.
Members '[Methodology b c,
Log p] r
=> (b -> p)
-> Sem r a
-> Sem r a
logMethodologyStart :: (b -> p) -> Sem r a -> Sem r a
logMethodologyStart b -> p
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 -> p -> Sem r ()
forall msg (r :: [(* -> *) -> * -> *]).
Member (Log msg) r =>
msg -> Sem r ()
C.log (b -> p
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
{-# INLINE logMethodologyStart #-}
logMethodologyEnd :: forall b c q r a.
Members '[Methodology b c,
Log q] r
=> (c -> q)
-> Sem r a
-> Sem r a
logMethodologyEnd :: (c -> q) -> Sem r a -> Sem r a
logMethodologyEnd c -> q
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
q -> Sem r ()
forall msg (r :: [(* -> *) -> * -> *]).
Member (Log msg) r =>
msg -> Sem r ()
C.log (q -> Sem r ()) -> q -> Sem r ()
forall a b. (a -> b) -> a -> b
$ c -> q
f c
c
c -> Sem r c
forall (m :: * -> *) a. Monad m => a -> m a
return c
c
{-# INLINE logMethodologyEnd #-}
logMethodologyAround :: forall b c p q r a.
Members '[ Methodology b c
, Log p
, Log q] r
=> (b -> p)
-> (c -> q)
-> Sem r a
-> Sem r a
logMethodologyAround :: (b -> p) -> (c -> q) -> Sem r a -> Sem r a
logMethodologyAround b -> p
f c -> q
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
p -> Sem r ()
forall msg (r :: [(* -> *) -> * -> *]).
Member (Log msg) r =>
msg -> Sem r ()
C.log (p -> Sem r ()) -> p -> Sem r ()
forall a b. (a -> b) -> a -> b
$ b -> p
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
q -> Sem r ()
forall msg (r :: [(* -> *) -> * -> *]).
Member (Log msg) r =>
msg -> Sem r ()
C.log (q -> Sem r ()) -> q -> Sem r ()
forall a b. (a -> b) -> a -> b
$ c -> q
g c
c
c -> Sem r c
forall (m :: * -> *) a. Monad m => a -> m a
return c
c
{-# INLINE logMethodologyAround #-}