{-# LANGUAGE LambdaCase            #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE RankNTypes            #-}
{-# LANGUAGE ScopedTypeVariables   #-}
{-# LANGUAGE TupleSections         #-}
{-# LANGUAGE TypeFamilies          #-}


{-|
  Shpadoinkle Continuation is the abstract structure of Shpadoinkle's event handling system.
  It allows for asynchronous effects in event handlers by providing a model for atomic updates
  of application state.
-}


module Shpadoinkle.Continuation (
  -- * The Continuation Type
  Continuation (..)
  , runContinuation
  , done, pur, impur, kleisli, causes, contIso
  -- * The Class
  , Continuous (..)
  -- ** Hoist
  , hoist
  -- * Forgetting
  , voidC', voidC, forgetC
  -- * Lifts
  , liftC', liftCMay', liftC, liftCMay
  -- * Utilities
  -- ** Product
  , leftC', leftC, rightC', rightC
  -- ** Coproduct
  , eitherC', eitherC
  -- ** Maybe
  , maybeC', maybeC, comaybe, comaybeC', comaybeC
  -- * Updates
  , writeUpdate, shouldUpdate, constUpdate
  -- * Monad Transformer
  , ContinuationT (..), voidRunContinuationT, kleisliT, commit
  ) where


import           Control.Arrow                 (first)
import qualified Control.Categorical.Functor   as F
import           Control.Monad                 (liftM2, void)
import           Control.Monad.Trans.Class     (MonadTrans (..))
import           Control.PseudoInverseCategory (EndoIso (..))
import           Data.Maybe                    (fromMaybe)
import           GHC.Conc                      (retry)
import           UnliftIO                      (MonadUnliftIO, TVar, atomically,
                                                newTVarIO, readTVar, readTVarIO,
                                                writeTVar)
import           UnliftIO.Concurrent           (forkIO)


-- | A Continuation builds up an
--   atomic state update incrementally in a series of stages. For each stage we perform
--   a monadic IO computation and we may get a pure state updating function. When
--   all of the stages have been executed we are left with a composition of the resulting
--   pure state updating functions, and this composition is applied atomically to the state.
--
--   Additionally, a Continuation stage may feature a Rollback action which cancels all state
--   updates generated so far but allows for further state updates to be generated based on
--   further monadic IO computation.
--
--   The functions generating each stage of the Continuation
--   are called with states which reflect the current state of the app, with all
--   the pure state updating functions generated so far having been
--   applied to it, so that each stage "sees" both the current state
--   (even if it changed since the start of computing the Continuation), and the updates made
--   so far, although those updates are not committed to the real state until the Continuation
--   finishes and they are all done atomically together.
data Continuation m a = Continuation (a -> a, a -> m (Continuation m a))
                      | Rollback (Continuation m a)
                      | Pure (a -> a)



-- | A pure state updating function can be turned into a Continuation. This function
--   is here so that users of the Continuation API can do basic things without needing
--   to depend on the internal structure of the type.
pur :: (a -> a) -> Continuation m a
pur :: (a -> a) -> Continuation m a
pur = (a -> a) -> Continuation m a
forall (m :: * -> *) a. (a -> a) -> Continuation m a
Pure


-- | A Continuation which doesn't touch the state and doesn't have any side effects
done :: Continuation m a
done :: Continuation m a
done = (a -> a) -> Continuation m a
forall a (m :: * -> *). (a -> a) -> Continuation m a
pur a -> a
forall a. a -> a
id


-- | A monadic computation of a pure state updating function can be turned into a Continuation.
impur :: Monad m => m (a -> a) -> Continuation m a
impur :: m (a -> a) -> Continuation m a
impur m (a -> a)
m = (a -> a, a -> m (Continuation m a)) -> Continuation m a
forall (m :: * -> *) a.
(a -> a, a -> m (Continuation m a)) -> Continuation m a
Continuation ((a -> a, a -> m (Continuation m a)) -> Continuation m a)
-> (m (Continuation m a) -> (a -> a, a -> m (Continuation m a)))
-> m (Continuation m a)
-> Continuation m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> a
forall a. a -> a
id,) ((a -> m (Continuation m a))
 -> (a -> a, a -> m (Continuation m a)))
-> (m (Continuation m a) -> a -> m (Continuation m a))
-> m (Continuation m a)
-> (a -> a, a -> m (Continuation m a))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. m (Continuation m a) -> a -> m (Continuation m a)
forall a b. a -> b -> a
const (m (Continuation m a) -> Continuation m a)
-> m (Continuation m a) -> Continuation m a
forall a b. (a -> b) -> a -> b
$ do
  a -> a
f <- m (a -> a)
m
  Continuation m a -> m (Continuation m a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Continuation m a -> m (Continuation m a))
-> Continuation m a -> m (Continuation m a)
forall a b. (a -> b) -> a -> b
$ (a -> a, a -> m (Continuation m a)) -> Continuation m a
forall (m :: * -> *) a.
(a -> a, a -> m (Continuation m a)) -> Continuation m a
Continuation (a -> a
f, m (Continuation m a) -> a -> m (Continuation m a)
forall a b. a -> b -> a
const (Continuation m a -> m (Continuation m a)
forall (m :: * -> *) a. Monad m => a -> m a
return Continuation m a
forall (m :: * -> *) a. Continuation m a
done))


-- | This turns a Kleisli arrow for computing a Continuation into the Continuation which
--   reads the state, runs the monadic computation specified by the arrow on that state,
--   and runs the resulting Continuation.
kleisli :: (a -> m (Continuation m a)) -> Continuation m a
kleisli :: (a -> m (Continuation m a)) -> Continuation m a
kleisli = (a -> a, a -> m (Continuation m a)) -> Continuation m a
forall (m :: * -> *) a.
(a -> a, a -> m (Continuation m a)) -> Continuation m a
Continuation ((a -> a, a -> m (Continuation m a)) -> Continuation m a)
-> ((a -> m (Continuation m a))
    -> (a -> a, a -> m (Continuation m a)))
-> (a -> m (Continuation m a))
-> Continuation m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> a
forall a. a -> a
id,)


-- | A monadic computation can be turned into a Continuation which does not touch the state.
causes :: Monad m => m () -> Continuation m a
causes :: m () -> Continuation m a
causes m ()
m = m (a -> a) -> Continuation m a
forall (m :: * -> *) a. Monad m => m (a -> a) -> Continuation m a
impur (m ()
m m () -> m (a -> a) -> m (a -> a)
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> (a -> a) -> m (a -> a)
forall (m :: * -> *) a. Monad m => a -> m a
return a -> a
forall a. a -> a
id)


-- | 'runContinuation' takes a 'Continuation' and a state value and runs the whole Continuation
--   as if the real state was frozen at the value given to 'runContinuation'. It performs all the
--   IO actions in the stages of the Continuation and returns a pure state updating function
--   which is the composition of all the pure state updating functions generated by the
--   non-rolled-back stages of the Continuation. If you are trying to update a 'Continuous'
--   territory, then you should probably be using 'writeUpdate' instead of 'runContinuation',
--   because 'writeUpdate' will allow each stage of the Continuation to see any extant updates
--   made to the territory after the Continuation started running.
runContinuation :: Monad m => Continuation m a -> a -> m (a -> a)
runContinuation :: Continuation m a -> a -> m (a -> a)
runContinuation = (a -> a) -> Continuation m a -> a -> m (a -> a)
forall (m :: * -> *) a.
Monad m =>
(a -> a) -> Continuation m a -> a -> m (a -> a)
runContinuation' a -> a
forall a. a -> a
id


runContinuation' :: Monad m => (a -> a) -> Continuation m a -> a -> m (a -> a)
runContinuation' :: (a -> a) -> Continuation m a -> a -> m (a -> a)
runContinuation' a -> a
f (Continuation (a -> a
g, a -> m (Continuation m a)
h)) a
x = do
  Continuation m a
i <- a -> m (Continuation m a)
h (a -> a
f a
x)
  (a -> a) -> Continuation m a -> a -> m (a -> a)
forall (m :: * -> *) a.
Monad m =>
(a -> a) -> Continuation m a -> a -> m (a -> a)
runContinuation' (a -> a
g(a -> a) -> (a -> a) -> a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
.a -> a
f) Continuation m a
i a
x
runContinuation' a -> a
_ (Rollback Continuation m a
f) a
x = (a -> a) -> Continuation m a -> a -> m (a -> a)
forall (m :: * -> *) a.
Monad m =>
(a -> a) -> Continuation m a -> a -> m (a -> a)
runContinuation' a -> a
forall a. a -> a
id Continuation m a
f a
x
runContinuation' a -> a
f (Pure a -> a
g) a
_ = (a -> a) -> m (a -> a)
forall (m :: * -> *) a. Monad m => a -> m a
return (a -> a
g(a -> a) -> (a -> a) -> a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
.a -> a
f)


-- | @f@ is a Functor to Hask from the category where the objects are
--   Continuation types and the morphisms are functions.
class Continuous f where
  mapC :: (Continuation m a -> Continuation m b) -> f m a -> f m b


instance Continuous Continuation where
  mapC :: (Continuation m a -> Continuation m b)
-> Continuation m a -> Continuation m b
mapC = (Continuation m a -> Continuation m b)
-> Continuation m a -> Continuation m b
forall a. a -> a
id


-- | Given a natural transformation, change a Continuation's underlying functor.
hoist :: Functor m => (forall b. m b -> n b) -> Continuation m a -> Continuation n a
hoist :: (forall b. m b -> n b) -> Continuation m a -> Continuation n a
hoist forall b. m b -> n b
_ (Pure a -> a
f)              = (a -> a) -> Continuation n a
forall (m :: * -> *) a. (a -> a) -> Continuation m a
Pure a -> a
f
hoist forall b. m b -> n b
f (Rollback Continuation m a
r)          = Continuation n a -> Continuation n a
forall (m :: * -> *) a. Continuation m a -> Continuation m a
Rollback ((forall b. m b -> n b) -> Continuation m a -> Continuation n a
forall (m :: * -> *) (n :: * -> *) a.
Functor m =>
(forall b. m b -> n b) -> Continuation m a -> Continuation n a
hoist forall b. m b -> n b
f Continuation m a
r)
hoist forall b. m b -> n b
f (Continuation (a -> a
g, a -> m (Continuation m a)
h)) = (a -> a, a -> n (Continuation n a)) -> Continuation n a
forall (m :: * -> *) a.
(a -> a, a -> m (Continuation m a)) -> Continuation m a
Continuation ((a -> a, a -> n (Continuation n a)) -> Continuation n a)
-> ((a -> n (Continuation n a))
    -> (a -> a, a -> n (Continuation n a)))
-> (a -> n (Continuation n a))
-> Continuation n a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> a
g,) ((a -> n (Continuation n a)) -> Continuation n a)
-> (a -> n (Continuation n a)) -> Continuation n a
forall a b. (a -> b) -> a -> b
$ \a
x -> m (Continuation n a) -> n (Continuation n a)
forall b. m b -> n b
f (m (Continuation n a) -> n (Continuation n a))
-> m (Continuation n a) -> n (Continuation n a)
forall a b. (a -> b) -> a -> b
$ (forall b. m b -> n b) -> Continuation m a -> Continuation n a
forall (m :: * -> *) (n :: * -> *) a.
Functor m =>
(forall b. m b -> n b) -> Continuation m a -> Continuation n a
hoist forall b. m b -> n b
f (Continuation m a -> Continuation n a)
-> m (Continuation m a) -> m (Continuation n a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> a -> m (Continuation m a)
h a
x


-- | Apply a lens inside a Continuation to change the Continuation's type.
liftC' :: Functor m => (a -> b -> b) -> (b -> a) -> Continuation m a -> Continuation m b
liftC' :: (a -> b -> b) -> (b -> a) -> Continuation m a -> Continuation m b
liftC' a -> b -> b
f b -> a
g (Pure a -> a
h) = (b -> b) -> Continuation m b
forall (m :: * -> *) a. (a -> a) -> Continuation m a
Pure (\b
x -> a -> b -> b
f (a -> a
h (b -> a
g b
x)) b
x)
liftC' a -> b -> b
f b -> a
g (Rollback Continuation m a
r) = Continuation m b -> Continuation m b
forall (m :: * -> *) a. Continuation m a -> Continuation m a
Rollback ((a -> b -> b) -> (b -> a) -> Continuation m a -> Continuation m b
forall (m :: * -> *) a b.
Functor m =>
(a -> b -> b) -> (b -> a) -> Continuation m a -> Continuation m b
liftC' a -> b -> b
f b -> a
g Continuation m a
r)
liftC' a -> b -> b
f b -> a
g (Continuation (a -> a
h, a -> m (Continuation m a)
i)) = (b -> b, b -> m (Continuation m b)) -> Continuation m b
forall (m :: * -> *) a.
(a -> a, a -> m (Continuation m a)) -> Continuation m a
Continuation (\b
x -> a -> b -> b
f (a -> a
h (b -> a
g b
x)) b
x, \b
x -> (a -> b -> b) -> (b -> a) -> Continuation m a -> Continuation m b
forall (m :: * -> *) a b.
Functor m =>
(a -> b -> b) -> (b -> a) -> Continuation m a -> Continuation m b
liftC' a -> b -> b
f b -> a
g (Continuation m a -> Continuation m b)
-> m (Continuation m a) -> m (Continuation m b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> a -> m (Continuation m a)
i (b -> a
g b
x))


-- | Apply a traversal inside a Continuation to change the Continuation's type.
liftCMay' :: Applicative m => (a -> b -> b) -> (b -> Maybe a) -> Continuation m a -> Continuation m b
liftCMay' :: (a -> b -> b)
-> (b -> Maybe a) -> Continuation m a -> Continuation m b
liftCMay' a -> b -> b
f b -> Maybe a
g (Pure a -> a
h)     = (b -> b) -> Continuation m b
forall (m :: * -> *) a. (a -> a) -> Continuation m a
Pure ((b -> b) -> Continuation m b) -> (b -> b) -> Continuation m b
forall a b. (a -> b) -> a -> b
$ \b
x -> b -> (a -> b) -> Maybe a -> b
forall b a. b -> (a -> b) -> Maybe a -> b
maybe b
x ((a -> b -> b) -> b -> a -> b
forall a b c. (a -> b -> c) -> b -> a -> c
flip a -> b -> b
f b
x (a -> b) -> (a -> a) -> a -> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> a
h) (Maybe a -> b) -> Maybe a -> b
forall a b. (a -> b) -> a -> b
$ b -> Maybe a
g b
x
liftCMay' a -> b -> b
f b -> Maybe a
g (Rollback Continuation m a
r) = Continuation m b -> Continuation m b
forall (m :: * -> *) a. Continuation m a -> Continuation m a
Rollback ((a -> b -> b)
-> (b -> Maybe a) -> Continuation m a -> Continuation m b
forall (m :: * -> *) a b.
Applicative m =>
(a -> b -> b)
-> (b -> Maybe a) -> Continuation m a -> Continuation m b
liftCMay' a -> b -> b
f b -> Maybe a
g Continuation m a
r)
liftCMay' a -> b -> b
f b -> Maybe a
g (Continuation (a -> a
h, a -> m (Continuation m a)
i)) =
  (b -> b, b -> m (Continuation m b)) -> Continuation m b
forall (m :: * -> *) a.
(a -> a, a -> m (Continuation m a)) -> Continuation m a
Continuation (\b
x -> b -> (a -> b) -> Maybe a -> b
forall b a. b -> (a -> b) -> Maybe a -> b
maybe b
x ((a -> b -> b) -> b -> a -> b
forall a b c. (a -> b -> c) -> b -> a -> c
flip a -> b -> b
f b
x (a -> b) -> (a -> a) -> a -> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> a
h) (Maybe a -> b) -> Maybe a -> b
forall a b. (a -> b) -> a -> b
$ b -> Maybe a
g b
x, m (Continuation m b)
-> (a -> m (Continuation m b)) -> Maybe a -> m (Continuation m b)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Continuation m b -> m (Continuation m b)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Continuation m b
forall (m :: * -> *) a. Continuation m a
done) ((Continuation m a -> Continuation m b)
-> m (Continuation m a) -> m (Continuation m b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((a -> b -> b)
-> (b -> Maybe a) -> Continuation m a -> Continuation m b
forall (m :: * -> *) a b.
Applicative m =>
(a -> b -> b)
-> (b -> Maybe a) -> Continuation m a -> Continuation m b
liftCMay' a -> b -> b
f b -> Maybe a
g) (m (Continuation m a) -> m (Continuation m b))
-> (a -> m (Continuation m a)) -> a -> m (Continuation m b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> m (Continuation m a)
i) (Maybe a -> m (Continuation m b))
-> (b -> Maybe a) -> b -> m (Continuation m b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. b -> Maybe a
g)


-- | Given a lens, change the value type of @f@ by applying the lens in the Continuations inside @f@.
liftC :: Functor m => Continuous f => (a -> b -> b) -> (b -> a) -> f m a -> f m b
liftC :: (a -> b -> b) -> (b -> a) -> f m a -> f m b
liftC a -> b -> b
f b -> a
g = (Continuation m a -> Continuation m b) -> f m a -> f m b
forall (f :: (* -> *) -> * -> *) (m :: * -> *) a b.
Continuous f =>
(Continuation m a -> Continuation m b) -> f m a -> f m b
mapC ((a -> b -> b) -> (b -> a) -> Continuation m a -> Continuation m b
forall (m :: * -> *) a b.
Functor m =>
(a -> b -> b) -> (b -> a) -> Continuation m a -> Continuation m b
liftC' a -> b -> b
f b -> a
g)


-- | Given a traversal, change the value of @f@ by apply the traversal in the Continuations inside @f@.
liftCMay :: Applicative m => Continuous f => (a -> b -> b) -> (b -> Maybe a) -> f m a -> f m b
liftCMay :: (a -> b -> b) -> (b -> Maybe a) -> f m a -> f m b
liftCMay a -> b -> b
f b -> Maybe a
g = (Continuation m a -> Continuation m b) -> f m a -> f m b
forall (f :: (* -> *) -> * -> *) (m :: * -> *) a b.
Continuous f =>
(Continuation m a -> Continuation m b) -> f m a -> f m b
mapC ((a -> b -> b)
-> (b -> Maybe a) -> Continuation m a -> Continuation m b
forall (m :: * -> *) a b.
Applicative m =>
(a -> b -> b)
-> (b -> Maybe a) -> Continuation m a -> Continuation m b
liftCMay' a -> b -> b
f b -> Maybe a
g)


-- | Change a void continuation into any other type of Continuation.
voidC' :: Monad m => Continuation m () -> Continuation m a
voidC' :: Continuation m () -> Continuation m a
voidC' Continuation m ()
f = (a -> a, a -> m (Continuation m a)) -> Continuation m a
forall (m :: * -> *) a.
(a -> a, a -> m (Continuation m a)) -> Continuation m a
Continuation ((a -> a, a -> m (Continuation m a)) -> Continuation m a)
-> ((a -> m (Continuation m a))
    -> (a -> a, a -> m (Continuation m a)))
-> (a -> m (Continuation m a))
-> Continuation m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> a
forall a. a -> a
id,) ((a -> m (Continuation m a)) -> Continuation m a)
-> (a -> m (Continuation m a)) -> Continuation m a
forall a b. (a -> b) -> a -> b
$ \a
_ -> do
  () -> ()
_ <- Continuation m () -> () -> m (() -> ())
forall (m :: * -> *) a.
Monad m =>
Continuation m a -> a -> m (a -> a)
runContinuation Continuation m ()
f ()
  Continuation m a -> m (Continuation m a)
forall (m :: * -> *) a. Monad m => a -> m a
return Continuation m a
forall (m :: * -> *) a. Continuation m a
done


-- | Change the type of the f-embedded void Continuations into any other type of Continuation.
voidC :: Monad m => Continuous f => f m () -> f m a
voidC :: f m () -> f m a
voidC = (Continuation m () -> Continuation m a) -> f m () -> f m a
forall (f :: (* -> *) -> * -> *) (m :: * -> *) a b.
Continuous f =>
(Continuation m a -> Continuation m b) -> f m a -> f m b
mapC Continuation m () -> Continuation m a
forall (m :: * -> *) a.
Monad m =>
Continuation m () -> Continuation m a
voidC'


-- | Forget about the Continuations.
forgetC :: Continuous f => f m a -> f m b
forgetC :: f m a -> f m b
forgetC = (Continuation m a -> Continuation m b) -> f m a -> f m b
forall (f :: (* -> *) -> * -> *) (m :: * -> *) a b.
Continuous f =>
(Continuation m a -> Continuation m b) -> f m a -> f m b
mapC (Continuation m b -> Continuation m a -> Continuation m b
forall a b. a -> b -> a
const Continuation m b
forall (m :: * -> *) a. Continuation m a
done)


--- | Change the type of a Continuation by applying it to the left coordinate of a tuple.
leftC' :: Functor m => Continuation m a -> Continuation m (a,b)
leftC' :: Continuation m a -> Continuation m (a, b)
leftC' = (a -> (a, b) -> (a, b))
-> ((a, b) -> a) -> Continuation m a -> Continuation m (a, b)
forall (m :: * -> *) a b.
Functor m =>
(a -> b -> b) -> (b -> a) -> Continuation m a -> Continuation m b
liftC' (\a
x (a
_,b
y) -> (a
x,b
y)) (a, b) -> a
forall a b. (a, b) -> a
fst


-- | Change the type of @f@ by applying the Continuations inside @f@ to the left coordinate of a tuple.
leftC :: Functor m => Continuous f => f m a -> f m (a,b)
leftC :: f m a -> f m (a, b)
leftC = (Continuation m a -> Continuation m (a, b)) -> f m a -> f m (a, b)
forall (f :: (* -> *) -> * -> *) (m :: * -> *) a b.
Continuous f =>
(Continuation m a -> Continuation m b) -> f m a -> f m b
mapC Continuation m a -> Continuation m (a, b)
forall (m :: * -> *) a b.
Functor m =>
Continuation m a -> Continuation m (a, b)
leftC'


-- | Change the type of a Continuation by applying it to the right coordinate of a tuple.
rightC' :: Functor m => Continuation m b -> Continuation m (a,b)
rightC' :: Continuation m b -> Continuation m (a, b)
rightC' = (b -> (a, b) -> (a, b))
-> ((a, b) -> b) -> Continuation m b -> Continuation m (a, b)
forall (m :: * -> *) a b.
Functor m =>
(a -> b -> b) -> (b -> a) -> Continuation m a -> Continuation m b
liftC' (\b
y (a
x,b
_) -> (a
x,b
y)) (a, b) -> b
forall a b. (a, b) -> b
snd


-- | Change the value type of @f@ by applying the Continuations inside @f@ to the right coordinate of a tuple.
rightC :: Functor m => Continuous f => f m b -> f m (a,b)
rightC :: f m b -> f m (a, b)
rightC = (Continuation m b -> Continuation m (a, b)) -> f m b -> f m (a, b)
forall (f :: (* -> *) -> * -> *) (m :: * -> *) a b.
Continuous f =>
(Continuation m a -> Continuation m b) -> f m a -> f m b
mapC Continuation m b -> Continuation m (a, b)
forall (m :: * -> *) b a.
Functor m =>
Continuation m b -> Continuation m (a, b)
rightC'


-- | Transform a Continuation to work on 'Maybe's. If it encounters 'Nothing', then it cancels itself.
maybeC' :: Applicative m => Continuation m a -> Continuation m (Maybe a)
maybeC' :: Continuation m a -> Continuation m (Maybe a)
maybeC' (Pure a -> a
f) = (Maybe a -> Maybe a) -> Continuation m (Maybe a)
forall (m :: * -> *) a. (a -> a) -> Continuation m a
Pure ((a -> a) -> Maybe a -> Maybe a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> a
f)
maybeC' (Rollback Continuation m a
r) = Continuation m (Maybe a) -> Continuation m (Maybe a)
forall (m :: * -> *) a. Continuation m a -> Continuation m a
Rollback (Continuation m a -> Continuation m (Maybe a)
forall (m :: * -> *) a.
Applicative m =>
Continuation m a -> Continuation m (Maybe a)
maybeC' Continuation m a
r)
maybeC' (Continuation (a -> a
f, a -> m (Continuation m a)
g)) = (Maybe a -> Maybe a, Maybe a -> m (Continuation m (Maybe a)))
-> Continuation m (Maybe a)
forall (m :: * -> *) a.
(a -> a, a -> m (Continuation m a)) -> Continuation m a
Continuation ((Maybe a -> Maybe a, Maybe a -> m (Continuation m (Maybe a)))
 -> Continuation m (Maybe a))
