effable 0.2.0.0 → 0.3.0.0

raw patch · 3 files changed

+407/−36 lines, 3 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• README.md +7/−2
• effable.cabal +1/−1
• src/Data/Effable.hs +399/−33

@@ -4,6 +4,7 @@  ![GitHub License](https://img.shields.io/github/license/carlwr/effable) ![Hackage Version](https://img.shields.io/hackage/v/effable)+![CI](https://img.shields.io/github/actions/workflow/status/carlwr/effable/ci.yml?label=CI)  <br> @@ -89,10 +90,14 @@  *Effable* as in *sayable* or *utterable*. -Or, *Eff-able* as in *able to be effected* or *effectuated* - something with the potential of becoming effects.+Or, *Eff-able* as in *able to be effected* or *effectuated* - something with the potential to become effects.   # Written by a human -AI tools were used extensively during the development of this package - for exploration, discussions, and feedback. All code and documentation were however authored by me (Carl), a human developer: no text in this repository is direct output from an AI model.+During the development of this package, AI models were used extensively for discussions and feedback. All code and documentation however is authored by me (Carl), a human developer: no text (code; natural language) within this package/repo is direct output from an AI model.++Since I am not a native English speaker, any natural language is likely to feature language quirks. AI models were not asked to identify or rectify such.++The above should not be understood as any opinion or even preference of mine - I both use and value development with higher degrees of AI autonomy than what was used in this (and many of my other) projects. 

@@ -1,7 +1,7 @@ cabal-version: 3.0  name:           effable-version:        0.2.0.0+version:        0.3.0.0 stability:      experimental category:       Data synopsis:       A data structure for emission plans

@@ -52,9 +52,10 @@  /Effable/ as in /sayable/ or /utterable/. -Or, /Eff-able/ as in /able to be effected/ or /effectuated/ - something with the potential of becoming effects.+Or, /Eff-able/ as in /able to be effected/ or /effectuated/ - something with the potential to become effects. -} +{-# LANGUAGE OverloadedStrings #-}  module Data.Effable (@@ -67,13 +68,16 @@ , embed , string --- * Transform items+-- * Transform+-- ** Items , mapItems---- * Transform wraps+, mapMaybe+-- ** Wraps -- $wrap , wrap , wrapInside+, wrapEach+-- $wrap-overview  -- * Branching #branching# , when'@@ -82,31 +86,51 @@ , ifThenElse , Enumerable , byAction+, byActionMaybe , embedAction+-- $branching-overview  -- * Effectuate , run , RunWith , runWith +-- * Usage example+-- $env_example+ ) where -import Data.String (IsString (..))+import Data.String import Data.Coerce-import Control.Monad (when, MonadPlus)-import Control.Applicative (Const(..), Alternative ((<|>), empty))+import Control.Monad+import Control.Applicative import Data.Word (Word8)-import Data.Foldable (traverse_)+import Data.Foldable+import Data.Maybe         qualified as Maybe+import Data.List          qualified as L+import System.Environment qualified as Env + {- implementation notes: -- instances of "\ \" etc. in docstrings are in order to sync vertical alignment/whitespace padding between code and the generated haddock+- 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 -}  @@ -132,6 +156,10 @@   (<*>) :: 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 @@ -194,6 +222,10 @@  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.  -}@@ -216,7 +248,7 @@ -- | @'Control.Monad.mplus'  ==  ('<>')@. instance MonadPlus (Effable m) -effify :: ([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') effify = coerce  wrapEm' :: (Wrap m -> Wrap m) -> Effable m b -> Effable m b@@ -224,10 +256,22 @@  {-# INLINE wrapEm' #-} +{- | traverse methods: non-exported internal helpers ---- functions---- ---------+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] @@ -237,8 +281,12 @@ string :: IsString b => String -> Effable m b string = embed . fromString -{- | Map items. +--- transform+--- ---------++{- | Map items (= map over @b@s).+ @ 'mapItems' == 'fmap' @@@ -253,8 +301,43 @@ 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':  @@@ -264,28 +347,28 @@ @ -} -{- | Add an additional emission wrapper to each @b@.+{- | 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 covariantly+          \ \ \ \        -- 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 each @b@.+{- | Add an additional emission wrapper to all items. -The given function /composes inside of/ any existing wrappers.+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 contravariantly+                \ \ \ \            -- composes /contra/variantly  'run' emit ('wrapInside' f x)  ==  'run' (f . emit) x @@@ -295,6 +378,53 @@ 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:@@ -318,6 +448,19 @@     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@@ -325,7 +468,20 @@   -> Effable m b whenA b = wrap (when b) -{- | Flipped 'when''. -}++{- | 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)@@ -358,14 +514,20 @@  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 '>>='+In light of 'byAction', 'ifThenElse' can be viewed as 'byAction' specialized to a domain with the two inhabitants 'True' and 'False': -The signature can be compared to that of /monadic bind/ ('>>='):+@+'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, e b ~ t'Effable' m b) =>-\ \           'Monad' m => m a -> (a -> e b) -> e b-('>>=')    :: 'Monad' m => m a -> (a -> m b) -> m b+'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:@@ -385,7 +547,6 @@ > λ> effable = byAction (pure True) embed > > λ> -- make GHCi report evaluation time and allocated bytes:-> > λ> :set +s > > λ> run print effable@@ -393,14 +554,13 @@ > (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.+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)@@ -416,9 +576,8 @@   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.-  -- ...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.+  -- "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'@@ -446,10 +605,39 @@     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' applies.) -} embedAction@@ -458,8 +646,37 @@   -> Effable m a embedAction xM = byAction xM 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.+{- $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]:@@ -491,10 +708,21 @@ >>> run emitConst (embed 'a' <> (silence $ embed 'b') <> embed 'c') Const "ac" +== Definition++'run' is the /monoid homomorphism/++@+from   ('Effable' m b, '<>', 'mempty' )+to     (m ()\ \      , '*>', 'pure' ())+@++and is natural in the emission function.+ -} run   :: Applicative m-  => (b -> m ())      -- ^ emitting one @b@+  => (b -> m ())      -- ^ emitting one item   -> Effable m b   -> m () run emit (Effable parts) = traverse_ (emitPart emit) parts@@ -527,7 +755,7 @@  -} runWith-  :: (b -> m ())      -- ^ emitting one @b@+  :: (b -> m ())      -- ^ emitting one item   -> Effable m b   -> RunWith (m ()) runWith emit (Effable parts) = coerce (emitPart emit <$> parts)@@ -536,6 +764,7 @@ {-# INLINE singleton  #-} {-# INLINE embed      #-} {-# INLINE mapItems   #-}+{-# INLINE mapMaybe   #-} {-# INLINE wrap       #-} {-# INLINE wrapInside #-} {-# INLINE when'      #-}@@ -543,3 +772,140 @@  {-# 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.")