packages feed

effable-0.3.1.0: src/Data/Effable.hs

{-| 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 to become effects.
-}

{-# LANGUAGE OverloadedStrings #-}

module Data.Effable
(
  -- * Type
  Effable
, Wrap

  -- * Create
, singleton
, embed
, string

-- * Transform
-- ** Items
, mapItems
, mapMaybe
-- ** Wraps
-- $wrap
, wrap
, wrapInside
, wrapEach
-- $wrap-overview

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

-- * Effectuate
, run
, RunWith
, runWith

-- * Usage example
-- $env_example

)
where

import Data.String
import Data.Coerce
import Control.Monad
import Control.Applicative
import Data.Word (Word8)
import Data.Foldable
import Data.Maybe         qualified as Maybe
import Data.List          qualified as L
import System.Environment qualified as Env


{- implementation notes:

- user-facing terminology for one element of [Part m b]:
  - module docstring:
    - "a @b@", "each @b@" etc.; prefer over "item" to the extent reasonable
  - everywhere else (including later docstrings, identifier names):
    - "item(s)" (clarify with "a @b@" etc. where suitable, e.g. at first use after the module docstring and in 'run' docstring)

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

- haddock table bug: won't render if following immediately after heading
  - workaround: put a `&#32;` (= SGML whitespace) between

-}

{- $setup
>>> import Data.Word (Word8)
>>> import Control.Monad
>>> :set -XOverloadedStrings
-}


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

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


--- Part ---

data Part m b = Part
  { _partWrap  :: Wrap m
  , _partItem :: b
  }
  deriving (Functor)

instance Applicative (Part m) where
  pure :: b -> Part m b
  pure x = Part id x

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

-- single-element 'Foldable' and 'Traversable':
instance Foldable    (Part m) where foldMap  f (Part _ x) = f x
instance Traversable (Part m) where traverse f (Part w x) = Part w <$> f x

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

emitPart :: (b -> m ()) -> Part m b -> m ()
emitPart emit (Part w l) = w (emit l)

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


--- Effable ---

{- | An ordered sequence of values, each with an associated emission wrapper (default: 'id'). -}
newtype Effable m b = Effable { inEffable :: [Part m b] }
  deriving (Semigroup, Monoid, Functor)

instance (IsString b) => IsString (Effable m b) where
  fromString = 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 x = Effable [pure x]

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

_effable_applicative_doctest_typechecks :: a
_effable_applicative_doctest_typechecks = undefined
  where
    runConst = run (\b -> Const [b])

    _ex0 :: Const [Char] ()
    _ex0 = runConst $ (embed pred <> embed succ) <*> (embed '1' <> embed 'b')

    _ex1 :: Const [Word8] ()
    _ex1 = runConst $ embed succ <*> (embed (1::Word8) <> whenA True (embed 5))

{- | '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@.

@
'pure' x  ==  'embed' x
@

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 xs >>= f  =
    Effable
      [ Part (wx . wf) lf
        | Part wx lx <- xs
        , Part wf lf <- f' lx
      ]
    where
      f' = inEffable . f

-- | @('<|>')  ==  ('<>')@.
instance Alternative (Effable m) where
  (<|>) = (<>)
  empty = mempty

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

effify :: ([Part m b]->[Part m b']) -> (Effable m b->Effable m b')
effify = coerce

wrapEm' :: (Wrap m -> Wrap m) -> Effable m b -> Effable m b
wrapEm' f = effify $ map (mapPartWrap f)

{-# INLINE wrapEm' #-}

{- | traverse methods: non-exported internal helpers

Currently unused.

May not be exported: they allow expressing folding over bare @b@s, which does not give a semantically meaningful result/violates opacity.
-}
_traverseEff :: (Applicative f) => (a -> f b) -> Effable m a -> f (Effable m b)
_traverseEff f (Effable ps) = Effable <$> traverse (traverse f) ps

_sequenceEff :: (Applicative f) => Effable m (f a) -> f (Effable m a)
_sequenceEff = _traverseEff id


--- create
--- ------

singleton :: Wrap m -> b -> Effable m b
singleton w l = Effable [Part w l]

embed :: b -> Effable m b
embed = singleton id

string :: IsString b => String -> Effable m b
string = embed . fromString


--- transform
--- ---------

{- | Map items (= map over @b@s).

@
'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 = fmap

{- | Map items for which the functional argument returns a 'Just' value; otherwise, don't include the item in the result.

@
'mapMaybe' f eff = eff >>= f'
  where
    f' x|Just y <- f x  =  'embed' y
        |otherwise      =  'mempty'
@

For filtering, creating the following function can be helpful:

@
filter' :: (b' -> Bool) -> 'Effable' f b' -> 'Effable' f b'
filter' p = 'mapMaybe' (\x -> if p x then Just x else Nothing)

-- or, equivalently, since 'Effable' has a 'MonadPlus' instance:
filter' = 'mfilter'
@

-}
mapMaybe :: (b -> Maybe b') -> Effable m b -> Effable m b'
mapMaybe f = effify (traverseJusts f)
  where
    {- For each element of the list, apply the function to each inner element and sequence the Maybe effect. Return a list of the Just results.

    > >>> traverseJusts (\x->if even x then Just (x `div` 2) else Nothing) [[2,4],[21,40],[60,80]]
    > [[1,2],[30,40]]

    -}
    traverseJusts :: Traversable t => (bb -> Maybe bb') -> [t bb] -> [t bb']
    traverseJusts f' = Maybe.mapMaybe (traverse f')


{- $wrap

=== Laws

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 all items.

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

@
'wrap' 'id'          ==  'id'
'wrap' (f . g)\ \    ==  'wrap' f . 'wrap' g
          \ \ \ \        -- composes /co/variantly

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 all items.

The given function /composes inside of/ any existing wrappers, i.e. it will be applied directly to the action produced by the emission.

@
'wrapInside' 'id'              ==  'id'
'wrapInside' (f . g)\ \        ==  'wrapInside' g . 'wrapInside' f
                \ \ \ \            -- composes /contra/variantly

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

wrap       f x = wrapEm' (f .) x
wrapInside f x = wrapEm' (. f) x

{- | Add an additional emission wrapper to each item.

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

=== __For a @wrapEachInside@ function__

For a variant of this function that composes the new wrapper /inside of/ existing wrappers, the user may choose to define::

@
wrapEachInside :: (b -> 'Wrap' m) -> 'Effable' m b -> 'Effable' m b
wrapEachInside f eff =
  let g x = 'singleton' (f x) x
  in  eff '>>=' g
@

-}
wrapEach :: (b -> Wrap m) -> Effable m b -> Effable m b
wrapEach f = effify $ \ps -> [Part (f x . w  ) x | Part w x <- ps]

_wrapEachInside :: (b -> Wrap m) -> Effable m b -> Effable m b
_wrapEachInside f eff =
  let  g x = singleton (f x) x
  in   eff >>= g

{- $wrap-overview

== Wrap: overview

&#32;

+--------+---------------------------+---------------------------------------------------+
|        |Composition order          |Signature                                          |
+        +----------+----------------+                                                   |
|        |outside   |inside          |                                                   |
|        |          |                |                                                   |
+========+==========+================+===================================================+
|Uniform |'wrap'    |'wrapInside'    |@'Wrap' m        -> 'Effable' m b -> 'Effable' m b@|
+--------+----------+----------------+---------------------------------------------------+
|Per-item|'wrapEach'| wrapEachInside |@(b -> 'Wrap' m) -> 'Effable' m b -> 'Effable' m b@|
+--------+----------+----------------+---------------------------------------------------+

-}


--- branching
--- ---------

{- | /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' bM =
  wrap $ \action -> do
    b <- bM
    when b action

{- | /Conditional inclusion/ (pure predicate).

Note that @'whenA' False _@ is not generally the same as 'mempty': @'whenA' False x@ preserves the structure of @x@ even though its emission will be suppressed:

>>> runEmit eff = putStr "result: " >> run putStr eff
>>> prepend_a = (putStr "a" *>)
>>> runEmit $ wrap prepend_a (whenA False (string "suppressed"))
result: a

>>> runEmit $ wrap prepend_a mempty
result:

-}
whenA
  :: Applicative m
  => Bool
  -> Effable m b -- ^ to include if True (else nothing)
  -> Effable m b
whenA b = wrap (when b)


{- | Flipped 'when''.

The high precedence allows expressions such as e.g.:

@
{-# LANGUAGE OverloadedStrings #-}

debugMsg =
 \ \    ("host: "'<>'host)  \`'onlyIf'\`  isPrintHostM
  '<>'   "is connected"\ \  \`'onlyIf'\`  isPrintStatusM
@

-}
onlyIf
  :: Monad m
  => Effable m b  -- ^ to include if True (else nothing)
  -> m Bool
  -> Effable m b
onlyIf = flip 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 pM true false =
     (when'        pM  true )
  <> (when' (not<$>pM) 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.

In light of 'byAction', 'ifThenElse' can be viewed as 'byAction' specialized to a domain with the two inhabitants 'True' and 'False':

@
'ifThenElse' bM x y  ==  'byAction' bM (\\b -> if b then x else y)
@

(Between the LHS and RHS the ordering of the internal representation will be different; that is however not observable with read-like actions.)

=== Comparing the signature with '>>='

@
'byAction' :: ('Enumerable' a, eff b ~ t'Effable' m b) =>
\ \           'Monad' m => m a -> (a -> eff b) -> eff 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.

> --- 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 xM f = foldMap g domain
  where
    g d    = when' ((==d) <$> xM) (f d)
    domain = [minBound..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. I'm not locking the door, but I _have_ put the tie on the doorknob; if you walk in, then what you see's on you.

_byAction_doctest_code :: Int -> IO ()
_byAction_doctest_code n_limit = _ineffable_res'
  where
    _effable        = byAction (pure True) embed
    _effable_res    = run print _effable

    _ineffable      = byAction (pure (1::Int)) embed
    _ineffable_res  = run print _ineffable

    _ineffable'     = effify (take n_limit) _ineffable
    _ineffable_res' = run print _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 function/ whose result is a 'Maybe' value.

Using this function allows deciding to suppress evaluation results based on the value the action yielded. Yet, the internal representation only grows proportional to the number of domain inhabitants for which a 'Just' value is returned, rather than being proportional to the number of inhabitants.

@
'byAction' xM  f  ==  'byActionMaybe' xM ('Just' . f)
@
-}
byActionMaybe
  :: (Monad m, Enumerable a)
  => m a                         -- ^ monadic evaluation point
  -> (a -> Maybe (Effable m b))  -- ^ the function to evaluate
  -> Effable m b
byActionMaybe xM f = foldMapMaybe g domain
  where
    g d    = when' ((==d) <$> xM) <$> (f d)
    domain = [minBound..maxBound]

    foldMapMaybe :: (Foldable t, Monoid mm) => (x -> Maybe mm) -> t x -> mm
    foldMapMaybe f' = foldr comb mempty
      where
        comb x xs = case f' x of
          Just x' -> x' <> xs
          _       ->       xs

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

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

@
'embedAction' x  ==  'byAction' x 'embed'
@

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

{- $branching-overview

== Branching: overview

&#32;

+---------------+------------------+--------------+--------------------------+
|               |Domain            |Representation|Range of emission         |
|               +------+-----------+∝ *1          |                          |
|               |      |\(\Sigma\) |              |                          |
|               |      |inhabitants|              |                          |
+===============+======+===========+==============+==========================+
|'when''        |'Bool'|2          |\(1\)         |x₁, @pure ()@             |
+---------------+------+-----------+--------------+--------------------------+
|'ifThenElse'   |'Bool'|2          |\(2\)         |x₁, x₂                    |
+---------------+------+-----------+--------------+--------------------------+
|'byAction'     |@a@   |/n/        |\(n\)         |x₁, ..., xₙ               |
+---------------+------+-----------+--------------+--------------------------+
|'byActionMaybe'|@a@   |/n/        |\(\leq n\)    |x₁, ..., xₘ, \(m \leq n\) |
+---------------+------+-----------+--------------+--------------------------+

__*1__: "the size of the internal representation is proportional to..."

-}


--- effectuate
--- ----------

{- | For each item (each @b@) of an t'Effable', emit it with the given function, then apply the composed emission wrapper associated with that item, 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 item
  -> Effable m b
  -> m ()
run emit (Effable parts) = traverse_ (emitPart emit) parts

newtype RunWith a = RunWith [a]
  deriving (Functor, Foldable, 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 item
  -> Effable m b
  -> RunWith (m ())
runWith emit (Effable parts) = coerce (emitPart emit <$> parts)


{-# INLINE singleton  #-}
{-# INLINE embed      #-}
{-# INLINE mapItems   #-}
{-# INLINE mapMaybe   #-}
{-# INLINE wrap       #-}
{-# INLINE wrapInside #-}
{-# INLINE when'      #-}
{-# INLINE whenA      #-}

{-# INLINEABLE run     #-}
{-# INLINEABLE runWith #-}


--- example
--- -------

{- $env_example

>>> import qualified System.Environment as Env
>>> import qualified Data.List          as L
>>> import qualified Data.Maybe         as Maybe

Preparation - create some helper functions:

>>> haveVar name = Maybe.isJust <$> Env.lookupEnv name
>>> envVarsM     = L.genericLength <$> Env.getEnvironment :: IO Word8
>>> envVars      = embedAction envVarsM                   :: Effable IO Word8

Create an 'Effable', using @OverloadedStrings@ to promote 'String' literals like @"shell-invoked"@ to an 'Effable':

>>> :set -XOverloadedStrings
>>> :{
eff =
      (show <$> envVars)  `onlyIf`  haveVar "DBG"
  <>  "shell-invoked"     `onlyIf`  haveVar "SHELL"
  <>  "DONE."
:}

Depending on the environment variables present, running the 'Effable' with 'putStrLn' would return an @'IO' ()@ that prints something matching this:

>>> run putStrLn eff
...
DONE.

E.g. if 92 environment variables are set, two of which are @DBG@ and @SHELL@, the following would be printed:

> >>> run putStrLn eff
> 92
> shell-invoked
> DONE.

__It is crucial that the code was written so that the IO action yielded a 'Word8'.__ It has 256 inhabitants, which is manageable.

== Comparison: IO-monadic code

This version, written directly in the IO monad, is equivalent in what it prints:

>>> :{
monadicIO = do
  isDbg   <- haveVar "DBG"
  isShell <- haveVar "SHELL"
  --
  n <- envVarsM
  let nStr = show n
  --
  when isDbg   $ putStrLn nStr
  when isShell $ putStrLn "shell-invoked"
  putStrLn "DONE."
:}

>>> monadicIO
...
DONE.

== @eff@ vs. @monadicIO@

- (-) blows-up unless @envVarsM@ is carefully implemented to limit the domain of what the action returns

- (-) is slower, and more expensive in allocations

- (+) is pure, and has a type that allows further transformations:

    > --- GHCi session ---
    >
    > λ> :t eff
    > eff :: Effable IO String
    >
    > λ> :t monadicIO
    > monadicIO :: IO ()

    ...e.g.:

    > >>> leftline = ("| "<>)
    > >>> run putStrLn (leftline <$> eff)
    > | 92
    > | shell-invoked
    > | DONE.

-}

_env_example_docstring :: IO ()
_env_example_docstring = main_env_example
  where

    haveVar  :: String -> IO Bool
    haveVar name = Maybe.isJust <$> Env.lookupEnv name
    envVarsM     = L.genericLength <$> Env.getEnvironment :: IO Word8
    envVars      = embedAction envVarsM                   :: Effable IO Word8

    eff =
        (show <$> envVars)  `onlyIf`  haveVar "DBG"
      <> "shell-invoked"    `onlyIf`  haveVar "SHELL"
      <> "DONE."

    _res0 = run putStrLn eff

    monadicIO :: IO ()
    monadicIO = do
      isDbg   <- haveVar "DBG"
      isShell <- haveVar "SHELL"

      n <- envVarsM
      let nStr = show n

      when isDbg   $ putStrLn nStr
      when isShell $ putStrLn "shell-invoked"
      putStrLn "DONE."

    leftline = ("| "<>)
    _res_leftline = run putStrLn (leftline <$> eff)

    main_env_example :: IO ()
    main_env_example = do
      print . length  . inEffable $ eff
      print . length  . inEffable $ ifThenElse (haveVar "SHELL") eff eff

      putStrLn "\n_res0:"       ; _res0
      putStrLn "\n_res_leftline"; _res_leftline
      putStrLn "\nmonadic:"     ; monadicIO

    -- not used: `eff` expressed with a do-block:
    _eff_do :: Effable IO String
    _eff_do = do
      n <- envVars
      let nStr = show n
      l1 <- when' (haveVar "DBG"  ) (string nStr)
      l2 <- when' (haveVar "SHELL") "shell-invoked"
      pure (l1 <> l2 <> "DONE.")