Applicative and Monad definitions of Step.

1 files changed, 22 insertions, 5 deletions

diff --git a/Spear/Step.hs b/Spear/Step.hs
index a860247..43c3415 100644
--- a/Spear/Step.hs
+++ b/Spear/Step.hs
@@ -37,21 +37,34 @@ type Elapsed = Float
 type Dt = Float
 
 -- | A step function.
-newtype Step state events a b = Step
-  { runStep :: Elapsed -> Dt -> state -> events -> a -> (b, Step state events a b)
+newtype Step state events input output = Step
+  { runStep :: Elapsed -> Dt -> state -> events -> input -> (output, Step state events input output)
   }
 
-instance Functor (Step s e a) where
+instance Functor (Step state events input) where
   fmap f (Step s1) = Step $ \elapsed dt g e x ->
     let (a, s') = s1 elapsed dt g e x
      in (f a, fmap f s')
 
-instance Semigroup (Step s e a a) where
+instance Semigroup (Step state events input input) where
   (<>) = (.>)
 
-instance Monoid (Step s e a a) where
+instance Monoid (Step state events input input) where
   mempty = sid
 
+instance Applicative (Step state events input) where
+  pure = sreturn
+  fStep <*> inputStep = Step $ \t dt state events input ->
+    let (a, inputStep') = runStep inputStep t dt state events input
+        (f, fStep')     = runStep fStep     t dt state events input
+    in (f a, fStep' <*> inputStep')
+
+instance Monad (Step state events input) where
+  return = pure
+  inputStep >>= f = Step $ \t dt state events input ->
+    let (a, inputStep') = runStep inputStep t dt state events input
+    in runStep (f a) t dt state events input
+
 -- | Construct a step from a function.
 step :: (Elapsed -> Dt -> s -> e -> a -> (b, Step s e a b)) -> Step s e a b
 step = Step
@@ -64,6 +77,10 @@ sid = Step $ \_ _ _ _ a -> (a, sid)
 spure :: (a -> b) -> Step s e a b
 spure f = Step $ \_ _ _ _ x -> (f x, spure f)
 
+-- | Construct a step that returns a constant value.
+sreturn :: b -> Step s e a b
+sreturn b = Step $ \_ _ _ _ _ -> (b, sreturn b)
+
 -- | The step that returns the first component in the tuple.
 sfst :: Step s e (a, b) a
 sfst = spure fst