wip

Author: aspiwack

src/Benign.hs

@@ -47,8 +47,17 @@ module Benign
     -- * Monads
     EvalM (..),
     withAlteringM,
+    withAlteringM',
     withSettingM,
+    withSettingM',
     unsafeSpanBenignM,
+    unsafeSpanBenignM',
+
+    -- * Strategies
+    Strat,
+    lazy,
+    whnf,
+    nf,
   )
 where
 
@@ -133,8 +142,8 @@ setLocalState vault = do
   tid <- myThreadId
   modifyMVar_ localStates (evaluate . Map.insert tid vault)
 
--- | @'withAltering' f g thing@ evaluates 'thing' with the local state's field
--- `f` set by `g` in the style of 'Map.alter'.
+-- | @'withAltering' f g strat thing@ evaluates 'thing' with the local state's
+-- field `f` set by `g` in the style of 'Map.alter'.
 --
 -- Why do we need this? If we are to do some logging in pure code, we still need
 -- to know /where/ to log too. That is we need configuration. It is out of
@@ -161,20 +170,20 @@ setLocalState vault = do
 -- make much sense to modify a global state. The modification could happen at
 -- any time and in any order. The result would be quite ill-defined.
 --
--- The reason why we need the 'Eval' constraint is that, as a direct consequence
+-- The reason why we need the 'strat' argument is that, as a direct consequence
 -- of the design, the lexical state is passed dynamically to `thing`. That is,
 -- the state that is seen by a piece of code depends on where it's executed: if
 -- a lazy thunk escapes 'withAltering', then it's going to be picking up a
--- different state. 'Eval' lets us be deliberate about what escapes and what
+-- different state. 'strat' lets us be deliberate about what escapes and what
 -- doesn't. Namely the altered state is available precisely during the
