diff options
| -rw-r--r-- | Spear/Step.hs | 27 |
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 | |||
| 37 | type Dt = Float | 37 | type Dt = Float |
| 38 | 38 | ||
| 39 | -- | A step function. | 39 | -- | A step function. |
| 40 | newtype Step state events a b = Step | 40 | newtype Step state events input output = Step |
| 41 | { runStep :: Elapsed -> Dt -> state -> events -> a -> (b, Step state events a b) | 41 | { runStep :: Elapsed -> Dt -> state -> events -> input -> (output, Step state events input output) |
| 42 | } | 42 | } |
| 43 | 43 | ||
| 44 | instance Functor (Step s e a) where | 44 | instance Functor (Step state events input) where |
| 45 | fmap f (Step s1) = Step $ \elapsed dt g e x -> | 45 | fmap f (Step s1) = Step $ \elapsed dt g e x -> |
| 46 | let (a, s') = s1 elapsed dt g e x | 46 | let (a, s') = s1 elapsed dt g e x |
| 47 | in (f a, fmap f s') | 47 | in (f a, fmap f s') |
| 48 | 48 | ||
| 49 | instance Semigroup (Step s e a a) where | 49 | instance Semigroup (Step state events input input) where |
| 50 | (<>) = (.>) | 50 | (<>) = (.>) |
| 51 | 51 | ||
| 52 | instance Monoid (Step s e a a) where | 52 | instance Monoid (Step state events input input) where |
| 53 | mempty = sid | 53 | mempty = sid |
| 54 | 54 | ||
| 55 | instance Applicative (Step state events input) where | ||
| 56 | pure = sreturn | ||
| 57 | fStep <*> inputStep = Step $ \t dt state events input -> | ||
| 58 | let (a, inputStep') = runStep inputStep t dt state events input | ||
| 59 | (f, fStep') = runStep fStep t dt state events input | ||
| 60 | in (f a, fStep' <*> inputStep') | ||
| 61 | |||
| 62 | instance Monad (Step state events input) where | ||
| 63 | return = pure | ||
| 64 | inputStep >>= f = Step $ \t dt state events input -> | ||
| 65 | let (a, inputStep') = runStep inputStep t dt state events input | ||
| 66 | in runStep (f a) t dt state events input | ||
| 67 | |||
| 55 | -- | Construct a step from a function. | 68 | -- | Construct a step from a function. |
| 56 | step :: (Elapsed -> Dt -> s -> e -> a -> (b, Step s e a b)) -> Step s e a b | 69 | step :: (Elapsed -> Dt -> s -> e -> a -> (b, Step s e a b)) -> Step s e a b |
| 57 | step = Step | 70 | step = Step |
| @@ -64,6 +77,10 @@ sid = Step $ \_ _ _ _ a -> (a, sid) | |||
| 64 | spure :: (a -> b) -> Step s e a b | 77 | spure :: (a -> b) -> Step s e a b |
| 65 | spure f = Step $ \_ _ _ _ x -> (f x, spure f) | 78 | spure f = Step $ \_ _ _ _ x -> (f x, spure f) |
| 66 | 79 | ||
| 80 | -- | Construct a step that returns a constant value. | ||
| 81 | sreturn :: b -> Step s e a b | ||
| 82 | sreturn b = Step $ \_ _ _ _ _ -> (b, sreturn b) | ||
| 83 | |||
| 67 | -- | The step that returns the first component in the tuple. | 84 | -- | The step that returns the first component in the tuple. |
| 68 | sfst :: Step s e (a, b) a | 85 | sfst :: Step s e (a, b) a |
| 69 | sfst = spure fst | 86 | sfst = spure fst |