-> ((Maybe a -> m (Continuation m (Maybe a)))
    -> (Maybe a -> Maybe a, Maybe a -> m (Continuation m (Maybe a))))
-> (Maybe a -> m (Continuation m (Maybe a)))
-> Continuation m (Maybe a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((a -> a) -> Maybe a -> Maybe a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> a
f,) ((Maybe a -> m (Continuation m (Maybe a)))
 -> Continuation m (Maybe a))
-> (Maybe a -> m (Continuation m (Maybe a)))
-> Continuation m (Maybe a)
forall a b. (a -> b) -> a -> b
$
  \case
    Just a
x  -> Continuation m a -> Continuation m (Maybe a)
forall (m :: * -> *) a.
Applicative m =>
Continuation m a -> Continuation m (Maybe a)
maybeC' (Continuation m a -> Continuation m (Maybe a))
-> m (Continuation m a) -> m (Continuation m (Maybe a))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> a -> m (Continuation m a)
g a
x
    Maybe a
Nothing -> Continuation m (Maybe a) -> m (Continuation m (Maybe a))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Continuation m (Maybe a) -> Continuation m (Maybe a)
forall (m :: * -> *) a. Continuation m a -> Continuation m a
Rollback Continuation m (Maybe a)
forall (m :: * -> *) a. Continuation m a
done)


