@@ -1,7 +1,12 @@
11
22module Automaton where
33
4−data Automaton inp out = Automaton (inp -> (out, Automaton inp out))
4+data Automaton a b = Automaton (a -> (b, Automaton a b))
5+
6+-- Maybe once there are infix type constructors this could be
7+-- data a ~> b
8+-- or something like that.
9+
510
611{--- API possibilies
712
@@ -12,13 +17,34 @@ How to run an automaton (some require typeclasses):
1217
1318run :: Automaton a b -> Signal a -> Signal b
1419run :: OrderedContainer c => Automaton a b -> c a -> c b
15−run :: Functor f => Automaton a b -> f a -> f b
16−
1720
1821compose :: Automaton a b -> Automaton b c -> Automaton a c
22+
1923combine :: [Automaton a b] -> Automaton a [b]
24+combine :: Container c => c (Automaton a b) -> Automaton a (c b)
2025
2126init :: b -> (a -> b -> b) -> Automaton a b
2227init' :: s -> (a -> s -> (b,s)) -> Automaton a b
2328
24−--}
29+draggable :: Form -> Automaton (Bool,(Int,Int)) Form
30+
31+--}
32+
33+
34+run (Automaton m0) input =
35+ lift fst $ foldp1 (\a (b, Automaton m) -> m a) m0 input
36+
37+compose (Automaton m1) (Automaton m2) =
38+ Automaton
39+ (\a -> let (b,m1') = m1 a in
40+ let (c,m2') = m2 b in (c, compose (Automaton m1') (Automaton m2')))
41+
42+combine autos =
43+ Automaton (\a -> let (bs,autos') = unzip $ map (\m -> m a) autos in
44+ (bs, combine autos'))
45+
46+init s step =
47+ Automaton (\a -> let s' = step a s in (s', init s' step))
48+
49+init' s step =
50+ Automaton (\a -> let (b,s') = step a s in (b, init s' step))