3 data ChangeFlag = NoChange | SomeChange
5 type Tx a = a -> TxRes a
6 data TxRes a = TxRes ChangeFlag a
8 seqTx :: Tx a -> Tx a -> Tx a
9 iterateTx :: Tx a -> Tx a
10 runTx :: Tx a -> a -> a
12 noTx, aTx :: a -> TxRes a
13 noTx x = TxRes NoChange x
14 aTx x = TxRes SomeChange x
16 replaceTx :: a -> TxRes b -> TxRes a
17 replaceTx a (TxRes change _) = TxRes change a
22 txHasChanged :: TxRes a -> Bool
23 txHasChanged (TxRes NoChange _) = False
24 txHasChanged (TxRes SomeChange _) = True
26 plusTx :: (a -> b -> c) -> TxRes a -> TxRes b -> TxRes c
27 plusTx f (TxRes c1 a) (TxRes c2 b) = TxRes (c1 `orChange` c2) (f a b)
29 mapTx :: Tx a -> Tx [a]
31 mapTx f (x:xs) = plusTx (:) (f x) (mapTx f xs)
36 let TxRes c1 a1 = f1 a
38 in TxRes (c1 `orChange` c2) a2
42 TxRes NoChange a' -> TxRes NoChange a'
43 TxRes SomeChange a' -> let TxRes _ a'' = iterateTx f a'
44 in TxRes SomeChange a''
46 orChange :: ChangeFlag -> ChangeFlag -> ChangeFlag
47 orChange NoChange c = c
48 orChange SomeChange _ = SomeChange
52 instance Functor TxRes where
53 fmap f (TxRes ch a) = TxRes ch (f a)
55 instance Monad TxRes where
56 return = TxRes NoChange
57 (TxRes NoChange a) >>= k = k a
58 (TxRes SomeChange a) >>= k = let (TxRes _ a') = k a in TxRes SomeChange a'