-- | Change the value type of @f@ by transforming the Continuations inside @f@ to work on 'Maybe's using maybeC'.
maybeC :: Applicative m => Continuous f => f m a -> f m (Maybe a)
maybeC :: f m a -> f m (Maybe a)
maybeC = (Continuation m a -> Continuation m (Maybe a))
-> f m a -> f m (Maybe a)
forall (f :: (* -> *) -> * -> *) (m :: * -> *) a b.
Continuous f =>
(Continuation m a -> Continuation m b) -> f m a -> f m b
mapC Continuation m a -> Continuation m (Maybe a)
forall (m :: * -> *) a.
Applicative m =>
Continuation m a -> Continuation m (Maybe a)
maybeC'


-- | Turn a @Maybe a@ updating function into an @a@ updating function which acts as
--   the identity function when the input function outputs 'Nothing'.
comaybe :: (Maybe a -> Maybe a) -> (a -> a)
comaybe :: (Maybe a -> Maybe a) -> a -> a
comaybe Maybe a -> Maybe a
f a
x = a -> Maybe a -> a
forall a. a -> Maybe a -> a
fromMaybe a
x (Maybe a -> a) -> (Maybe a -> Maybe a) -> Maybe a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe a -> Maybe a
f (Maybe a -> a) -> Maybe a -> a
forall a b. (a -> b) -> a -> b
$ a -> Maybe a
forall a. a -> Maybe a
Just a
x


