{-# 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 :: (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; b -> ReactionM s o b
forall (m :: * -> *) a. Monad m => a -> m a
return (a -> b
f a
x)

instance Applicative (ReactionM s o) where
  pure :: a -> ReactionM s o a
pure = a -> ReactionM s o a
forall (m :: * -> *) a. Monad m => a -> m a
return
  <*> :: ReactionM s o (a -> b) -> ReactionM s o a -> ReactionM s o 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 :: a -> ReactionM s o a
return a
x = (s -> [o] -> Maybe (s, [o], a)) -> ReactionM s o a
forall s o a. (s -> [o] -> Maybe (s, [o], a)) -> ReactionM s o a
M (\s
s [o]
o->(s, [o], a) -> Maybe (s, [o], a)
forall a. a -> Maybe a
Just (s
s,[o]
o,a
x))
  (M s -> [o] -> Maybe (s, [o], a)
f1) >>= :: ReactionM s o a -> (a -> ReactionM s o b) -> ReactionM s o b
>>= a -> ReactionM s o b
xm2 =
    (s -> [o] -> Maybe (s, [o], b)) -> ReactionM s o b
forall s o a. (s -> [o] -> Maybe (s, [o], a)) -> ReactionM s o a
M ((s -> [o] -> Maybe (s, [o], b)) -> ReactionM s o b)
-> (s -> [o] -> Maybe (s, [o], b)) -> ReactionM s o b
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 Maybe (s, [o], a) -> Bool
forall a. Maybe a -> Bool
isJust Maybe (s, [o], a)
r1 Bool -> Bool -> Bool
&& Maybe (s, [o], b) -> Bool
forall a. Maybe a -> Bool
isJust Maybe (s, [o], b)
r2
         then (s, [o], b) -> Maybe (s, [o], b)
forall a. a -> Maybe a
Just (s
s2,[o]
o1,b
x2)
	 else Maybe (s, [o], b)
forall a. Maybe a
Nothing
#if MIN_VERSION_base(4,12,0)
instance MonadFail (ReactionM s o) where
#endif
  fail :: String -> ReactionM s o a
fail String
_ = ReactionM s o a
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 :: a -> ReactionM a a ()
put a
o = (a -> [a] -> Maybe (a, [a], ())) -> ReactionM a a ()
forall s o a. (s -> [o] -> Maybe (s, [o], a)) -> ReactionM s o a
M ((a -> [a] -> Maybe (a, [a], ())) -> ReactionM a a ())
-> (a -> [a] -> Maybe (a, [a], ())) -> ReactionM a a ()
forall a b. (a -> b) -> a -> b
$ \ a
s [a]
os -> (a, [a], ()) -> Maybe (a, [a], ())
forall a. a -> Maybe a
Just (a
s,a
oa -> [a] -> [a]
forall a. a -> [a] -> [a]
:[a]
os,())
set :: s -> ReactionM s o ()
set s
s = (s -> [o] -> Maybe (s, [o], ())) -> ReactionM s o ()
forall s o a. (s -> [o] -> Maybe (s, [o], a)) -> ReactionM s o a
M ((s -> [o] -> Maybe (s, [o], ())) -> ReactionM s o ())
-> (s -> [o] -> Maybe (s, [o], ())) -> ReactionM s o ()
forall a b. (a -> b) -> a -> b
$ \ s
_ [o]
os -> (s, [o], ()) -> Maybe (s, [o], ())
forall a. a -> Maybe a
Just (s
s,[o]
os,())
get :: ReactionM a o a
get = (a -> [o] -> Maybe (a, [o], a)) -> ReactionM a o a
forall s o a. (s -> [o] -> Maybe (s, [o], a)) -> ReactionM s o a
M ((a -> [o] -> Maybe (a, [o], a)) -> ReactionM a o a)
-> (a -> [o] -> Maybe (a, [o], a)) -> ReactionM a o a
forall a b. (a -> b) -> a -> b
$ \ a
s [o]
os -> (a, [o], a) -> Maybe (a, [o], a)
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 (a -> b) -> ReactionM a o a -> ReactionM a o b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ReactionM a o a
forall a o. ReactionM a o a
get
update :: (t -> t) -> ReactionM t o ()
update t -> t
f = (t -> [o] -> Maybe (t, [o], ())) -> ReactionM t o ()
forall s o a. (s -> [o] -> Maybe (s, [o], a)) -> ReactionM s o a
M ((t -> [o] -> Maybe (t, [o], ())) -> ReactionM t o ())
-> (t -> [o] -> Maybe (t, [o], ())) -> ReactionM t o ()
forall a b. (a -> b) -> a -> b
$ \ t
s [o]
os -> (t, [o], ()) -> Maybe (t, [o], ())
forall a. a -> Maybe a
Just (t -> t
f t
s,[o]
os,())

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

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