{-# LANGUAGE CPP #-}
module ReactionM where
import Data.Maybe(isJust)
import Control.Applicative
import Control.Monad(ap)
#if MIN_VERSION_base(4,12,0)
#if MIN_VERSION_base(4,13,0)
#else
import Control.Monad.Fail
#endif
#endif

-- | Writer & State & Exception monad
newtype ReactionM s o a = M (s -> [o] -> Maybe (s,[o],a))

instance Functor (ReactionM s o) where
  fmap :: forall a b. (a -> b) -> ReactionM s o a -> ReactionM s o b
fmap a -> b
f ReactionM s o a
m = do a
x <- ReactionM s o a
m; forall (m :: * -> *) a. Monad m => a -> m a
return (a -> b
f a
x)

instance Applicative (ReactionM s o) where
  pure :: forall a. a -> ReactionM s o a
pure = forall (m :: * -> *) a. Monad m => a -> m a
return
  <*> :: forall a b.
ReactionM s o (a -> b) -> ReactionM s o a -> ReactionM s o b
(<*>) = forall (m :: * -> *) a b. Monad m => m (a -> b) -> m a -> m b
ap

instance Monad (ReactionM s o) where
  return :: forall a. a -> ReactionM s o a
return a
x = forall s o a. (s -> [o] -> Maybe (s, [o], a)) -> ReactionM s o a
M (\s
s [o]
o->forall a. a -> Maybe a
Just (s
s,[o]
o,a
x))
  (M s -> [o] -> Maybe (s, [o], a)
f1) >>= :: forall a b.
ReactionM s o a -> (a -> ReactionM s o b) -> ReactionM s o b
>>= a -> ReactionM s o b
xm2 =
    forall s o a. (s -> [o] -> Maybe (s, [o], a)) -> ReactionM s o a
M forall a b. (a -> b) -> a -> b
$ \ s
s0 [o]
o0 ->
      let r1 :: Maybe (s, [o], a)
r1 = s -> [o] -> Maybe (s, [o], a)
f1 s
s0 [o]
o2
          Just (s
s1,[o]
o1,a
x1) = Maybe (s, [o], a)
r1
          M s -> [o] -> Maybe (s, [o], b)
f2 = a -> ReactionM s o b
xm2 a
x1
	  r2 :: Maybe (s, [o], b)
r2 = s -> [o] -> Maybe (s, [o], b)
f2 s
s1 [o]
o0
	  Just (s
s2,[o]
o2,b
x2) = Maybe (s, [o], b)
r2
      in if forall a. Maybe a -> Bool
isJust Maybe (s, [o], a)
r1 Bool -> Bool -> Bool
&& forall a. Maybe a -> Bool
isJust Maybe (s, [o], b)
r2
         then forall a. a -> Maybe a
Just (s
s2,[o]
o1,b
x2)
	 else forall a. Maybe a
Nothing
#if MIN_VERSION_base(4,12,0)
instance MonadFail (ReactionM s o) where
#endif
  fail :: forall a. String -> ReactionM s o a
fail String
_ = forall {s} {o} {a}. ReactionM s o a
rfail

react :: ReactionM a o a -> a -> (a, [o])
react (M a -> [o] -> Maybe (a, [o], a)
f) a
s0 = case a -> [o] -> Maybe (a, [o], a)
f a
s0 [] of Just (a
s,[o]
o,a
_) -> (a
s,[o]
o); Maybe (a, [o], a)
_ -> (a
s0,[])
put :: o -> ReactionM s o ()
put o
o = forall s o a. (s -> [o] -> Maybe (s, [o], a)) -> ReactionM s o a
M forall a b. (a -> b) -> a -> b
$ \ s
s [o]
os -> forall a. a -> Maybe a
Just (s
s,o
oforall a. a -> [a] -> [a]
:[o]
os,())
set :: s -> ReactionM s o ()
set s
s = forall s o a. (s -> [o] -> Maybe (s, [o], a)) -> ReactionM s o a
M forall a b. (a -> b) -> a -> b
$ \ s
_ [o]
os -> forall a. a -> Maybe a
Just (s
s,[o]
os,())
get :: ReactionM a o a
get = forall s o a. (s -> [o] -> Maybe (s, [o], a)) -> ReactionM s o a
M forall a b. (a -> b) -> a -> b
$ \ a
s [o]
os -> forall a. a -> Maybe a
Just (a
s,[o]
os,a
s)
field :: (a -> b) -> ReactionM a o b
field a -> b
f = a -> b
f forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall {a} {o}. ReactionM a o a
get
update :: (t -> t) -> ReactionM t o ()
update t -> t
f = forall s o a. (s -> [o] -> Maybe (s, [o], a)) -> ReactionM s o a
M forall a b. (a -> b) -> a -> b
$ \ t
s [o]
os -> forall a. a -> Maybe a
Just (t -> t
f t
s,[o]
os,())

rfail :: ReactionM s o a
rfail = forall s o a. (s -> [o] -> Maybe (s, [o], a)) -> ReactionM s o a
M forall a b. (a -> b) -> a -> b
$ \ s
_ [o]
_ -> forall a. Maybe a
Nothing

lift :: Maybe a -> ReactionM s o a
lift Maybe a
m = forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall {s} {o} {a}. ReactionM s o a
rfail forall (m :: * -> *) a. Monad m => a -> m a
return Maybe a
m
nop :: forall (m :: * -> *). Monad m => m ()
nop = forall (m :: * -> *) a. Monad m => a -> m a
return ()
nop :: Monad m => m ()