-- | Change the type of a Maybe-valued Continuation into the Maybe-wrapped type.
--   The resulting Continuation acts like the input Continuation except that
--   when the input Continuation would replace the current value with 'Nothing',
--   instead the current value is retained.
comaybeC' :: Functor m => Continuation m (Maybe a) -> Continuation m a
comaybeC' :: Continuation m (Maybe a) -> Continuation m a
comaybeC' (Pure Maybe a -> Maybe a
f) = (a -> a) -> Continuation m a
forall (m :: * -> *) a. (a -> a) -> Continuation m a
Pure ((Maybe a -> Maybe a) -> a -> a
forall a. (Maybe a -> Maybe a) -> a -> a
comaybe Maybe a -> Maybe a
f)
comaybeC' (Rollback Continuation m (Maybe a)
r) = Continuation m a -> Continuation m a
forall (m :: * -> *) a. Continuation m a -> Continuation m a
Rollback (Continuation m (Maybe a) -> Continuation m a
forall (m :: * -> *) a.
Functor m =>
Continuation m (Maybe a) -> Continuation m a
comaybeC' Continuation m (Maybe a)
r)
comaybeC' (Continuation (Maybe a -> Maybe a
f,Maybe a -> m (Continuation m (Maybe a))
g)) = (a -> a, a -> m (Continuation m a)) -> Continuation m a
forall (m :: * -> *) a.
(a -> a, a -> m (Continuation m a)) -> Continuation m a
Continuation ((Maybe a -> Maybe a) -> a -> a
forall a. (Maybe a -> Maybe a) -> a -> a
comaybe Maybe a -> Maybe a
f, (Continuation m (Maybe a) -> Continuation m a)
-> m (Continuation m (Maybe a)) -> m (Continuation m a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Continuation m (Maybe a) -> Continuation m a
forall (m :: * -> *) a.
Functor m =>
Continuation m (Maybe a) -> Continuation m a
comaybeC' (m (Continuation m (Maybe a)) -> m (Continuation m a))
-> (a -> m (Continuation m (Maybe a))) -> a -> m (Continuation m a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe a -> m (Continuation m (Maybe a))
g (Maybe a -> m (Continuation m (Maybe a)))
-> (a -> Maybe a) -> a -> m (Continuation m (Maybe a))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Maybe a
forall a. a -> Maybe a
Just)


-- | Transform the Continuations inside @f@ using comaybeC'.
comaybeC :: Functor m => Continuous f => f m (Maybe a) -> f m a
comaybeC :: f m (Maybe a) -> f m a
comaybeC = (Continuation m (Maybe a) -> Continuation m a)
-> f m (Maybe a) -> f m a
forall (f :: (* -> *) -> * -> *) (m :: * -> *) a b.
Continuous f =>
(Continuation m a -> Continuation m b) -> f m a -> f m b
mapC Continuation m (Maybe a) -> Continuation m a
forall (m :: * -> *) a.
Functor m =>
Continuation m (Maybe a) -> Continuation m a
comaybeC'


-- Just define these rather than introducing another dependency even though they are in either
mapLeft :: (a -> b) -> Either a c -> Either b c
mapLeft :: (a -> b) -> Either a c -> Either b c
mapLeft a -> b
f (Left a
x)  = b -> Either b c
forall a b. a -> Either a b
Left (a -> b
f a
x)
mapLeft a -> b
_ (Right c
x) = c -> Either b c
forall a b. b -> Either a b
Right c
x


mapRight :: (b -> c) -> Either a b -> Either a c
mapRight :: (b -> c) -> Either a b -> Either a c
mapRight b -> c
_ (Left a
x)  = a -> Either a c
forall a b. a -> Either a b
Left a
x
mapRight b -> c
f (Right b
x) = c -> Either a c
forall a b. b -> Either a b
Right (b -> c
f b
x)


-- | Combine Continuations heterogeneously into coproduct Continuations.
--   The first value the Continuation sees determines which of the
--   two input Continuation branches it follows. If the coproduct Continuation
--   sees the state change to a different Either-branch, then it cancels itself.
--   If the state is in a different Either-branch when the Continuation
--   completes than it was when the Continuation started, then the
--   coproduct Continuation will have no effect on the state.
eitherC' :: Monad m => Continuation m a -> Continuation m b -> Continuation m (Either a b)
eitherC' :: Continuation m a -> Continuation m b -> Continuation m (Either a b)
eitherC' Continuation m a
f Continuation m b
g = (Either a b -> Either a b,
 Either a b -> m (Continuation m (Either a b)))
-> Continuation m (Either a b)
forall (m :: * -> *) a.
(a -> a, a -> m (Continuation m a)) -> Continuation m a
Continuation ((Either a b -> Either a b,
  Either a b -> m (Continuation m (Either a b)))
 -> Continuation m (Either a b))
-> ((Either a b -> m (Continuation m (Either a b)))
    -> (Either a b -> Either a b,
        Either a b -> m (Continuation m (Either a b))))
-> (Either a b -> m (Continuation m (Either a b)))
-> Continuation m (Either a b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Either a b -> Either a b
forall a. a -> a
id,) ((Either a b -> m (Continuation m (Either a b)))
 -> Continuation m (Either a b))
-> (Either a b -> m (Continuation m (Either a b)))
-> Continuation m (Either a b)
forall a b. (a -> b) -> a -> b
$ \case
  Left a
x -> case Continuation m a
f of
    Pure a -> a
h -> Continuation m (Either a b) -> m (Continuation m (Either a b))
forall (m :: * -> *) a. Monad m => a -> m a
return ((Either a b -> Either a b) -> Continuation m (Either a b)
forall (m :: * -> *) a. (a -> a) -> Continuation m a
Pure ((a -> a) -> Either a b -> Either a b
forall a b c. (a -> b) -> Either a c -> Either b c
mapLeft a -> a
h))
    Rollback Continuation m a
r -> Continuation m (Either a b) -> m (Continuation m (Either a b))
forall (m :: * -> *) a. Monad m => a -> m a
return (Continuation m (Either a b) -> m (Continuation m (Either a b)))
-> (Continuation m (Either a b) -> Continuation m (Either a b))
-> Continuation m (Either a b)
-> m (Continuation m (Either a b))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Continuation m (Either a b) -> Continuation m (Either a b)
forall (m :: * -> *) a. Continuation m a -> Continuation m a
Rollback (Continuation m (Either a b) -> m (Continuation m (Either a b)))
-> Continuation m (Either a b) -> m (Continuation m (Either a b))
forall a b. (a -> b) -> a -> b
$ Continuation m a -> Continuation m b -> Continuation m (Either a b)
forall (m :: * -> *) a b.
Monad m =>
Continuation m a -> Continuation m b -> Continuation m (Either a b)
eitherC' Continuation m a
r Continuation m b
forall (m :: * -> *) a. Continuation m a
done
    Continuation (a -> a
h, a -> m (Continuation m a)
i) -> do
      Continuation m a
j <- a -> m (Continuation m a)
i a
x
      Continuation m (Either a b) -> m (Continuation m (Either a b))
forall (m :: * -> *) a. Monad m => a -> m a
return (Continuation m (Either a b) -> m (Continuation m (Either a b)))
-> Continuation m (Either a b) -> m (Continuation m (Either a b))
forall a b. (a -> b) -> a -> b
$ (Either a b -> Either a b,
 Either a b -> m (Continuation m (Either a b)))
-> Continuation m (Either a b)
forall (m :: * -> *) a.
(a -> a, a -> m (Continuation m a)) -> Continuation m a
Continuation ((a -> a) -> Either a b -> Either a b
forall a b c. (a -> b) -> Either a c -> Either b c
mapLeft a -> a
h, m (Continuation m (Either a b))
-> Either a b -> m (Continuation m (Either a b))
forall a b. a -> b -> a
const (m (Continuation m (Either a b))
 -> Either a b -> m (Continuation m (Either a b)))
-> (Continuation m (Either a b) -> m (Continuation m (Either a b)))
-> Continuation m (Either a b)
-> Either a b
-> m (Continuation m (Either a b))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Continuation m (Either a b) -> m (Continuation m (Either a b))
forall (m :: * -> *) a. Monad m => a -> m a
return (Continuation m (Either a b)
 -> Either a b -> m (Continuation m (Either a b)))
-> Continuation m (Either a b)
-> Either a b
-> m (Continuation m (Either a b))
forall a b. (a -> b) -> a -> b
$ Continuation m a -> Continuation m b -> Continuation m (Either a b)
forall (m :: * -> *) a b.
Monad m =>
Continuation m a -> Continuation m b -> Continuation m (Either a b)
eitherC' Continuation m a
j (Continuation m b -> Continuation m b
forall (m :: * -> *) a. Continuation m a -> Continuation m a
Rollback Continuation m b
forall (m :: * -> *) a. Continuation m a
done))
  Right b
x -> case Continuation m b
g of
    Pure b -> b
h -> Continuation m (Either a b) -> m (Continuation m (Either a b))
forall (m :: * -> *) a. Monad m => a -> m a
return ((Either a b -> Either a b) -> Continuation m (Either a b)
forall (m :: * -> *) a. (a -> a) -> Continuation m a
Pure ((b -> b) -> Either a b -> Either a b
forall b c a. (b -> c) -> Either a b -> Either a c
mapRight b -> b
h))
    Rollback Continuation m b
r -> Continuation m (Either a b) -> m (Continuation m (Either a b))
forall (m :: * -> *) a. Monad m => a -> m a
return (Continuation m (Either a b) -> m (Continuation m (Either a b)))
-> (Continuation m (Either a b) -> Continuation m (Either a b))
-> Continuation m (Either a b)
-> m (Continuation m (Either a b))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Continuation m (Either a b) -> Continuation m (Either a b)
forall (m :: * -> *) a. Continuation m a -> Continuation m a
Rollback (Continuation m (Either a b) -> m (Continuation m (Either a b)))
-> Continuation m (Either a b) -> m (Continuation m (Either a b))
forall a b. (a -> b) -> a -> b
$ Continuation m a -> Continuation m b -> Continuation m (Either a b)
forall (m :: * -> *) a b.
Monad m =>
Continuation m a -> Continuation m b -> Continuation m (Either a b)
eitherC' Continuation m a
forall (m :: * -> *) a. Continuation m a
done Continuation m b
r
    Continuation (b -> b
h, b -> m (Continuation m b)
i) -> do
      Continuation m b
j <- b -> m (Continuation m b)
i b
x
      Continuation m (Either a b) -> m (Continuation m (Either a b))
forall (m :: * -> *) a. Monad m => a -> m a
return (Continuation m (Either a b) -> m (Continuation m (Either a b)))
-> Continuation m (Either a b) -> m (Continuation m (Either a b))
forall a b. (a -> b) -> a -> b
$ (Either a b -> Either a b,
 Either a b -> m (Continuation m (Either a b)))
-> Continuation m (Either a b)
forall (m :: * -> *) a.
(a -> a, a -> m (Continuation m a)) -> Continuation m a
Continuation ((b -> b) -> Either a b -> Either a b
forall b c a. (b -> c) -> Either a b -> Either a c
mapRight b -> b
h, m (Continuation m (Either a b))
-> Either a b -> m (Continuation m (Either a b))
forall a b. a -> b -> a
const (m (Continuation m (Either a b))
 -> Either a b -> m (Continuation m (Either a b)))
-> (Continuation m (Either a b) -> m (Continuation m (Either a b)))
-> Continuation m (Either a b)
-> Either a b
-> m (Continuation m (Either a b))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Continuation m (Either a b) -> m (Continuation m (Either a b))
forall (m :: * -> *) a. Monad m => a -> m a
return (Continuation m (Either a b)
 -> Either a b -> m (Continuation m (Either a b)))
-> Continuation m (Either a b)
-> Either a b
-> m (Continuation m (Either a b))
forall a b. (a -> b) -> a -> b
$ Continuation m a -> Continuation m b -> Continuation m (Either a b)
forall (m :: * -> *) a b.
Monad m =>
Continuation m a -> Continuation m b -> Continuation m (Either a b)
eitherC' (Continuation m a -> Continuation m a
forall (m :: * -> *) a. Continuation m a -> Continuation m a
Rollback Continuation m a
forall (m :: * -> *) a. Continuation m a
done) Continuation m b
j)


-- | Create a structure containing coproduct Continuations using two case
--   alternatives which generate structures containing Continuations of
--   the types inside the coproduct. The Continuations in the resulting
--   structure will only have effect on the state while it is in the branch
--   of the coproduct selected by the input value used to create the structure.
eitherC :: Monad m => Continuous f => (a -> f m a) -> (b -> f m b) -> Either a b -> f m (Either a b)
eitherC :: (a -> f m a) -> (b -> f m b) -> Either a b -> f m (Either a b)
eitherC a -> f m a
l b -> f m b
_ (Left a
x)  = (Continuation m a -> Continuation m (Either a b))
-> f m a -> f m (Either a b)
forall (f :: (* -> *) -> * -> *) (m :: * -> *) a b.
Continuous f =>
(Continuation m a -> Continuation m b) -> f m a -> f m b
mapC (\Continuation m a
c -> Continuation m a -> Continuation m b -> Continuation m (Either a b)
forall (m :: * -> *) a b.
Monad m =>
Continuation m a -> Continuation m b -> Continuation m (Either a b)
eitherC' Continuation m a
c ((b -> b) -> Continuation m b
forall a (m :: * -> *). (a -> a) -> Continuation m a
pur b -> b
forall a. a -> a
id)) (a -> f m a
l a
x)
eitherC a -> f m a
_ b -> f m b
r (Right b
x) = (Continuation m b -> Continuation m (Either a b))
-> f m b -> f m (Either a b)
forall (f :: (* -> *) -> * -> *) (m :: * -> *) a b.
Continuous f =>
(Continuation m a -> Continuation m b) -> f m a -> f m b
mapC (Continuation m a -> Continuation m b -> Continuation m (Either a b)
forall (m :: * -> *) a b.
Monad m =>
Continuation m a -> Continuation m b -> Continuation m (Either a b)
eitherC' ((a -> a) -> Continuation m a
forall a (m :: * -> *). (a -> a) -> Continuation m a
pur a -> a
forall a. a -> a
id)) (b -> f m b
r b
x)