--- evaluation of `eval thing`.
-withAltering :: Eval b => Field a -> (Maybe a -> Maybe a) -> b -> Result b
-withAltering f g thing = unsafePerformIO $ withAlteringIO f g (PureEval thing)
+-- evaluation of `strat thing`.
+withAltering :: Field a -> (Maybe a -> Maybe a) -> Strat b -> b -> b
+withAltering f g strat thing = unsafePerformIO $ withAlteringIO f g strat thing
 {-# NOINLINE withAltering #-}
 
 -- | TODO
-withAlteringIO :: EvalIO b => Field a -> (Maybe a -> Maybe a) -> b -> IO (ResultIO b)
-withAlteringIO f g thing = do
+withAlteringIO :: Field a -> (Maybe a -> Maybe a) -> Strat b -> b -> IO b
+withAlteringIO f g strat thing = do
   outer_vault <- myLocalState
   inner_vault <- evaluate $ alterVault g f outer_vault
   -- We make an `async` here, not because of concurrency: it's not going to be
@@ -198,7 +207,8 @@ withAlteringIO f g thing = do
   -- - Uses the GC to collect thread-local state: https://hackage.haskell.org/package/thread-utils-context
   me <- async $ do
     setLocalState inner_vault
-    evalIO thing
+    E <- evaluate $ strat thing
+    return thing
   -- Note: this implementation relies of the fact that thread ids can't be
   -- reused, otherwise there may be races. I'm not sure that GHC guarantees
   -- this property.
@@ -209,34 +219,134 @@ withAlteringIO f g thing = do
 -- set to `a`.
 --
 -- See 'withAltering' for more explanations.
-withSetting :: Eval b => Field a -> a -> b -> Result b
+withSetting :: Field a -> a -> Strat b -> b -> b
 withSetting f a = withAltering f (\_ -> Just a)
 
 -- | TODO
-withSettingIO :: EvalIO b => Field a -> a -> b -> IO (ResultIO b)
+withSettingIO :: Field a -> a -> Strat b -> b -> IO b
 withSettingIO f a = withAlteringIO f (\_ -> Just a)
 
 -- | @'unsafeSpanBenign' before after thing@ runs the `before` action before
--- evaluating `thing`, then runs the `after` action.
+-- evaluating `strat thing`, then runs the `after` action.
 --
 -- 'unsafeSpanBenign' is not typically used directly in programs, but used to
 -- write safe benign-effect-spanning functions.
 --
 -- To call 'unsafeSpanBenign' safely, make sure that the `before` and `after`
 -- actions are indeed benign.
 unsafeSpanBenign ::
-  Eval a =>
   -- | Action to run before evaluation
   IO () ->
   -- | Action to run after evaluation
   IO () ->
+  Strat a ->
   a ->
-  Result a
-unsafeSpanBenign before after thing = unsafePerformIO $ do
-  thunk <- bracket_ before after (evaluate $ eval thing)
-  return $ extractEval thunk
+  a
+unsafeSpanBenign before after strat thing = unsafePerformIO $ do
+  E <- bracket_ before after (evaluate $ strat thing)
+  return thing
 {-# NOINLINE unsafeSpanBenign #-}
 
+---------------------------------------------------------------------------
+--
+-- Evaluate in a monad
+--
+---------------------------------------------------------------------------
+
+-- | In non-IO monadic code (that is when monads are used as a way to organise
+-- pure code), naturally, we'll be wanting to use benign effect as well. How
+-- scopes and running monadic code interleave doesn't have a generic
+-- answer. This is because monadic code is fundamentally staged: first you build
+-- a monadic expression, then it is run. Benign effects, and in particular
+-- local state updates, must happen when the monad is run, not when the
+-- expression is built.
+--
+-- Just like there isn't a generic `run` function, since all monads interpret
+-- the monadic expression differently, each monad needs to explain how they
+-- implement 'withAltering' and 'unsafeSpanBenign'. This is what the (admittedly
+-- poorly named) 'EvalM' class lets monad do.
+class EvalM m where
+  spliceEval :: (forall a. Strat a -> a ->  a) -> Strat b -> m b -> m b
+
+withAlteringM :: (EvalM m) => Field a -> (Maybe a -> Maybe a) -> Strat b -> m b -> m b
+withAlteringM f g = spliceEval (withAltering f g)
+
+-- | Like 'withAlteringM', but the `strat` is `lazy`. This is most often the
+-- right choice in a monadic context.
+withAlteringM' :: (EvalM m) => Field a -> (Maybe a -> Maybe a) -> m b -> m b
+withAlteringM' f g = withAlteringM f g lazy
+
+-- | Like 'withSetting', but in a monadic context. The `strat` is `lazy`. This
+-- is most often the right choice in a monadic context.
+withSettingM :: (EvalM m) => Field a -> a -> Strat b -> m b -> m b
+withSettingM f a = withAlteringM f (\_ -> Just a)
+
+-- | Like 'withSettingM', but the `strat` is `lazy`. This is most often the
+-- right choice in a monadic context.
+withSettingM' :: (EvalM m) => Field a -> a -> m b -> m b
+withSettingM' f a = withSettingM f a lazy
+
+unsafeSpanBenignM :: (EvalM m) => IO () -> IO () -> Strat a->m a -> m a
+unsafeSpanBenignM before after = spliceEval (unsafeSpanBenign before after)
+
+-- | Like 'unsafeSpanBenignM', but the `strat` is `lazy`. This is most often the
+-- right choice in a monadic context.
+unsafeSpanBenignM' :: (EvalM m) => IO () -> IO () -> m a -> m a
+unsafeSpanBenignM' before after = unsafeSpanBenignM before after lazy
+
+instance EvalM Identity where
+  spliceEval :: forall b. (forall a. Strat a -> a -> a) -> Strat b -> Identity b -> Identity b
+  spliceEval f = coerce $ f @b
+
+-- | Doesn't evaluate the state. It would be possible to require `'Eval' s` so
+-- that the state can also be evaluated. Unclear what is the most natural.
+instance (EvalM m) => EvalM (StateT s m) where
+  spliceEval f strat (StateT thing) = StateT $ \s -> spliceEval f tupStrat (thing s)
+    where
+      tupStrat (b, _) = strat b
+
+instance (EvalM m) => EvalM (ReaderT e m) where
+  spliceEval f strat (ReaderT thing) = ReaderT $ \e -> spliceEval f strat (thing e)
+
+---------------------------------------------------------------------------
+--
+-- Evaluate in a monad
+--
+---------------------------------------------------------------------------
+
+-- | Evaluation strategies. The idea is that evaluating with strategy `strat` is
+-- the same as evaluating `strat a` in whnf.
+--
+-- This is inspired by `Control.Seq.Strategy` from the
+-- [parallel](https://hackage.haskell.org/package/parallel) package. It's
+-- actually roughly the same type, but a little more modern. Making sure in
+-- particular that 'E', as a monoid, is strict, so that
+--
+-- > 'foldMap' :: Foldable t => Strat a -> Strat (t a)
+--
+-- Evaluates all the position in a container.
+type Strat a = a -> E
+
+data E = E
+  deriving stock (Eq, Ord, Enum, Bounded, Show, Read)
+
+instance Semigroup E where
+  E <> E = E
+
+instance Monoid E where
+  mempty = E
+
+-- | Doesn't do any evaluation.
+lazy :: Strat a
+lazy = mempty
+
+-- | Evaluates in whnf. Like 'seq'
+whnf :: Strat a
+whnf a = a `seq` E
+
+nf :: (NFData a) => Strat a
+nf a = a `deepseq` E
+
 class Eval a where
   data Thunk a
 
@@ -351,43 +461,3 @@ newtype PureEval a = PureEval a
 instance Eval a => EvalIO (PureEval a) where
   type ResultIO (PureEval a) = Result a
   evalIO (PureEval a) = evalInIO a
-
----------------------------------------------------------------------------
---
--- Evaluate in a monad
---
----------------------------------------------------------------------------
-
--- | In non-IO monadic code (that is when monads are used as a way to organise
--- pure code), naturally, we'll be wanting to use benign effect as well. How
--- scopes and running monadic code interleave doesn't have a generic
--- answer. This is because monadic code is fundamentally staged: first you build
--- a monadic expression, then it is run. Benign effects, and in particular
--- local state updates, must happen when the monad is run, not when the
--- expression is built.
---
--- Just like there isn't a generic `run` function, since all monads interpret
--- the monadic expression differently, each monad needs to explain how they
--- implement 'withAltering' and 'unsafeSpanBenign'. This is what the (admittedly
--- poorly named) 'EvalM' class lets monad do.
-class EvalM m where
-  spliceEval :: Eval b => (forall a. Eval a => (a -> Result a)) -> m b -> m (Result b)
-
-withAlteringM :: (EvalM m, Eval b) => Field a -> (Maybe a -> Maybe a) -> m b -> m (Result b)
-withAlteringM f g = spliceEval (withAltering f g)
-
-withSettingM :: (EvalM m, Eval b) => Field a -> a -> m b -> m (Result b)
-withSettingM f a = withAlteringM f (\_ -> Just a)
-
-unsafeSpanBenignM :: (EvalM m, Eval a) => IO () -> IO () -> m a -> m (Result a)
-unsafeSpanBenignM before after = spliceEval (unsafeSpanBenign before after)
-
-instance EvalM Identity where
-  spliceEval :: forall b. Eval b => (forall a. Eval a => a -> Result a) -> Identity b -> Identity (Result b)
-  spliceEval f = coerce $ f @b
-
-instance (EvalM m, Eval s, Result s ~ s) => EvalM (StateT s m) where
-  spliceEval f (StateT thing) = StateT $ \s -> spliceEval f (thing s)
-
-instance (EvalM m) => EvalM (ReaderT e m) where
-  spliceEval f (ReaderT thing) = ReaderT $ \e -> spliceEval f (thing e)