{-| Description : A data structure for emission plans
    License     : MIT

An @t'Effable' m b@ is

- a __pure plan__ for the later emission of @b@s

- a representation of an __ordered sequence of @b@s__, each annotated with an /emission wrapper/ @m () -> m ()@

- __emitted__ to its eventual result @m ()@ __with 'run'__ (/interpretation/\//elimination/)

- fairly __opaque__

    - its constructor is not exported
    - observing it is only supported through 'run'/'runWith'

- __/niche: see Caveats section/__


== Why?

Compared to just working in the monadic @m b@ context, t'Effable' brings one particular distinguishing feature:

/An t'Effable' can undergo decoration with emission wrappers ('wrap', 'wrapInside') after which it is still a pure t'Effable'./

This means that even after having been modified with wrappers, or any other supported transformation...

- ...it is still a 'Functor', 'Applicative' and 'Monad' in @b@
- ...it can be transformed further and combined into more complex structures with '<>'

Emission wrappers can be applied to granular constituents of an t'Effable' as the user code is building it. The t'Effable' machinery will track the wrappers behind-the-scenes through all supported transformations so that the eventual emission respects them.


== Caveats and usage scope

- [effectful predicates](#g:branching) and [emission wrappers](#v:wrap) typically run more than once when a plan is emitted

    - these actions should yield the same value across evaluations, otherwise the inclusion of branches will be inconsistent
    - /therefore/, t'Effable' is only suitable when __these actions are read-like__ (return the same value over repeated evaluations and are free of externally observable side-effects)

- the nesting of combinators and use of '<*>' and '>>=' will grow the internal t'Effable' representation, and the number of times actions are run at emission, combinatorially


== Intuition

/t'Effable's are kept pure through all supported transformations by representing all possible outcomes of actions that affect structure. Running the actions is deferred to emission time. This comes with the cost of the internal representation carrying a complexity proportional to all possible outcomes./

Metaphorically, t'Effable' is the many-worlds interpretation of /actions/ meaning actions can be represented without them interacting with the actual world (= purity) and its representation is not collapsed to an outcome until it is observed (= 'run').


== \"Effable\"?

/Effable/ as in /sayable/ or /utterable/.

Or, /Eff-able/ as in /able to be effected/ or /effectuated/ - something with the potential of becoming effects.
-}

{-# LANGUAGE OverloadedStrings #-}

module Effable
(
  -- * Type
  Effable
, Wrap

  -- * Create
, singleton
, embed
, string
, empty

-- * Transform items
, mapItems

-- * Transform wraps
-- $wrap
, wrap
, wrapInside

-- * Branching #branching#
, when'
, whenA
, onlyIf
, ifThenElse
, Enumerable
, byAction
, embedAction

-- * Effectuate
, run
, RunWith
, runWith

)
where

import Data.String (IsString (..))
import Data.Coerce
import Control.Monad (when, MonadPlus)
import Control.Applicative (Const(..), Alternative ((<|>)))
import Control.Applicative qualified as Alt (Alternative(empty))
import Data.Word (Word8)
import Data.Foldable (traverse_)
import Data.Text (Text)

{- implementation notes:

- instances of "\ \" etc. in docstrings are in order to sync vertical alignment/whitespace padding between code and the generated haddock

-}

{- $setup
>>> import Data.Word (Word8)
-}


--- types, type helpers
--- -------------------

-- | An emission wrapper.
type Wrap m = m () -> m ()


--- Part ---

data Part m b = Part
  { forall (m :: * -> *) b. Part m b -> Wrap m
partWrap  :: Wrap m
  , forall (m :: * -> *) b. Part m b -> b
partItem :: b
  }
  deriving ((forall a b. (a -> b) -> Part m a -> Part m b)
-> (forall a b. a -> Part m b -> Part m a) -> Functor (Part m)
forall a b. a -> Part m b -> Part m a
forall a b. (a -> b) -> Part m a -> Part m b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
forall (m :: * -> *) a b. a -> Part m b -> Part m a
forall (m :: * -> *) a b. (a -> b) -> Part m a -> Part m b
$cfmap :: forall (m :: * -> *) a b. (a -> b) -> Part m a -> Part m b
fmap :: forall a b. (a -> b) -> Part m a -> Part m b
$c<$ :: forall (m :: * -> *) a b. a -> Part m b -> Part m a
<$ :: forall a b. a -> Part m b -> Part m a
Functor)

instance Applicative (Part m) where
  pure :: b -> Part m b
  pure :: forall a. a -> Part m a
pure b
x = Wrap m -> b -> Part m b
forall (m :: * -> *) b. Wrap m -> b -> Part m b
Part Wrap m
forall a. a -> a
id b
x

  (<*>) :: Part m (b -> b') -> Part m b -> Part m b'
  Part Wrap m
wf b -> b'
lf <*> :: forall a b. Part m (a -> b) -> Part m a -> Part m b
<*> Part Wrap m
wx b
lx  =  Wrap m -> b' -> Part m b'
forall (m :: * -> *) b. Wrap m -> b -> Part m b
Part (Wrap m
wf Wrap m -> Wrap m -> Wrap m
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Wrap m
wx) (b -> b'
lf b
lx)

mapPartWrap :: (Wrap m -> Wrap m) -> Part m b -> Part m b
mapPartWrap :: forall (m :: * -> *) b. (Wrap m -> Wrap m) -> Part m b -> Part m b
mapPartWrap Wrap m -> Wrap m
f (Part Wrap m
w b
l) = Wrap m -> b -> Part m b
forall (m :: * -> *) b. Wrap m -> b -> Part m b
Part (Wrap m -> Wrap m
f Wrap m
w) b
l

emitPart :: (b -> m ()) -> Part m b -> m ()
emitPart :: forall b (m :: * -> *). (b -> m ()) -> Part m b -> m ()
emitPart b -> m ()
emit (Part Wrap m
w b
l) = Wrap m
w (b -> m ()
emit b
l)

{-# INLINE mapPartWrap #-}
{-# INLINE emitPart    #-}


--- Effable ---

{- | An ordered sequence of values, each with an associated emission wrapper (default: 'id'). -}
newtype Effable m b = Effable { forall (m :: * -> *) b. Effable m b -> [Part m b]
inEffable :: [Part m b] }
  deriving (NonEmpty (Effable m b) -> Effable m b
Effable m b -> Effable m b -> Effable m b
(Effable m b -> Effable m b -> Effable m b)
-> (NonEmpty (Effable m b) -> Effable m b)
-> (forall b. Integral b => b -> Effable m b -> Effable m b)
-> Semigroup (Effable m b)
forall b. Integral b => b -> Effable m b -> Effable m b
forall a.
(a -> a -> a)
-> (NonEmpty a -> a)
-> (forall b. Integral b => b -> a -> a)
-> Semigroup a
forall (m :: * -> *) b. NonEmpty (Effable m b) -> Effable m b
forall (m :: * -> *) b. Effable m b -> Effable m b -> Effable m b
forall (m :: * -> *) b b.
Integral b =>
b -> Effable m b -> Effable m b
$c<> :: forall (m :: * -> *) b. Effable m b -> Effable m b -> Effable m b
<> :: Effable m b -> Effable m b -> Effable m b
$csconcat :: forall (m :: * -> *) b. NonEmpty (Effable m b) -> Effable m b
sconcat :: NonEmpty (Effable m b) -> Effable m b
$cstimes :: forall (m :: * -> *) b b.
Integral b =>
b -> Effable m b -> Effable m b
stimes :: forall b. Integral b => b -> Effable m b -> Effable m b
Semigroup, Semigroup (Effable m b)
Effable m b
Semigroup (Effable m b) =>
Effable m b
-> (Effable m b -> Effable m b -> Effable m b)
-> ([Effable m b] -> Effable m b)
-> Monoid (Effable m b)
[Effable m b] -> Effable m b
Effable m b -> Effable m b -> Effable m b
forall a.
Semigroup a =>
a -> (a -> a -> a) -> ([a] -> a) -> Monoid a
forall (m :: * -> *) b. Semigroup (Effable m b)
forall (m :: * -> *) b. Effable m b
forall (m :: * -> *) b. [Effable m b] -> Effable m b
forall (m :: * -> *) b. Effable m b -> Effable m b -> Effable m b
$cmempty :: forall (m :: * -> *) b. Effable m b
mempty :: Effable m b
$cmappend :: forall (m :: * -> *) b. Effable m b -> Effable m b -> Effable m b
mappend :: Effable m b -> Effable m b -> Effable m b
$cmconcat :: forall (m :: * -> *) b. [Effable m b] -> Effable m b
mconcat :: [Effable m b] -> Effable m b
Monoid, (forall a b. (a -> b) -> Effable m a -> Effable m b)
-> (forall a b. a -> Effable m b -> Effable m a)
-> Functor (Effable m)
forall a b. a -> Effable m b -> Effable m a
forall a b. (a -> b) -> Effable m a -> Effable m b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
forall (m :: * -> *) a b. a -> Effable m b -> Effable m a
forall (m :: * -> *) a b. (a -> b) -> Effable m a -> Effable m b
$cfmap :: forall (m :: * -> *) a b. (a -> b) -> Effable m a -> Effable m b
fmap :: forall a b. (a -> b) -> Effable m a -> Effable m b
$c<$ :: forall (m :: * -> *) a b. a -> Effable m b -> Effable m a
<$ :: forall a b. a -> Effable m b -> Effable m a
Functor)

instance (IsString b) => IsString (Effable m b) where
  fromString :: String -> Effable m b
fromString = String -> Effable m b
forall b (m :: * -> *). IsString b => String -> Effable m b
string

{- | 'Applicative' models /list-like indeterminism/: the result of @xs '<*>' fs@ is /all combinations/ of embedded functions and embedded values.

In the result of @fs '<*>' xs@, emission wrappers of @f@s are composed on the outside of that of @xs@.

=== Examples

>>> import Data.Functor.Const (Const (..))
>>> runConst = run (\b -> Const [b])
>>> runConst $ (embed pred <> embed succ) <*> (embed '1' <> embed 'b')
Const "0a2c"

>>> runConst $ embed succ <*> (embed (1::Word8) <> whenA True (embed 5))
Const [2,6]

-}
instance Applicative (Effable m) where
  pure :: b -> Effable m b
  pure :: forall a. a -> Effable m a
pure b
x = [Part m b] -> Effable m b
forall (m :: * -> *) b. [Part m b] -> Effable m b
Effable [b -> Part m b
forall a. a -> Part m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure b
x]

  (<*>) :: Effable m (b -> b') -> Effable m b -> Effable m b'
  Effable [Part m (b -> b')]
fs <*> :: forall a b. Effable m (a -> b) -> Effable m a -> Effable m b
<*> Effable [Part m b]
xs  =
    [Part m b'] -> Effable m b'
forall (m :: * -> *) b. [Part m b] -> Effable m b
Effable
      [ Part m (b -> b')
f Part m (b -> b') -> Part m b -> Part m b'
forall a b. Part m (a -> b) -> Part m a -> Part m b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Part m b
x
        | Part m (b -> b')
f <- [Part m (b -> b')]
fs
        , Part m b
x <- [Part m b]
xs
      ]
    -- == the list Applicative lifted through 'Part'

_effable_applicative_doctest_typechecks :: a
_effable_applicative_doctest_typechecks :: forall a. a
_effable_applicative_doctest_typechecks = a
forall a. HasCallStack => a
undefined
  where
    runConst :: Effable (Const [a]) a -> Const [a] ()
runConst = (a -> Const [a] ()) -> Effable (Const [a]) a -> Const [a] ()
forall (m :: * -> *) b.
Applicative m =>
(b -> m ()) -> Effable m b -> m ()
run (\a
b -> [a] -> Const [a] ()
forall {k} a (b :: k). a -> Const a b
Const [a
b])

    _ex0 :: Const [Char] ()
    _ex0 :: Const String ()
_ex0 = Effable (Const String) Char -> Const String ()
forall {a}. Effable (Const [a]) a -> Const [a] ()
runConst (Effable (Const String) Char -> Const String ())
-> Effable (Const String) Char -> Const String ()
forall a b. (a -> b) -> a -> b
$ ((Char -> Char) -> Effable (Const String) (Char -> Char)
forall b (m :: * -> *). b -> Effable m b
embed Char -> Char
forall a. Enum a => a -> a
pred Effable (Const String) (Char -> Char)
-> Effable (Const String) (Char -> Char)
-> Effable (Const String) (Char -> Char)
forall a. Semigroup a => a -> a -> a
<> (Char -> Char) -> Effable (Const String) (Char -> Char)
forall b (m :: * -> *). b -> Effable m b
embed Char -> Char
forall a. Enum a => a -> a
succ) Effable (Const String) (Char -> Char)
-> Effable (Const String) Char -> Effable (Const String) Char
forall a b.
Effable (Const String) (a -> b)
-> Effable (Const String) a -> Effable (Const String) b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Char -> Effable (Const String) Char
forall b (m :: * -> *). b -> Effable m b
embed Char
'1' Effable (Const String) Char
-> Effable (Const String) Char -> Effable (Const String) Char
forall a. Semigroup a => a -> a -> a
<> Char -> Effable (Const String) Char
forall b (m :: * -> *). b -> Effable m b
embed Char
'b')

    _ex1 :: Const [Word8] ()
    _ex1 :: Const [Word8] ()
_ex1 = Effable (Const [Word8]) Word8 -> Const [Word8] ()
forall {a}. Effable (Const [a]) a -> Const [a] ()
runConst (Effable (Const [Word8]) Word8 -> Const [Word8] ())
-> Effable (Const [Word8]) Word8 -> Const [Word8] ()
forall a b. (a -> b) -> a -> b
$ (Word8 -> Word8) -> Effable (Const [Word8]) (Word8 -> Word8)
forall b (m :: * -> *). b -> Effable m b
embed Word8 -> Word8
forall a. Enum a => a -> a
succ Effable (Const [Word8]) (Word8 -> Word8)
-> Effable (Const [Word8]) Word8 -> Effable (Const [Word8]) Word8
forall a b.
Effable (Const [Word8]) (a -> b)
-> Effable (Const [Word8]) a -> Effable (Const [Word8]) b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Word8 -> Effable (Const [Word8]) Word8
forall b (m :: * -> *). b -> Effable m b
embed (Word8
1::Word8) Effable (Const [Word8]) Word8
-> Effable (Const [Word8]) Word8 -> Effable (Const [Word8]) Word8
forall a. Semigroup a => a -> a -> a
<> Bool
-> Effable (Const [Word8]) Word8 -> Effable (Const [Word8]) Word8
forall (f :: * -> *) b.
Applicative f =>
Bool -> Effable f b -> Effable f b
whenA Bool
True (Word8 -> Effable (Const [Word8]) Word8
forall b (m :: * -> *). b -> Effable m b
embed Word8
2))

{- | 'Monad' models /list-like indeterminism/.

The result of @xs '>>=' f@ is the concatenation of the results of applying @f@ to each value embedded in @xs@.

Note that the 'Monad' instance of t'Effable' is not related to the type parameter @m@ in a value of type @t'Effable' m b@ - that @m@ is a parameterization of the eventual effectful context (@m ()@) that will be used for emission. The 'Monad' instance of t'Effable', on the other hand, allows for and defines monadic computations on @t'Effable' m b@ values themselves.

-}
instance Monad (Effable m) where
  (>>=) :: Effable m b -> (b -> Effable m b') -> Effable m b'
  Effable [Part m b]
xs >>= :: forall a b. Effable m a -> (a -> Effable m b) -> Effable m b
>>= b -> Effable m b'
f  =
    [Part m b'] -> Effable m b'
forall (m :: * -> *) b. [Part m b] -> Effable m b
Effable
      [ Wrap m -> b' -> Part m b'
forall (m :: * -> *) b. Wrap m -> b -> Part m b
Part (Wrap m
wx Wrap m -> Wrap m -> Wrap m
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Wrap m
wf) b'
lf
        | Part Wrap m
wx b
lx <- [Part m b]
xs
        , Part Wrap m
wf b'
lf <- b -> [Part m b']
f' b
lx
      ]
    where
      f' :: b -> [Part m b']
f' = Effable m b' -> [Part m b']
forall (m :: * -> *) b. Effable m b -> [Part m b]
inEffable (Effable m b' -> [Part m b'])
-> (b -> Effable m b') -> b -> [Part m b']
forall b c a. (b -> c) -> (a -> b) -> a -> c
. b -> Effable m b'
f

-- | @('<|>')  ==  ('<>')@.
instance Alternative (Effable m) where
  <|> :: forall a. Effable m a -> Effable m a -> Effable m a
(<|>) = Effable m a -> Effable m a -> Effable m a
forall a. Semigroup a => a -> a -> a
(<>)
  empty :: forall a. Effable m a
empty = Effable m a
forall a. Monoid a => a
mempty

-- | @'Control.Monad.mplus'  ==  ('<>')@.
instance MonadPlus (Effable m)

effify :: ([Part m b]->[Part m b]) -> (Effable m b->Effable m b)
effify :: forall (m :: * -> *) b.
([Part m b] -> [Part m b]) -> Effable m b -> Effable m b
effify = ([Part m b] -> [Part m b]) -> Effable m b -> Effable m b
forall a b. Coercible a b => a -> b
coerce

wrapEm' :: (Wrap m -> Wrap m) -> Effable m b -> Effable m b
wrapEm' :: forall (m :: * -> *) b.
(Wrap m -> Wrap m) -> Effable m b -> Effable m b
wrapEm' Wrap m -> Wrap m
f = ([Part m b] -> [Part m b]) -> Effable m b -> Effable m b
forall (m :: * -> *) b.
([Part m b] -> [Part m b]) -> Effable m b -> Effable m b
effify (([Part m b] -> [Part m b]) -> Effable m b -> Effable m b)
-> ([Part m b] -> [Part m b]) -> Effable m b -> Effable m b
forall a b. (a -> b) -> a -> b
$ (Part m b -> Part m b) -> [Part m b] -> [Part m b]
forall a b. (a -> b) -> [a] -> [b]
map ((Wrap m -> Wrap m) -> Part m b -> Part m b
forall (m :: * -> *) b. (Wrap m -> Wrap m) -> Part m b -> Part m b
mapPartWrap Wrap m -> Wrap m
f)

{-# INLINE wrapEm' #-}


--- functions
--- ---------

singleton :: Wrap m -> b -> Effable m b
singleton :: forall (m :: * -> *) b. Wrap m -> b -> Effable m b
singleton Wrap m
w b
l = [Part m b] -> Effable m b
forall (m :: * -> *) b. [Part m b] -> Effable m b
Effable [Wrap m -> b -> Part m b
forall (m :: * -> *) b. Wrap m -> b -> Part m b
Part Wrap m
w b
l]

embed :: b -> Effable m b
embed :: forall b (m :: * -> *). b -> Effable m b
embed = Wrap m -> b -> Effable m b
forall (m :: * -> *) b. Wrap m -> b -> Effable m b
singleton Wrap m
forall a. a -> a
id

string :: IsString b => String -> Effable m b
string :: forall b (m :: * -> *). IsString b => String -> Effable m b
string = b -> Effable m b
forall b (m :: * -> *). b -> Effable m b
embed (b -> Effable m b) -> (String -> b) -> String -> Effable m b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> b
forall a. IsString a => String -> a
fromString

empty :: Effable m b
empty :: forall (m :: * -> *) b. Effable m b
empty = Effable m b
forall a. Monoid a => a
mempty

{- | Map items.

@
'mapItems' == 'fmap'
@

Example:

>>> evenEffect x = if even x then Just () else Nothing
>>> run evenEffect ((+1) <$> embed 3)
Just ()

-}
mapItems :: (b->b') -> Effable m b -> Effable m b'
mapItems :: forall b b' (m :: * -> *). (b -> b') -> Effable m b -> Effable m b'
mapItems = (b -> b') -> Effable m b -> Effable m b'
forall a b. (a -> b) -> Effable m a -> Effable m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap

{-# INLINE mapItems #-}

{- $wrap

These hold for both 'wrap' and 'wrapInside':

@
'wrap' f 'mempty'    ==  'mempty'
'wrap' f (x '<>' y)  ==  'wrap' f x '<>' 'wrap' f y    -- distributes over '<>'
g '<$>' 'wrap' f x   ==  'wrap' f (g '<$>' x) \ \      -- commutes with 'fmap'
@
-}

{- | Add an additional emission wrapper to each @b@.

The given function /composes outside of/ any existing wrappers.

@
'wrap' 'id'          ==  'id'
'wrap' (f . g)\ \    ==  'wrap' f . 'wrap' g

run' ('wrap' f x)\ \ ==  f '<$>' (run' x)      where run' = 'runWith' emit
@
-}
wrap :: Wrap m -> Effable m b -> Effable m b

{- | Add an additional emission wrapper to each @b@.

The given function /composes inside of/ any existing wrappers.

@
'wrapInside' 'id'              ==  'id'
'wrapInside' (f . g)\ \        ==  'wrapInside' g . 'wrapInside' f

'run' emit ('wrapInside' f x)  ==  'run' (f . emit) x
@
-}
wrapInside :: Wrap m -> Effable m b -> Effable m b

wrap :: forall (m :: * -> *) b. Wrap m -> Effable m b -> Effable m b
wrap       Wrap m
f Effable m b
x = (Wrap m -> Wrap m) -> Effable m b -> Effable m b
forall (m :: * -> *) b.
(Wrap m -> Wrap m) -> Effable m b -> Effable m b
wrapEm' (Wrap m
f .) Effable m b
x
wrapInside :: forall (m :: * -> *) b. Wrap m -> Effable m b -> Effable m b
wrapInside Wrap m
f Effable m b
x = (Wrap m -> Wrap m) -> Effable m b -> Effable m b
forall (m :: * -> *) b.
(Wrap m -> Wrap m) -> Effable m b -> Effable m b
wrapEm' (Wrap m -> Wrap m -> Wrap m
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Wrap m
f) Effable m b
x

{-# INLINE wrap       #-}
{-# INLINE wrapInside #-}

{- | /Conditional inclusion/.

Suppress the effects of emitting the value if an effectful predicate evaluates to False:

@
'run' emit ('when'' (pure False) x)  == pure ()
'run' emit ('when'' (pure True ) x)  == 'run' emit x
@

'when'' has the distributive and commutation properties as those of 'wrap'.

When emitted, the monadic action will be run once for each element of the internal representation.
-}
when'
  :: Monad m
  => m Bool
  -> Effable m b -- ^ to include if True (else nothing)
  -> Effable m b
when' :: forall (m :: * -> *) b.
Monad m =>
m Bool -> Effable m b -> Effable m b
when' m Bool
bM =
  Wrap m -> Effable m b -> Effable m b
forall (m :: * -> *) b. Wrap m -> Effable m b -> Effable m b
wrap (Wrap m -> Effable m b -> Effable m b)
-> Wrap m -> Effable m b -> Effable m b
forall a b. (a -> b) -> a -> b
$ \m ()
action -> do
    Bool
b <- m Bool
bM
    Bool -> Wrap m
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
b m ()
action

whenA
  :: Applicative f
  => Bool
  -> Effable f b -- ^ to include if True (else nothing)
  -> Effable f b
whenA :: forall (f :: * -> *) b.
Applicative f =>
Bool -> Effable f b -> Effable f b
whenA Bool
b = Wrap f -> Effable f b -> Effable f b
forall (m :: * -> *) b. Wrap m -> Effable m b -> Effable m b
wrap (Bool -> Wrap f
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
b)

{- | Flipped 'when''. -}
onlyIf
  :: Monad m
  => Effable m b  -- ^ to include if True (else nothing)
  -> m Bool
  -> Effable m b
onlyIf :: forall (m :: * -> *) b.
Monad m =>
Effable m b -> m Bool -> Effable m b
onlyIf = (m Bool -> Effable m b -> Effable m b)
-> Effable m b -> m Bool -> Effable m b
forall a b c. (a -> b -> c) -> b -> a -> c
flip m Bool -> Effable m b -> Effable m b
forall (m :: * -> *) b.
Monad m =>
m Bool -> Effable m b -> Effable m b
when'
infixl 7 `onlyIf`

{- | /Binary choice/.

When emitted, the monadic action will be run twice for each element of the internal representation.
-}
ifThenElse
  :: Monad m
  => m Bool
  -> Effable m b  -- ^ to include if True
  -> Effable m b  -- ^ to include if False
  -> Effable m b
ifThenElse :: forall (m :: * -> *) b.
Monad m =>
m Bool -> Effable m b -> Effable m b -> Effable m b
ifThenElse m Bool
pM Effable m b
true Effable m b
false =
     (m Bool -> Effable m b -> Effable m b
forall (m :: * -> *) b.
Monad m =>
m Bool -> Effable m b -> Effable m b
when'        m Bool
pM  Effable m b
true )
  Effable m b -> Effable m b -> Effable m b
forall a. Semigroup a => a -> a -> a
<> (m Bool -> Effable m b -> Effable m b
forall (m :: * -> *) b.
Monad m =>
m Bool -> Effable m b -> Effable m b
when' (Bool -> Bool
not(Bool -> Bool) -> m Bool -> m Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>m Bool
pM) Effable m b
false)

{- | Constraining to types whose inhabitants can be enumerated with @['minBound'..'maxBound']@.

Such types are types with a known and finite set of inhabitants, given that their 'Enum' and 'Bounded' instances behave within established social norms.
-}
type Enumerable a = (Enum a, Bounded a, Eq a)

{- | /Evaluation of finite-domain function/ for the daring.

When emitted, the monadic action will be run once for each element, for each inhabitant of the 'Enumerable' type that the action yields.

=== Comparing with '>>='

The signature can be compared to that of /monadic bind/ ('>>='):

@
'byAction' :: ('Enumerable' a, e b ~ t'Effable' m b) =>
\ \           'Monad' m => m a -> (a -> e b) -> e b
('>>=')    :: 'Monad' m => m a -> (a -> m b) -> m b
@

A possible interpretation of the two signatures is:

- '>>=' returns a value-yielding action that may depend on what value some other action yields

- 'byAction' returns a pure t'Effable' that may depend on what value some action yields

=== __Warning:__ should only be used with types of a few inhabitants

All outcomes of the action are reified in the internal representation. With 'IO'-like monads, there is no short-circuiting; neither will we be saved by laziness - the full internal representation is likely to be forced at emission time.

'Bool' has two inhabitants so reifying @IO Bool@ is not expensive.

> --- GHCi session ---
>
> λ> effable = byAction (pure True) embed
>
> λ> -- make GHCi report evaluation time and allocated bytes:
>
> λ> :set +s
>
> λ> run print effable
> True
> (ran for 0.01 secs, allocated 1,014,600 bytes)
>

An 'Int' is 'Enumerable' but has many inhabitants so reifying @IO Int@ becomes costly in both time and allocations.

> --- GHCi session ---
>
> λ> ineffable = byAction (pure (1::Int)) embed
>
> λ> :set +s
>
> λ> run print ineffable
> 1
> (ran for 1.02 million years, allocated 3.06e10 gigabytes)
>

-}
byAction
  :: (Monad m, Enumerable a)
  => m a                     -- ^ monadic evaluation point
  -> (a -> Effable m b)      -- ^ the function to evaluate
  -> Effable m b
byAction :: forall (m :: * -> *) a b.
(Monad m, Enumerable a) =>
m a -> (a -> Effable m b) -> Effable m b
byAction m a
xM a -> Effable m b
f = (a -> Effable m b) -> [a] -> Effable m b
forall m a. Monoid m => (a -> m) -> [a] -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap a -> Effable m b
g [a]
domain
  where
    g :: a -> Effable m b
g a
d    = m Bool -> Effable m b -> Effable m b
forall (m :: * -> *) b.
Monad m =>
m Bool -> Effable m b -> Effable m b
when' ((a -> a -> Bool
forall a. Eq a => a -> a -> Bool
==a
d) (a -> Bool) -> m a -> m Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m a
xM) (a -> Effable m b
f a
d)
    domain :: [a]
domain = [a
forall a. Bounded a => a
minBound..a
forall a. Bounded a => a
maxBound]
  -- why give the user a footgun, when you can give them a death star pointed right at their head?
  -- a function like this shouldn't be seen anywhere near an API surface. But it is useful. So here it is.
  -- ...we're adults after all; it's not my job to lock the door - I've put the tie on the doorknob, if you walk in, then what you see is on you.

  -- dev note: yes, this function (and embedAction) should be included and exported; it allows working conveniently with few-inhabitant enums, e.g. when user code has made a sum type of a Bool to avoid boolean blindness, or to include 3 or 4 options. I mitigate to a reasonable extent by showing and calling out the consequences reasonably loudly. Also note that byAction isn't that special in terms of allowing/inviting combinatorial explosions; anything recursive with when' or unfortunate use of >>= can have similar consequences.

_byAction_doctest_code :: Int -> IO ()
_byAction_doctest_code :: Int -> IO ()
_byAction_doctest_code Int
n_limit = IO ()
_ineffable_res'
  where
    _effable :: Effable IO Bool
_effable        = IO Bool -> (Bool -> Effable IO Bool) -> Effable IO Bool
forall (m :: * -> *) a b.
(Monad m, Enumerable a) =>
m a -> (a -> Effable m b) -> Effable m b
byAction (Bool -> IO Bool
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
True) Bool -> Effable IO Bool
forall b (m :: * -> *). b -> Effable m b
embed
    _effable_res :: IO ()
_effable_res    = (Bool -> IO ()) -> Effable IO Bool -> IO ()
forall (m :: * -> *) b.
Applicative m =>
(b -> m ()) -> Effable m b -> m ()
run Bool -> IO ()
forall a. Show a => a -> IO ()
print Effable IO Bool
_effable

    _ineffable :: Effable IO Int
_ineffable      = IO Int -> (Int -> Effable IO Int) -> Effable IO Int
forall (m :: * -> *) a b.
(Monad m, Enumerable a) =>
m a -> (a -> Effable m b) -> Effable m b
byAction (Int -> IO Int
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Int
1::Int)) Int -> Effable IO Int
forall b (m :: * -> *). b -> Effable m b
embed
    _ineffable_res :: IO ()
_ineffable_res  = (Int -> IO ()) -> Effable IO Int -> IO ()
forall (m :: * -> *) b.
Applicative m =>
(b -> m ()) -> Effable m b -> m ()
run Int -> IO ()
forall a. Show a => a -> IO ()
print Effable IO Int
_ineffable

    _ineffable' :: Effable IO Int
_ineffable'     = ([Part IO Int] -> [Part IO Int])
-> Effable IO Int -> Effable IO Int
forall (m :: * -> *) b.
([Part m b] -> [Part m b]) -> Effable m b -> Effable m b
effify (Int -> [Part IO Int] -> [Part IO Int]
forall a. Int -> [a] -> [a]
take Int
n_limit) Effable IO Int
_ineffable
    _ineffable_res' :: IO ()
_ineffable_res' = (Int -> IO ()) -> Effable IO Int -> IO ()
forall (m :: * -> *) b.
Applicative m =>
(b -> m ()) -> Effable m b -> m ()
run Int -> IO ()
forall a. Show a => a -> IO ()
print Effable IO Int
_ineffable'

    {- calcs for GHCi session transcript:

    λ> :set +s

    λ> _byAction_doctest_code (round 0.5e6)
    (0.87 secs, 829,006,864 bytes)

    λ> (fromIntegral (maxBound :: Int) :: Float) * 2 / 0.5e6 * 0.87 / (60*60*24*365)
    1017799.8

    λ> (fromIntegral (maxBound :: Int) :: Float) * 2 / 0.5e6 * 829e6 / 1e12
    3.05847e10
    -}

{- | /Evaluation of finite-domain value/ for the daring.

When emitted, the monadic action will be run once for each value of the domain.

(The same warning as that for 'byAction' applies.)
-}
embedAction
  :: (Monad m, Enumerable a)
  => m a                     -- ^ monadic value
  -> Effable m a
embedAction :: forall (m :: * -> *) a.
(Monad m, Enumerable a) =>
m a -> Effable m a
embedAction m a
xM = m a -> (a -> Effable m a) -> Effable m a
forall (m :: * -> *) a b.
(Monad m, Enumerable a) =>
m a -> (a -> Effable m b) -> Effable m b
byAction m a
xM a -> Effable m a
forall b (m :: * -> *). b -> Effable m b
embed

{- | For each @b@ of an t'Effable', emit it with the given function, then apply the composed emission wrapper associated with that @b@, and combine all results.

== Laws

[Monoid homomorphism]:

    @
    'run' emit 'mempty'    ==  pure ()
    'run' emit (x '<>' y)  ==  'run' emit x '*>' 'run' emit y
    @

[Naturality]:

    @
    'run' emit (f '<$>' x)  ==  'run' (emit . f) x
    @

== Examples

These examples use @t'Const' []@ whose emission effect is to accumulate emitted items into a list.

>>> import Data.Functor.Const (Const (..))
>>> emitConst b = Const [b]

>>> run emitConst (embed 'a' <> embed 'b')
Const "ab"

With emission wrapper:

>>> silence = wrap (\_ -> Const [])
>>> run emitConst (embed 'a' <> (silence $ embed 'b') <> embed 'c')
Const "ac"

-}
run
  :: Applicative m
  => (b -> m ())      -- ^ emitting one @b@
  -> Effable m b
  -> m ()
run :: forall (m :: * -> *) b.
Applicative m =>
(b -> m ()) -> Effable m b -> m ()
run b -> m ()
emit (Effable [Part m b]
parts) = (Part m b -> m ()) -> [Part m b] -> m ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ ((b -> m ()) -> Part m b -> m ()
forall b (m :: * -> *). (b -> m ()) -> Part m b -> m ()
emitPart b -> m ()
emit) [Part m b]
parts

newtype RunWith a = RunWith [a]
  deriving ((forall a b. (a -> b) -> RunWith a -> RunWith b)
-> (forall a b. a -> RunWith b -> RunWith a) -> Functor RunWith
forall a b. a -> RunWith b -> RunWith a
forall a b. (a -> b) -> RunWith a -> RunWith b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall a b. (a -> b) -> RunWith a -> RunWith b
fmap :: forall a b. (a -> b) -> RunWith a -> RunWith b
$c<$ :: forall a b. a -> RunWith b -> RunWith a
<$ :: forall a b. a -> RunWith b -> RunWith a
Functor, (forall m. Monoid m => RunWith m -> m)
-> (forall m a. Monoid m => (a -> m) -> RunWith a -> m)
-> (forall m a. Monoid m => (a -> m) -> RunWith a -> m)
-> (forall a b. (a -> b -> b) -> b -> RunWith a -> b)
-> (forall a b. (a -> b -> b) -> b -> RunWith a -> b)
-> (forall b a. (b -> a -> b) -> b -> RunWith a -> b)
-> (forall b a. (b -> a -> b) -> b -> RunWith a -> b)
-> (forall a. (a -> a -> a) -> RunWith a -> a)
-> (forall a. (a -> a -> a) -> RunWith a -> a)
-> (forall a. RunWith a -> [a])
-> (forall a. RunWith a -> Bool)
-> (forall a. RunWith a -> Int)
-> (forall a. Eq a => a -> RunWith a -> Bool)
-> (forall a. Ord a => RunWith a -> a)
-> (forall a. Ord a => RunWith a -> a)
-> (forall a. Num a => RunWith a -> a)
-> (forall a. Num a => RunWith a -> a)
-> Foldable RunWith
forall a. Eq a => a -> RunWith a -> Bool
forall a. Num a => RunWith a -> a
forall a. Ord a => RunWith a -> a
forall m. Monoid m => RunWith m -> m
forall a. RunWith a -> Bool
forall a. RunWith a -> Int
forall a. RunWith a -> [a]
forall a. (a -> a -> a) -> RunWith a -> a
forall m a. Monoid m => (a -> m) -> RunWith a -> m
forall b a. (b -> a -> b) -> b -> RunWith a -> b
forall a b. (a -> b -> b) -> b -> RunWith a -> b
forall (t :: * -> *).
(forall m. Monoid m => t m -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. t a -> [a])
-> (forall a. t a -> Bool)
-> (forall a. t a -> Int)
-> (forall a. Eq a => a -> t a -> Bool)
-> (forall a. Ord a => t a -> a)
-> (forall a. Ord a => t a -> a)
-> (forall a. Num a => t a -> a)
-> (forall a. Num a => t a -> a)
-> Foldable t
$cfold :: forall m. Monoid m => RunWith m -> m
fold :: forall m. Monoid m => RunWith m -> m
$cfoldMap :: forall m a. Monoid m => (a -> m) -> RunWith a -> m
foldMap :: forall m a. Monoid m => (a -> m) -> RunWith a -> m
$cfoldMap' :: forall m a. Monoid m => (a -> m) -> RunWith a -> m
foldMap' :: forall m a. Monoid m => (a -> m) -> RunWith a -> m
$cfoldr :: forall a b. (a -> b -> b) -> b -> RunWith a -> b
foldr :: forall a b. (a -> b -> b) -> b -> RunWith a -> b
$cfoldr' :: forall a b. (a -> b -> b) -> b -> RunWith a -> b
foldr' :: forall a b. (a -> b -> b) -> b -> RunWith a -> b
$cfoldl :: forall b a. (b -> a -> b) -> b -> RunWith a -> b
foldl :: forall b a. (b -> a -> b) -> b -> RunWith a -> b
$cfoldl' :: forall b a. (b -> a -> b) -> b -> RunWith a -> b
foldl' :: forall b a. (b -> a -> b) -> b -> RunWith a -> b
$cfoldr1 :: forall a. (a -> a -> a) -> RunWith a -> a
foldr1 :: forall a. (a -> a -> a) -> RunWith a -> a
$cfoldl1 :: forall a. (a -> a -> a) -> RunWith a -> a
foldl1 :: forall a. (a -> a -> a) -> RunWith a -> a
$ctoList :: forall a. RunWith a -> [a]
toList :: forall a. RunWith a -> [a]
$cnull :: forall a. RunWith a -> Bool
null :: forall a. RunWith a -> Bool
$clength :: forall a. RunWith a -> Int
length :: forall a. RunWith a -> Int
$celem :: forall a. Eq a => a -> RunWith a -> Bool
elem :: forall a. Eq a => a -> RunWith a -> Bool
$cmaximum :: forall a. Ord a => RunWith a -> a
maximum :: forall a. Ord a => RunWith a -> a
$cminimum :: forall a. Ord a => RunWith a -> a
minimum :: forall a. Ord a => RunWith a -> a
$csum :: forall a. Num a => RunWith a -> a
sum :: forall a. Num a => RunWith a -> a
$cproduct :: forall a. Num a => RunWith a -> a
product :: forall a. Num a => RunWith a -> a
Foldable, Functor RunWith
Foldable RunWith
(Functor RunWith, Foldable RunWith) =>
(forall (f :: * -> *) a b.
 Applicative f =>
 (a -> f b) -> RunWith a -> f (RunWith b))
-> (forall (f :: * -> *) a.
    Applicative f =>
    RunWith (f a) -> f (RunWith a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> RunWith a -> m (RunWith b))
-> (forall (m :: * -> *) a.
    Monad m =>
    RunWith (m a) -> m (RunWith a))
-> Traversable RunWith
forall (t :: * -> *).
(Functor t, Foldable t) =>
(forall (f :: * -> *) a b.
 Applicative f =>
 (a -> f b) -> t a -> f (t b))
-> (forall (f :: * -> *) a. Applicative f => t (f a) -> f (t a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> t a -> m (t b))
-> (forall (m :: * -> *) a. Monad m => t (m a) -> m (t a))
-> Traversable t
forall (m :: * -> *) a. Monad m => RunWith (m a) -> m (RunWith a)
forall (f :: * -> *) a.
Applicative f =>
RunWith (f a) -> f (RunWith a)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> RunWith a -> m (RunWith b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> RunWith a -> f (RunWith b)
$ctraverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> RunWith a -> f (RunWith b)
traverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> RunWith a -> f (RunWith b)
$csequenceA :: forall (f :: * -> *) a.
Applicative f =>
RunWith (f a) -> f (RunWith a)
sequenceA :: forall (f :: * -> *) a.
Applicative f =>
RunWith (f a) -> f (RunWith a)
$cmapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> RunWith a -> m (RunWith b)
mapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> RunWith a -> m (RunWith b)
$csequence :: forall (m :: * -> *) a. Monad m => RunWith (m a) -> m (RunWith a)
sequence :: forall (m :: * -> *) a. Monad m => RunWith (m a) -> m (RunWith a)
Traversable)

{- | Create a representation of the individual emission results of an t'Effable'.

Methods of the 'Foldable' and 'Traversable' instances of the result type can be used e.g. to customize how the individual emission results are combined.

@
'Data.Foldable.sequenceA_' ('runWith' emit x)  == 'run' emit x
@

=== Example

The following uses the 'foldr' method of t'RunWith'\'s 'Foldable' instance to create a 'run'-like function with a 'foldr'-style API:

>>> :{
  let
    run_foldr
      :: (b -> m ())
      -> (m () -> c -> c)
      -> c
      -> Effable m b
      -> c
    run_foldr emit comb z = foldr comb z . runWith emit
:}

-}
runWith
  :: (b -> m ())      -- ^ emitting one @b@
  -> Effable m b
  -> RunWith (m ())
runWith :: forall b (m :: * -> *).
(b -> m ()) -> Effable m b -> RunWith (m ())
runWith b -> m ()
emit (Effable [Part m b]
parts) = [m ()] -> RunWith (m ())
forall a b. Coercible a b => a -> b
coerce ((b -> m ()) -> Part m b -> m ()
forall b (m :: * -> *). (b -> m ()) -> Part m b -> m ()
emitPart b -> m ()
emit (Part m b -> m ()) -> [Part m b] -> [m ()]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Part m b]
parts)


type SpeclzR  m b = Applicative m=> (b->m ()) -> Effable m b -> m ()
type SpeclzRW m b =                 (b->m ()) -> Effable m b -> RunWith (m ())

{-# SPECIALIZE INLINE run     :: SpeclzR  m String #-}
{-# SPECIALIZE INLINE run     :: SpeclzR  m Text   #-}
{-# SPECIALIZE INLINE runWith :: SpeclzRW m String #-}
{-# SPECIALIZE INLINE runWith :: SpeclzRW m Text   #-}


--- misc.
--- -----

_silenceUnusedWarnings :: _
_silenceUnusedWarnings :: w
_silenceUnusedWarnings =
  (Part Any Any -> Wrap Any) -> (Part Any Any -> Any) -> w
forall a. HasCallStack => a
undefined
    Part Any Any -> Wrap Any
forall (m :: * -> *) b. Part m b -> Wrap m
partWrap
    Part Any Any -> Any
forall (m :: * -> *) b. Part m b -> b
partItem