module UniqueLogic.ST.System (
Variable,
globalVariable,
C, doUpdate,
simpleUpdate,
updateIfNew,
updateAndCheck,
Fragile(break),
T,
localVariable,
constant,
assignment2,
assignment3,
Apply, arg, runApply,
solve,
query,
queryForbid,
queryIgnore,
queryVerify,
) where
import qualified Control.Monad.Exception.Synchronous as E
import qualified Control.Monad.Trans.Writer as MW
import qualified Control.Monad.Trans.Class as MT
import qualified UniqueLogic.ST.MonadTrans as UMT
import qualified UniqueLogic.ST.Duplicate as Duplicate
import qualified Data.Foldable as Fold
import Control.Monad.Trans.Writer (WriterT, )
import Control.Monad.Trans.Maybe (MaybeT(MaybeT), runMaybeT, mapMaybeT, )
import Control.Monad.Trans.Identity (IdentityT, )
import Control.Monad.ST (ST, )
import Control.Monad.HT (void, (<=<), )
import Control.Monad (when, liftM2, ap, )
import Control.Applicative (Applicative, pure, (<*>), )
import Data.Functor.Compose (Compose(Compose))
import Data.STRef (STRef, newSTRef, modifySTRef, readSTRef, writeSTRef, )
import Data.Maybe (isNothing, )
import Data.Monoid (Monoid, )
import Prelude hiding (break)
data Variable w s a =
Variable {
forall (w :: (* -> *) -> * -> *) s a.
Variable w s a -> MaybeT (ST s) a -> Update w s
varUpdate :: MaybeT (ST s) a -> Update w s,
forall (w :: (* -> *) -> * -> *) s a.
Variable w s a -> STRef s [Update w s]
dependsRef :: STRef s [Update w s],
forall (w :: (* -> *) -> * -> *) s a.
Variable w s a -> STRef s (Maybe a)
valueRef :: STRef s (Maybe a)
}
type Update w s = UMT.Wrap w (ST s) ()
type Updater w s a =
STRef s [Update w s] -> STRef s (Maybe a) ->
MaybeT (UMT.Wrap w (ST s)) a -> Update w s
type SimpleUpdater w s a =
STRef s [Update w s] -> STRef s (Maybe a) ->
MaybeT (ST s) a -> Update w s
newtype T w s a =
Cons {forall (w :: (* -> *) -> * -> *) s a.
T w s a -> WriterT [STRef s [Update w s]] (ST s) a
run :: WriterT [STRef s [Update w s]] (ST s) a}
instance Functor (T w s) where
fmap :: forall a b. (a -> b) -> T w s a -> T w s b
fmap a -> b
f (Cons WriterT [STRef s [Update w s]] (ST s) a
x) = forall (w :: (* -> *) -> * -> *) s a.
WriterT [STRef s [Update w s]] (ST s) a -> T w s a
Cons (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f WriterT [STRef s [Update w s]] (ST s) a
x)
instance Applicative (T w s) where
pure :: forall a. a -> T w s a
pure = forall (w :: (* -> *) -> * -> *) s a.
WriterT [STRef s [Update w s]] (ST s) a -> T w s a
Cons forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a. Monad m => a -> m a
return
<*> :: forall a b. T w s (a -> b) -> T w s a -> T w s b
(<*>) = forall (m :: * -> *) a b. Monad m => m (a -> b) -> m a -> m b
ap
instance Monad (T w s) where
return :: forall a. a -> T w s a
return = forall (f :: * -> *) a. Applicative f => a -> f a
pure
Cons WriterT [STRef s [Update w s]] (ST s) a
x >>= :: forall a b. T w s a -> (a -> T w s b) -> T w s b
>>= a -> T w s b
k = forall (w :: (* -> *) -> * -> *) s a.
WriterT [STRef s [Update w s]] (ST s) a -> T w s a
Cons forall a b. (a -> b) -> a -> b
$ forall (w :: (* -> *) -> * -> *) s a.
T w s a -> WriterT [STRef s [Update w s]] (ST s) a
run forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> T w s b
k forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< WriterT [STRef s [Update w s]] (ST s) a
x
lift :: ST s a -> T w s a
lift :: forall s a (w :: (* -> *) -> * -> *). ST s a -> T w s a
lift = forall (w :: (* -> *) -> * -> *) s a.
WriterT [STRef s [Update w s]] (ST s) a -> T w s a
Cons forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
MT.lift
globalVariable ::
(UMT.C w, Duplicate.C a) =>
SimpleUpdater w s a -> ST s (Variable w s a)
globalVariable :: forall (w :: (* -> *) -> * -> *) a s.
(C w, C a) =>
SimpleUpdater w s a -> ST s (Variable w s a)
globalVariable SimpleUpdater w s a
update = forall s (w :: (* -> *) -> * -> *) a.
(STRef s [Update w s]
-> STRef s (Maybe a) -> MaybeT (ST s) a -> Update w s)
-> Maybe a -> ST s (Variable w s a)
object SimpleUpdater w s a
update forall a. Maybe a
Nothing
localVariable :: (C w, Duplicate.C a) => T w s (Variable w s a)
localVariable :: forall (w :: (* -> *) -> * -> *) a s.
(C w, C a) =>
T w s (Variable w s a)
localVariable = forall s a (w :: (* -> *) -> * -> *). ST s a -> T w s a
lift forall a b. (a -> b) -> a -> b
$ forall (w :: (* -> *) -> * -> *) a s.
(C w, C a) =>
SimpleUpdater w s a -> ST s (Variable w s a)
globalVariable forall (w :: (* -> *) -> * -> *) a s.
(C w, C a) =>
SimpleUpdater w s a
simpleUpdate
constant ::
(C w, Duplicate.C a) =>
a -> T w s (Variable w s a)
constant :: forall (w :: (* -> *) -> * -> *) a s.
(C w, C a) =>
a -> T w s (Variable w s a)
constant a
a =
do Variable w s a
v <- forall s a (w :: (* -> *) -> * -> *). ST s a -> T w s a
lift forall a b. (a -> b) -> a -> b
$ forall s (w :: (* -> *) -> * -> *) a.
(STRef s [Update w s]
-> STRef s (Maybe a) -> MaybeT (ST s) a -> Update w s)
-> Maybe a -> ST s (Variable w s a)
object forall (w :: (* -> *) -> * -> *) a s.
(C w, C a) =>
SimpleUpdater w s a
simpleUpdate forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just a
a
forall (w :: (* -> *) -> * -> *) s a.
WriterT [STRef s [Update w s]] (ST s) a -> T w s a
Cons forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) w. Monad m => w -> WriterT w m ()
MW.tell [forall (w :: (* -> *) -> * -> *) s a.
Variable w s a -> STRef s [Update w s]
dependsRef Variable w s a
v]
forall (m :: * -> *) a. Monad m => a -> m a
return Variable w s a
v
object ::
(STRef s [Update w s] -> STRef s (Maybe a) ->
MaybeT (ST s) a -> Update w s) ->
Maybe a -> ST s (Variable w s a)
object :: forall s (w :: (* -> *) -> * -> *) a.
(STRef s [Update w s]
-> STRef s (Maybe a) -> MaybeT (ST s) a -> Update w s)
-> Maybe a -> ST s (Variable w s a)
object STRef s [Update w s]
-> STRef s (Maybe a) -> MaybeT (ST s) a -> Update w s
updater Maybe a
ma = do
STRef s [Update w s]
al <- forall a s. a -> ST s (STRef s a)
newSTRef []
STRef s (Maybe a)
av <- forall a s. a -> ST s (STRef s a)
newSTRef Maybe a
ma
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall (w :: (* -> *) -> * -> *) s a.
(MaybeT (ST s) a -> Update w s)
-> STRef s [Update w s] -> STRef s (Maybe a) -> Variable w s a
Variable (STRef s [Update w s]
-> STRef s (Maybe a) -> MaybeT (ST s) a -> Update w s
updater STRef s [Update w s]
al STRef s (Maybe a)
av) STRef s [Update w s]
al STRef s (Maybe a)
av
resolve ::
UMT.C w =>
STRef s [Update w s] -> Update w s
resolve :: forall (w :: (* -> *) -> * -> *) s.
C w =>
STRef s [Update w s] -> Update w s
resolve =
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, Monad m) =>
t (m a) -> m ()
sequence_ forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(C t, Monad m) =>
m a -> Wrap t m a
UMT.lift forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. STRef s a -> ST s a
readSTRef
solve ::
UMT.C w =>
T w s a -> w (ST s) a
solve :: forall (w :: (* -> *) -> * -> *) s a. C w => T w s a -> w (ST s) a
solve (Cons WriterT [STRef s [Update w s]] (ST s) a
m) = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
Wrap t m a -> t m a
UMT.unwrap forall a b. (a -> b) -> a -> b
$ do
(a
a,[STRef s [Update w s]]
w) <- forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(C t, Monad m) =>
m a -> Wrap t m a
UMT.lift forall a b. (a -> b) -> a -> b
$ forall w (m :: * -> *) a. WriterT w m a -> m (a, w)
MW.runWriterT WriterT [STRef s [Update w s]] (ST s) a
m
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ forall (w :: (* -> *) -> * -> *) s.
C w =>
STRef s [Update w s] -> Update w s
resolve [STRef s [Update w s]]
w
forall (m :: * -> *) a. Monad m => a -> m a
return a
a
query :: Variable w s a -> ST s (Maybe a)
query :: forall (w :: (* -> *) -> * -> *) s a.
Variable w s a -> ST s (Maybe a)
query = forall s a. STRef s a -> ST s a
readSTRef forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (w :: (* -> *) -> * -> *) s a.
Variable w s a -> STRef s (Maybe a)
valueRef
queryForbid :: Variable w s (Duplicate.Forbid a) -> ST s (Maybe a)
queryForbid :: forall (w :: (* -> *) -> * -> *) s a.
Variable w s (Forbid a) -> ST s (Maybe a)
queryForbid = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\(Duplicate.Forbid a
a) -> a
a)) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (w :: (* -> *) -> * -> *) s a.
Variable w s a -> ST s (Maybe a)
query
queryIgnore :: Variable w s (Duplicate.Ignore a) -> ST s (Maybe a)
queryIgnore :: forall (w :: (* -> *) -> * -> *) s a.
Variable w s (Ignore a) -> ST s (Maybe a)
queryIgnore = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\(Duplicate.Ignore a
a) -> a
a)) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (w :: (* -> *) -> * -> *) s a.
Variable w s a -> ST s (Maybe a)
query
queryVerify :: Variable w s (Duplicate.Verify a) -> ST s (Maybe a)
queryVerify :: forall (w :: (* -> *) -> * -> *) s a.
Variable w s (Verify a) -> ST s (Maybe a)
queryVerify = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\(Duplicate.Verify a
a) -> a
a)) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (w :: (* -> *) -> * -> *) s a.
Variable w s a -> ST s (Maybe a)
query
updateIfNew :: (C w, Duplicate.C a) => Updater w s a
updateIfNew :: forall (w :: (* -> *) -> * -> *) a s. (C w, C a) => Updater w s a
updateIfNew STRef s [Update w s]
al STRef s (Maybe a)
av MaybeT (Wrap w (ST s)) a
act = do
Maybe a
as <- forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(C t, Monad m) =>
m a -> Wrap t m a
UMT.lift forall a b. (a -> b) -> a -> b
$ forall s a. STRef s a -> ST s a
readSTRef STRef s (Maybe a)
av
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (forall a. Maybe a -> Bool
isNothing Maybe a
as) forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. Monad m => m a -> m ()
void forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. MaybeT m a -> m (Maybe a)
runMaybeT forall a b. (a -> b) -> a -> b
$ do
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
MT.lift forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(C t, Monad m) =>
m a -> Wrap t m a
UMT.lift forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. STRef s a -> a -> ST s ()
writeSTRef STRef s (Maybe a)
av forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> Maybe a
Just forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< MaybeT (Wrap w (ST s)) a
act
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
MT.lift forall a b. (a -> b) -> a -> b
$ forall (w :: (* -> *) -> * -> *) s.
C w =>
STRef s [Update w s] -> Update w s
resolve STRef s [Update w s]
al
class Inconsistency e where
inconsistency :: e
instance
Inconsistency e =>
Fragile (E.ExceptionalT e) where
break :: forall (m :: * -> *) a. Monad m => Wrap (ExceptionalT e) m a
break =
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
t m a -> Wrap t m a
UMT.wrap forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) e a. Monad m => e -> ExceptionalT e m a
E.throwT forall e. Inconsistency e => e
inconsistency
class C t => Fragile t where
break :: Monad m => UMT.Wrap t m a
updateAndCheck ::
(UMT.C w, Duplicate.C a) =>
(a -> a -> UMT.Wrap w (ST s) ()) ->
Updater w s a
updateAndCheck :: forall (w :: (* -> *) -> * -> *) a s.
(C w, C a) =>
(a -> a -> Wrap w (ST s) ()) -> Updater w s a
updateAndCheck a -> a -> Wrap w (ST s) ()
customBreak STRef s [Wrap w (ST s) ()]
al STRef s (Maybe a)
av MaybeT (Wrap w (ST s)) a
act = do
Maybe a
maold <- forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(C t, Monad m) =>
m a -> Wrap t m a
UMT.lift forall a b. (a -> b) -> a -> b
$ forall s a. STRef s a -> ST s a
readSTRef STRef s (Maybe a)
av
Maybe a
manew <- forall (m :: * -> *) a. MaybeT m a -> m (Maybe a)
runMaybeT MaybeT (Wrap w (ST s)) a
act
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
Fold.forM_ Maybe a
manew forall a b. (a -> b) -> a -> b
$ \a
anew -> do
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(C t, Monad m) =>
m a -> Wrap t m a
UMT.lift forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. STRef s a -> a -> ST s ()
writeSTRef STRef s (Maybe a)
av forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ a
anew
case Maybe a
maold of
Just a
aold ->
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool -> Bool
not forall a b. (a -> b) -> a -> b
$ forall a. C a => a -> a -> Bool
Duplicate.accept a
aold a
anew) forall a b. (a -> b) -> a -> b
$
a -> a -> Wrap w (ST s) ()
customBreak a
aold a
anew
Maybe a
Nothing -> forall (w :: (* -> *) -> * -> *) s.
C w =>
STRef s [Update w s] -> Update w s
resolve STRef s [Wrap w (ST s) ()]
al
class UMT.C w => C w where
doUpdate :: (Duplicate.C a) => Updater w s a
instance C IdentityT where
doUpdate :: forall a s. C a => Updater IdentityT s a
doUpdate = forall (w :: (* -> *) -> * -> *) a s. (C w, C a) => Updater w s a
updateIfNew
instance (Monoid w) => C (MW.WriterT w) where
doUpdate :: forall a s. C a => Updater (WriterT w) s a
doUpdate = forall (w :: (* -> *) -> * -> *) a s. (C w, C a) => Updater w s a
updateIfNew
instance (Inconsistency e) => C (E.ExceptionalT e) where
doUpdate :: forall a s. C a => Updater (ExceptionalT e) s a
doUpdate = forall (w :: (* -> *) -> * -> *) a s.
(C w, C a) =>
(a -> a -> Wrap w (ST s) ()) -> Updater w s a
updateAndCheck forall a b. (a -> b) -> a -> b
$ \a
_ a
_ -> forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(Fragile t, Monad m) =>
Wrap t m a
break
simpleUpdate :: (C w, Duplicate.C a) => SimpleUpdater w s a
simpleUpdate :: forall (w :: (* -> *) -> * -> *) a s.
(C w, C a) =>
SimpleUpdater w s a
simpleUpdate STRef s [Update w s]
al STRef s (Maybe a)
av = forall (w :: (* -> *) -> * -> *) a s. (C w, C a) => Updater w s a
doUpdate STRef s [Update w s]
al STRef s (Maybe a)
av forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a (n :: * -> *) b.
(m (Maybe a) -> n (Maybe b)) -> MaybeT m a -> MaybeT n b
mapMaybeT forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(C t, Monad m) =>
m a -> Wrap t m a
UMT.lift
readSTRefM :: STRef s (Maybe a) -> MaybeT (ST s) a
readSTRefM :: forall s a. STRef s (Maybe a) -> MaybeT (ST s) a
readSTRefM = forall (m :: * -> *) a. m (Maybe a) -> MaybeT m a
MaybeT forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. STRef s a -> ST s a
readSTRef
assignment2 ::
UMT.C w =>
(a -> b) ->
Variable w s a -> Variable w s b ->
T w s ()
assignment2 :: forall (w :: (* -> *) -> * -> *) a b s.
C w =>
(a -> b) -> Variable w s a -> Variable w s b -> T w s ()
assignment2 a -> b
f (Variable MaybeT (ST s) a -> Update w s
_ STRef s [Update w s]
al STRef s (Maybe a)
av) Variable w s b
b =
let update :: Update w s
update =
forall (w :: (* -> *) -> * -> *) s a.
Variable w s a -> MaybeT (ST s) a -> Update w s
varUpdate Variable w s b
b forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f forall a b. (a -> b) -> a -> b
$ forall s a. STRef s (Maybe a) -> MaybeT (ST s) a
readSTRefM STRef s (Maybe a)
av
in forall s a (w :: (* -> *) -> * -> *). ST s a -> T w s a
lift forall a b. (a -> b) -> a -> b
$
forall s a. STRef s a -> (a -> a) -> ST s ()
modifySTRef STRef s [Update w s]
al (Update w s
update forall a. a -> [a] -> [a]
:)
assignment3 ::
UMT.C w =>
(a -> b -> c) ->
Variable w s a -> Variable w s b -> Variable w s c ->
T w s ()
assignment3 :: forall (w :: (* -> *) -> * -> *) a b c s.
C w =>
(a -> b -> c)
-> Variable w s a -> Variable w s b -> Variable w s c -> T w s ()
assignment3 a -> b -> c
f (Variable MaybeT (ST s) a -> Update w s
_ STRef s [Update w s]
al STRef s (Maybe a)
av) (Variable MaybeT (ST s) b -> Update w s
_ STRef s [Update w s]
bl STRef s (Maybe b)
bv) Variable w s c
c =
let update :: Update w s
update =
forall (w :: (* -> *) -> * -> *) s a.
Variable w s a -> MaybeT (ST s) a -> Update w s
varUpdate Variable w s c
c forall a b. (a -> b) -> a -> b
$
forall (m :: * -> *) a1 a2 r.
Monad m =>
(a1 -> a2 -> r) -> m a1 -> m a2 -> m r
liftM2 a -> b -> c
f (forall s a. STRef s (Maybe a) -> MaybeT (ST s) a
readSTRefM STRef s (Maybe a)
av) (forall s a. STRef s (Maybe a) -> MaybeT (ST s) a
readSTRefM STRef s (Maybe b)
bv)
in forall s a (w :: (* -> *) -> * -> *). ST s a -> T w s a
lift forall a b. (a -> b) -> a -> b
$
forall s a. STRef s a -> (a -> a) -> ST s ()
modifySTRef STRef s [Update w s]
al (Update w s
update forall a. a -> [a] -> [a]
:) forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
forall s a. STRef s a -> (a -> a) -> ST s ()
modifySTRef STRef s [Update w s]
bl (Update w s
update forall a. a -> [a] -> [a]
:)
newtype Apply w s a =
Apply (Compose (MW.Writer [STRef s [Update w s]]) (MaybeT (ST s)) a)
arg :: Variable w s a -> Apply w s a
arg :: forall (w :: (* -> *) -> * -> *) s a. Variable w s a -> Apply w s a
arg (Variable MaybeT (ST s) a -> Update w s
_update STRef s [Update w s]
al STRef s (Maybe a)
av) =
forall (w :: (* -> *) -> * -> *) s a.
Compose (Writer [STRef s [Update w s]]) (MaybeT (ST s)) a
-> Apply w s a
Apply forall a b. (a -> b) -> a -> b
$ forall {k} {k1} (f :: k -> *) (g :: k1 -> k) (a :: k1).
f (g a) -> Compose f g a
Compose forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a w. Monad m => (a, w) -> WriterT w m a
MW.writer (forall (m :: * -> *) a. m (Maybe a) -> MaybeT m a
MaybeT forall a b. (a -> b) -> a -> b
$ forall s a. STRef s a -> ST s a
readSTRef STRef s (Maybe a)
av, [STRef s [Update w s]
al])
instance Functor (Apply w s) where
fmap :: forall a b. (a -> b) -> Apply w s a -> Apply w s b
fmap a -> b
f (Apply Compose (Writer [STRef s [Update w s]]) (MaybeT (ST s)) a
a) = forall (w :: (* -> *) -> * -> *) s a.
Compose (Writer [STRef s [Update w s]]) (MaybeT (ST s)) a
-> Apply w s a
Apply forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f Compose (Writer [STRef s [Update w s]]) (MaybeT (ST s)) a
a
instance Applicative (Apply w s) where
pure :: forall a. a -> Apply w s a
pure a
a = forall (w :: (* -> *) -> * -> *) s a.
Compose (Writer [STRef s [Update w s]]) (MaybeT (ST s)) a
-> Apply w s a
Apply forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a. Applicative f => a -> f a
pure a
a
Apply Compose (Writer [STRef s [Update w s]]) (MaybeT (ST s)) (a -> b)
f <*> :: forall a b. Apply w s (a -> b) -> Apply w s a -> Apply w s b
<*> Apply Compose (Writer [STRef s [Update w s]]) (MaybeT (ST s)) a
a = forall (w :: (* -> *) -> * -> *) s a.
Compose (Writer [STRef s [Update w s]]) (MaybeT (ST s)) a
-> Apply w s a
Apply forall a b. (a -> b) -> a -> b
$ Compose (Writer [STRef s [Update w s]]) (MaybeT (ST s)) (a -> b)
f forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Compose (Writer [STRef s [Update w s]]) (MaybeT (ST s)) a
a
runApply ::
UMT.C w =>
Apply w s a -> Variable w s a -> T w s ()
runApply :: forall (w :: (* -> *) -> * -> *) s a.
C w =>
Apply w s a -> Variable w s a -> T w s ()
runApply (Apply (Compose Writer [STRef s [Update w s]] (MaybeT (ST s) a)
w)) Variable w s a
a =
case forall w a. Writer w a -> (a, w)
MW.runWriter Writer [STRef s [Update w s]] (MaybeT (ST s) a)
w of
(MaybeT (ST s) a
f, [STRef s [Update w s]]
refs) ->
forall s a (w :: (* -> *) -> * -> *). ST s a -> T w s a
lift forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
Fold.forM_ [STRef s [Update w s]]
refs forall a b. (a -> b) -> a -> b
$ forall a b c. (a -> b -> c) -> b -> a -> c
flip forall s a. STRef s a -> (a -> a) -> ST s ()
modifySTRef (forall (w :: (* -> *) -> * -> *) s a.
Variable w s a -> MaybeT (ST s) a -> Update w s
varUpdate Variable w s a
a MaybeT (ST s) a
f forall a. a -> [a] -> [a]
:)