module UniqueLogic.ST.System (
   -- * Preparation
   Variable,
   globalVariable,
   -- * Handle duplicates
   C, doUpdate,
   simpleUpdate, -- should be private in future
   updateIfNew, -- should be private or with special type
   updateAndCheck,
   Fragile(break),
   -- * Posing statements
   T,
   localVariable,
   constant,
   assignment2,
   assignment3,
   Apply, arg, runApply,
   -- * Solution
   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)


{- |
This function allows to generalize 'assignment2' and 'assignment3' to more arguments.
You could achieve the same with nested applications of @assignment3 (,)@.
-}
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]
:)