-- | Transform the type of a Continuation using an isomorphism.
contIso :: Functor m => (a -> b) -> (b -> a) -> Continuation m a -> Continuation m b
contIso :: (a -> b) -> (b -> a) -> Continuation m a -> Continuation m b
contIso a -> b
f b -> a
g (Continuation (a -> a
h, a -> m (Continuation m a)
i)) = (b -> b, b -> m (Continuation m b)) -> Continuation m b
forall (m :: * -> *) a.
(a -> a, a -> m (Continuation m a)) -> Continuation m a
Continuation (a -> b
f(a -> b) -> (b -> a) -> b -> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
.a -> a
h(a -> a) -> (b -> a) -> b -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
.b -> a
g, (Continuation m a -> Continuation m b)
-> m (Continuation m a) -> m (Continuation m b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((a -> b) -> (b -> a) -> Continuation m a -> Continuation m b
forall (m :: * -> *) a b.
Functor m =>
(a -> b) -> (b -> a) -> Continuation m a -> Continuation m b
contIso a -> b
f b -> a
g) (m (Continuation m a) -> m (Continuation m b))
-> (b -> m (Continuation m a)) -> b -> m (Continuation m b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> m (Continuation m a)
i (a -> m (Continuation m a))
-> (b -> a) -> b -> m (Continuation m a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. b -> a
g)
contIso a -> b
f b -> a
g (Rollback Continuation m a
h) = Continuation m b -> Continuation m b
forall (m :: * -> *) a. Continuation m a -> Continuation m a
Rollback ((a -> b) -> (b -> a) -> Continuation m a -> Continuation m b
forall (m :: * -> *) a b.
Functor m =>
(a -> b) -> (b -> a) -> Continuation m a -> Continuation m b
contIso a -> b
f b -> a
g Continuation m a
h)
contIso a -> b
f b -> a
g (Pure a -> a
h) = (b -> b) -> Continuation m b
forall (m :: * -> *) a. (a -> a) -> Continuation m a
Pure (a -> b
f(a -> b) -> (b -> a) -> b -> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
.a -> a
h(a -> a) -> (b -> a) -> b -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
.b -> a
g)


-- | @Continuation m@ is a Functor in the EndoIso category (where the objects
--   are types and the morphisms are EndoIsos).
instance Applicative m => F.Functor EndoIso EndoIso (Continuation m) where
  map :: EndoIso a b -> EndoIso (Continuation m a) (Continuation m b)
map (EndoIso a -> a
f a -> b
g b -> a
h) =
    (Continuation m a -> Continuation m a)
-> (Continuation m a -> Continuation m b)
-> (Continuation m b -> Continuation m a)
-> EndoIso (Continuation m a) (Continuation m b)
forall a b. (a -> a) -> (a -> b) -> (b -> a) -> EndoIso a b
EndoIso ((a -> a, a -> m (Continuation m a)) -> Continuation m a
forall (m :: * -> *) a.
(a -> a, a -> m (Continuation m a)) -> Continuation m a
Continuation ((a -> a, a -> m (Continuation m a)) -> Continuation m a)
-> (Continuation m a -> (a -> a, a -> m (Continuation m a)))
-> Continuation m a
-> Continuation m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> a
f,) ((a -> m (Continuation m a))
 -> (a -> a, a -> m (Continuation m a)))
-> (Continuation m a -> a -> m (Continuation m a))
-> Continuation m a
-> (a -> a, a -> m (Continuation m a))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. m (Continuation m a) -> a -> m (Continuation m a)
forall a b. a -> b -> a
const (m (Continuation m a) -> a -> m (Continuation m a))
-> (Continuation m a -> m (Continuation m a))
-> Continuation m a
-> a
-> m (Continuation m a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Continuation m a -> m (Continuation m a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure) ((a -> b) -> (b -> a) -> Continuation m a -> Continuation m b
forall (m :: * -> *) a b.
Functor m =>
(a -> b) -> (b -> a) -> Continuation m a -> Continuation m b
contIso a -> b
g b -> a
h) ((b -> a) -> (a -> b) -> Continuation m b -> Continuation m a
forall (m :: * -> *) a b.
Functor m =>
(a -> b) -> (b -> a) -> Continuation m a -> Continuation m b
contIso b -> a
h a -> b
g)


-- | You can combine multiple Continuations homogeneously using the 'Monoid' typeclass
--   instance. The resulting Continuation will execute all the subcontinuations in parallel,
--   allowing them to see each other's state updates and roll back each other's updates,
--   applying all of the updates generated by all the subcontinuations atomically once
--   all of them are done.
instance Monad m => Semigroup (Continuation m a) where
  (Continuation (a -> a
f, a -> m (Continuation m a)
g)) <> :: Continuation m a -> Continuation m a -> Continuation m a
<> (Continuation (a -> a
h, a -> m (Continuation m a)
i)) =
    (a -> a, a -> m (Continuation m a)) -> Continuation m a
forall (m :: * -> *) a.
(a -> a, a -> m (Continuation m a)) -> Continuation m a
Continuation (a -> a
f(a -> a) -> (a -> a) -> a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
.a -> a
h, \a
x -> (Continuation m a -> Continuation m a -> Continuation m a)
-> m (Continuation m a)
-> m (Continuation m a)
-> m (Continuation m a)
forall (m :: * -> *) a1 a2 r.
Monad m =>
(a1 -> a2 -> r) -> m a1 -> m a2 -> m r
liftM2 Continuation m a -> Continuation m a -> Continuation m a
forall a. Semigroup a => a -> a -> a
(<>) (a -> m (Continuation m a)
g a
x) (a -> m (Continuation m a)
i a
x))
  (Continuation (a -> a
f, a -> m (Continuation m a)
g)) <> (Rollback Continuation m a
h) =
    Continuation m a -> Continuation m a
forall (m :: * -> *) a. Continuation m a -> Continuation m a
Rollback ((a -> a, a -> m (Continuation m a)) -> Continuation m a
forall (m :: * -> *) a.
(a -> a, a -> m (Continuation m a)) -> Continuation m a
Continuation (a -> a
f, \a
x -> (Continuation m a -> Continuation m a -> Continuation m a)
-> m (Continuation m a)
-> m (Continuation m a)
-> m (Continuation m a)
forall (m :: * -> *) a1 a2 r.
Monad m =>
(a1 -> a2 -> r) -> m a1 -> m a2 -> m r
liftM2 Continuation m a -> Continuation m a -> Continuation m a
forall a. Semigroup a => a -> a -> a
(<>) (a -> m (Continuation m a)
g a
x) (Continuation m a -> m (Continuation m a)
forall (m :: * -> *) a. Monad m => a -> m a
return Continuation m a
h)))
  (Rollback Continuation m a
h) <> (Continuation (a -> a
_, a -> m (Continuation m a)
g)) =
    Continuation m a -> Continuation m a
forall (m :: * -> *) a. Continuation m a -> Continuation m a
Rollback ((a -> a, a -> m (Continuation m a)) -> Continuation m a
forall (m :: * -> *) a.
(a -> a, a -> m (Continuation m a)) -> Continuation m a
Continuation (a -> a
forall a. a -> a
id, (Continuation m a -> Continuation m a)
-> m (Continuation m a) -> m (Continuation m a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Continuation m a
h Continuation m a -> Continuation m a -> Continuation m a
forall a. Semigroup a => a -> a -> a
<>) (m (Continuation m a) -> m (Continuation m a))
-> (a -> m (Continuation m a)) -> a -> m (Continuation m a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> m (Continuation m a)
g))
  (Rollback Continuation m a
f) <> (Rollback Continuation m a
g) = Continuation m a -> Continuation m a
forall (m :: * -> *) a. Continuation m a -> Continuation m a
Rollback (Continuation m a
f Continuation m a -> Continuation m a -> Continuation m a
forall a. Semigroup a => a -> a -> a
<> Continuation m a
g)
  (Pure a -> a
f) <> (Pure a -> a
g) = (a -> a) -> Continuation m a
forall (m :: * -> *) a. (a -> a) -> Continuation m a
Pure (a -> a
f(a -> a) -> (a -> a) -> a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
.a -> a
g)
  (Pure a -> a
f) <> (Continuation (a -> a
g,a -> m (Continuation m a)
h)) = (a -> a, a -> m (Continuation m a)) -> Continuation m a
forall (m :: * -> *) a.
(a -> a, a -> m (Continuation m a)) -> Continuation m a
Continuation (a -> a
f(a -> a) -> (a -> a) -> a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
.a -> a
g,a -> m (Continuation m a)
h)
  (Continuation (a -> a
f,a -> m (Continuation m a)
g)) <> (Pure a -> a
h) = (a -> a, a -> m (Continuation m a)) -> Continuation m a
forall (m :: * -> *) a.
(a -> a, a -> m (Continuation m a)) -> Continuation m a
Continuation (a -> a
f(a -> a) -> (a -> a) -> a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
.a -> a
h,a -> m (Continuation m a)
g)
  (Pure a -> a
f) <> (Rollback Continuation m a
g) = (a -> a, a -> m (Continuation m a)) -> Continuation m a
forall (m :: * -> *) a.
(a -> a, a -> m (Continuation m a)) -> Continuation m a
Continuation (a -> a
f, m (Continuation m a) -> a -> m (Continuation m a)
forall a b. a -> b -> a
const (Continuation m a -> m (Continuation m a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Continuation m a -> Continuation m a
forall (m :: * -> *) a. Continuation m a -> Continuation m a
Rollback Continuation m a
g)))
  (Rollback Continuation m a
f) <> (Pure a -> a
_) = Continuation m a -> Continuation m a
forall (m :: * -> *) a. Continuation m a -> Continuation m a
Rollback Continuation m a
f


-- | Since combining Continuations homogeneously is an associative operation,
--   and this operation has a unit element (done), Continuations are a 'Monoid'.
instance Monad m => Monoid (Continuation m a) where
  mempty :: Continuation m a
mempty = Continuation m a
forall (m :: * -> *) a. Continuation m a
done


writeUpdate' :: MonadUnliftIO m => (a -> a) -> TVar a -> (a -> m (Continuation m a)) -> m ()
writeUpdate' :: (a -> a) -> TVar a -> (a -> m (Continuation m a)) -> m ()
writeUpdate' a -> a
h TVar a
model a -> m (Continuation m a)
f = do
  a
i <- TVar a -> m a
forall (m :: * -> *) a. MonadIO m => TVar a -> m a
readTVarIO TVar a
model
  Continuation m a
m <- a -> m (Continuation m a)
f (a -> a
h a
i)
  case Continuation m a
m of
    Continuation (a -> a
g,a -> m (Continuation m a)
gs) -> (a -> a) -> TVar a -> (a -> m (Continuation m a)) -> m ()
forall (m :: * -> *) a.
MonadUnliftIO m =>
(a -> a) -> TVar a -> (a -> m (Continuation m a)) -> m ()
writeUpdate' (a -> a
g(a -> a) -> (a -> a) -> a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
.a -> a
h) TVar a
model a -> m (Continuation m a)
gs
    Pure a -> a
g -> STM () -> m ()
forall (m :: * -> *) a. MonadIO m => STM a -> m a
atomically (TVar a -> a -> STM ()
forall a. TVar a -> a -> STM ()
writeTVar TVar a
model (a -> STM ()) -> (a -> a) -> a -> STM ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> a
g (a -> a) -> (a -> a) -> a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> a
h (a -> STM ()) -> STM a -> STM ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< TVar a -> STM a
forall a. TVar a -> STM a
readTVar TVar a
model)
    Rollback Continuation m a
gs -> (a -> a) -> TVar a -> (a -> m (Continuation m a)) -> m ()
forall (m :: * -> *) a.
MonadUnliftIO m =>
(a -> a) -> TVar a -> (a -> m (Continuation m a)) -> m ()
writeUpdate' a -> a
forall a. a -> a
id TVar a
model (m (Continuation m a) -> a -> m (Continuation m a)
forall a b. a -> b -> a
const (Continuation m a -> m (Continuation m a)
forall (m :: * -> *) a. Monad m => a -> m a
return Continuation m a
gs))


-- | Run a Continuation on a state variable. This may update the state.
--   This is a synchronous, non-blocking operation for pure updates,
--   and an asynchronous, non-blocking operation for impure updates.
writeUpdate :: MonadUnliftIO m => TVar a -> Continuation m a -> m ()
writeUpdate :: TVar a -> Continuation m a -> m ()
writeUpdate TVar a
model = \case
  Continuation (a -> a
f,a -> m (Continuation m a)
g) -> m ThreadId -> m ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (m ThreadId -> m ()) -> (m () -> m ThreadId) -> m () -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. m () -> m ThreadId
forall (m :: * -> *). MonadUnliftIO m => m () -> m ThreadId
forkIO (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ (a -> a) -> TVar a -> (a -> m (Continuation m a)) -> m ()
forall (m :: * -> *) a.
MonadUnliftIO m =>
(a -> a) -> TVar a -> (a -> m (Continuation m a)) -> m ()
writeUpdate' a -> a
f TVar a
model a -> m (Continuation m a)
g
  Pure a -> a
f             -> STM () -> m ()
forall (m :: * -> *) a. MonadIO m => STM a -> m a
atomically (TVar a -> a -> STM ()
forall a. TVar a -> a -> STM ()
writeTVar TVar a
model (a -> STM ()) -> (a -> a) -> a -> STM ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> a
f (a -> STM ()) -> STM a -> STM ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< TVar a -> STM a
forall a. TVar a -> STM a
readTVar TVar a
model)
  Rollback Continuation m a
f         -> TVar a -> Continuation m a -> m ()
forall (m :: * -> *) a.
MonadUnliftIO m =>
TVar a -> Continuation m a -> m ()
writeUpdate TVar a
model Continuation m a
f


-- | Execute a fold by watching a state variable and executing the next
--   step of the fold each time it changes.
shouldUpdate :: MonadUnliftIO m => Eq a => (b -> a -> m b) -> b -> TVar a -> m ()
shouldUpdate :: (b -> a -> m b) -> b -> TVar a -> m ()
shouldUpdate b -> a -> m b
sun b
prev TVar a
model = do
  a
i' <- TVar a -> m a
forall (m :: * -> *) a. MonadIO m => TVar a -> m a
readTVarIO TVar a
model
  TVar a
p  <- a -> m (TVar a)
forall (m :: * -> *) a. MonadIO m => a -> m (TVar a)
newTVarIO a
i'
  () () -> m ThreadId -> m ()
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ m () -> m ThreadId
forall (m :: * -> *). MonadUnliftIO m => m () -> m ThreadId
forkIO (b -> TVar a -> m ()
go b
prev TVar a
p)
  where
    go :: b -> TVar a -> m ()
go b
x TVar a
p = do
      a
a <- STM a -> m a
forall (m :: * -> *) a. MonadIO m => STM a -> m a
atomically (STM a -> m a) -> STM a -> m a
forall a b. (a -> b) -> a -> b
$ do
        a
new' <- TVar a -> STM a
forall a. TVar a -> STM a
readTVar TVar a
model
        a
old  <- TVar a -> STM a
forall a. TVar a -> STM a
readTVar TVar a
p
        if a
new' a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
old then STM a
forall a. STM a
retry else a
new' a -> STM () -> STM a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ TVar a -> a -> STM ()
forall a. TVar a -> a -> STM ()
writeTVar TVar a
p a
new'
      b
y <- b -> a -> m b
sun b
x a
a
      b -> TVar a -> m ()
go b
y TVar a
p


-- | A monad transformer for building up a Continuation in a series of steps in a monadic computation
newtype ContinuationT model m a = ContinuationT
  { ContinuationT model m a -> m (a, Continuation m model)
runContinuationT :: m (a, Continuation m model) }


-- | This adds the given Continuation to the Continuation being built up in the monadic context
--   where this function is invoked.
commit :: Monad m => Continuation m model -> ContinuationT model m ()
commit :: Continuation m model -> ContinuationT model m ()
commit = m ((), Continuation m model) -> ContinuationT model m ()
forall model (m :: * -> *) a.
m (a, Continuation m model) -> ContinuationT model m a
ContinuationT (m ((), Continuation m model) -> ContinuationT model m ())
-> (Continuation m model -> m ((), Continuation m model))
-> Continuation m model
-> ContinuationT model m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((), Continuation m model) -> m ((), Continuation m model)
forall (m :: * -> *) a. Monad m => a -> m a
return (((), Continuation m model) -> m ((), Continuation m model))
-> (Continuation m model -> ((), Continuation m model))
-> Continuation m model
-> m ((), Continuation m model)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((),)


-- | This turns a monadic computation to build up a Continuation into the Continuation which it
--   represents. The actions inside the monadic computation will be run when the Continuation
--   is run. The return value of the monadic computation will be discarded.
voidRunContinuationT :: Monad m => ContinuationT model m a -> Continuation m model
voidRunContinuationT :: ContinuationT model m a -> Continuation m model
voidRunContinuationT ContinuationT model m a
m = (model -> model, model -> m (Continuation m model))
-> Continuation m model
forall (m :: * -> *) a.
(a -> a, a -> m (Continuation m a)) -> Continuation m a
Continuation ((model -> model, model -> m (Continuation m model))
 -> Continuation m model)
-> (m (Continuation m model)
    -> (model -> model, model -> m (Continuation m model)))
-> m (Continuation m model)
-> Continuation m model
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (model -> model
forall a. a -> a
id,) ((model -> m (Continuation m model))
 -> (model -> model, model -> m (Continuation m model)))
-> (m (Continuation m model) -> model -> m (Continuation m model))
-> m (Continuation m model)
-> (model -> model, model -> m (Continuation m model))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. m (Continuation m model) -> model -> m (Continuation m model)
forall a b. a -> b -> a
const (m (Continuation m model) -> Continuation m model)
-> m (Continuation m model) -> Continuation m model
forall a b. (a -> b) -> a -> b
$ (a, Continuation m model) -> Continuation m model
forall a b. (a, b) -> b
snd ((a, Continuation m model) -> Continuation m model)
-> m (a, Continuation m model) -> m (Continuation m model)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ContinuationT model m a -> m (a, Continuation m model)
forall model (m :: * -> *) a.
ContinuationT model m a -> m (a, Continuation m model)
runContinuationT ContinuationT model m a
m


-- | This turns a function for building a Continuation in a monadic computation
--   which is parameterized by the current state of the model
--   into a Continuation which reads the current state of the model,
--   runs the resulting monadic computation, and runs the Continuation
--   resulting from that computation.
kleisliT :: Monad m => (model -> ContinuationT model m a) -> Continuation m model
kleisliT :: (model -> ContinuationT model m a) -> Continuation m model
kleisliT model -> ContinuationT model m a
f = (model -> m (Continuation m model)) -> Continuation m model
forall a (m :: * -> *).
(a -> m (Continuation m a)) -> Continuation m a
kleisli ((model -> m (Continuation m model)) -> Continuation m model)
-> (model -> m (Continuation m model)) -> Continuation m model
forall a b. (a -> b) -> a -> b
$ \model
x -> Continuation m model -> m (Continuation m model)
forall (m :: * -> *) a. Monad m => a -> m a
return (Continuation m model -> m (Continuation m model))
-> (ContinuationT model m a -> Continuation m model)
-> ContinuationT model m a
-> m (Continuation m model)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ContinuationT model m a -> Continuation m model
forall (m :: * -> *) model a.
Monad m =>
ContinuationT model m a -> Continuation m model
voidRunContinuationT (ContinuationT model m a -> m (Continuation m model))
-> ContinuationT model m a -> m (Continuation m model)
forall a b. (a -> b) -> a -> b
$ model -> ContinuationT model m a
f model
x


instance Functor m => Functor (ContinuationT model m) where
  fmap :: (a -> b) -> ContinuationT model m a -> ContinuationT model m b
fmap a -> b
f = m (b, Continuation m model) -> ContinuationT model m b
forall model (m :: * -> *) a.
m (a, Continuation m model) -> ContinuationT model m a
ContinuationT (m (b, Continuation m model) -> ContinuationT model m b)
-> (ContinuationT model m a -> m (b, Continuation m model))
-> ContinuationT model m a
-> ContinuationT model m b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((a, Continuation m model) -> (b, Continuation m model))
-> m (a, Continuation m model) -> m (b, Continuation m model)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((a -> b) -> (a, Continuation m model) -> (b, Continuation m model)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
first a -> b
f) (m (a, Continuation m model) -> m (b, Continuation m model))
-> (ContinuationT model m a -> m (a, Continuation m model))
-> ContinuationT model m a
-> m (b, Continuation m model)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ContinuationT model m a -> m (a, Continuation m model)
forall model (m :: * -> *) a.
ContinuationT model m a -> m (a, Continuation m model)
runContinuationT


instance Monad m => Applicative (ContinuationT model m) where
  pure :: a -> ContinuationT model m a
pure = m (a, Continuation m model) -> ContinuationT model m a
forall model (m :: * -> *) a.
m (a, Continuation m model) -> ContinuationT model m a
ContinuationT (m (a, Continuation m model) -> ContinuationT model m a)
-> (a -> m (a, Continuation m model))
-> a
-> ContinuationT model m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a, Continuation m model) -> m (a, Continuation m model)
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((a, Continuation m model) -> m (a, Continuation m model))
-> (a -> (a, Continuation m model))
-> a
-> m (a, Continuation m model)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (, Continuation m model
forall (m :: * -> *) a. Continuation m a
done)

  ContinuationT model m (a -> b)
ft <*> :: ContinuationT model m (a -> b)
-> ContinuationT model m a -> ContinuationT model m b
<*> ContinuationT model m a
xt = m (b, Continuation m model) -> ContinuationT model m b
forall model (m :: * -> *) a.
m (a, Continuation m model) -> ContinuationT model m a
ContinuationT (m (b, Continuation m model) -> ContinuationT model m b)
-> m (b, Continuation m model) -> ContinuationT model m b
forall a b. (a -> b) -> a -> b
$ do
    (a -> b
f, Continuation m model
fc) <- ContinuationT model m (a -> b) -> m (a -> b, Continuation m model)
forall model (m :: * -> *) a.
ContinuationT model m a -> m (a, Continuation m model)
runContinuationT ContinuationT model m (a -> b)
ft
    (a
x, Continuation m model
xc) <- ContinuationT model m a -> m (a, Continuation m model)
forall model (m :: * -> *) a.
ContinuationT model m a -> m (a, Continuation m model)
runContinuationT ContinuationT model m a
xt
    (b, Continuation m model) -> m (b, Continuation m model)
forall (m :: * -> *) a. Monad m => a -> m a
return (a -> b
f a
x, Continuation m model
fc Continuation m model
-> Continuation m model -> Continuation m model
forall a. Semigroup a => a -> a -> a
<> Continuation m model
xc)


instance Monad m => Monad (ContinuationT model m) where
  return :: a -> ContinuationT model m a
return = m (a, Continuation m model) -> ContinuationT model m a
forall model (m :: * -> *) a.
m (a, Continuation m model) -> ContinuationT model m a
ContinuationT (m (a, Continuation m model) -> ContinuationT model m a)
-> (a -> m (a, Continuation m model))
-> a
-> ContinuationT model m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a, Continuation m model) -> m (a, Continuation m model)
forall (m :: * -> *) a. Monad m => a -> m a
return ((a, Continuation m model) -> m (a, Continuation m model))
-> (a -> (a, Continuation m model))
-> a
-> m (a, Continuation m model)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (, Continuation m model
forall (m :: * -> *) a. Continuation m a
done)

  ContinuationT model m a
m >>= :: ContinuationT model m a
-> (a -> ContinuationT model m b) -> ContinuationT model m b
>>= a -> ContinuationT model m b
f = m (b, Continuation m model) -> ContinuationT model m b
forall model (m :: * -> *) a.
m (a, Continuation m model) -> ContinuationT model m a
ContinuationT (m (b, Continuation m model) -> ContinuationT model m b)
-> m (b, Continuation m model) -> ContinuationT model m b
forall a b. (a -> b) -> a -> b
$ do
    (a
x, Continuation m model
g) <- ContinuationT model m a -> m (a, Continuation m model)
forall model (m :: * -> *) a.
ContinuationT model m a -> m (a, Continuation m model)
runContinuationT ContinuationT model m a
m
    (b
y, Continuation m model
h) <- ContinuationT model m b -> m (b, Continuation m model)
forall model (m :: * -> *) a.
ContinuationT model m a -> m (a, Continuation m model)
runContinuationT (a -> ContinuationT model m b
f a
x)
    (b, Continuation m model) -> m (b, Continuation m model)
forall (m :: * -> *) a. Monad m => a -> m a
return (b
y, Continuation m model
g Continuation m model
-> Continuation m model -> Continuation m model
forall a. Semigroup a => a -> a -> a
<> Continuation m model
h)


instance MonadTrans (ContinuationT model) where
  lift :: m a -> ContinuationT model m a
lift = m (a, Continuation m model) -> ContinuationT model m a
forall model (m :: * -> *) a.
m (a, Continuation m model) -> ContinuationT model m a
ContinuationT (m (a, Continuation m model) -> ContinuationT model m a)
-> (m a -> m (a, Continuation m model))
-> m a
-> ContinuationT model m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> (a, Continuation m model))
-> m a -> m (a, Continuation m model)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (, Continuation m model
forall (m :: * -> *) a. Continuation m a
done)


-- | Create an update to a constant value.
constUpdate :: a -> Continuation m a
constUpdate :: a -> Continuation m a
constUpdate = (a -> a) -> Continuation m a
forall a (m :: * -> *). (a -> a) -> Continuation m a
pur ((a -> a) -> Continuation m a)
-> (a -> a -> a) -> a -> Continuation m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> a -> a
forall a b. a -> b -> a
const
{-# INLINE constUpdate #-}