4 data ChangeFlag = NoChange | SomeChange
6 type Tx a = a -> TxRes a
7 data TxRes a = TxRes ChangeFlag a
9 seqTx :: Tx a -> Tx a -> Tx a
10 iterateTx :: Tx a -> Tx a
11 runTx :: Tx a -> a -> a
13 noTx, aTx :: a -> TxRes a
14 noTx x = TxRes NoChange x
15 aTx x = TxRes SomeChange x
17 replaceTx :: a -> TxRes b -> TxRes a
18 replaceTx a (TxRes change _) = TxRes change a
23 txHasChanged :: TxRes a -> Bool
24 txHasChanged (TxRes NoChange _) = False
25 txHasChanged (TxRes SomeChange _) = True
27 plusTx :: (a -> b -> c) -> TxRes a -> TxRes b -> TxRes c
28 plusTx f (TxRes c1 a) (TxRes c2 b) = TxRes (c1 `orChange` c2) (f a b)
30 mapTx :: Tx a -> Tx [a]
32 mapTx f (x:xs) = plusTx (:) (f x) (mapTx f xs)
37 let TxRes c1 a1 = f1 a
39 in TxRes (c1 `orChange` c2) a2
43 TxRes NoChange a' -> TxRes NoChange a'
44 TxRes SomeChange a' -> let TxRes _ a'' = iterateTx f a'
45 in TxRes SomeChange a''
47 orChange :: ChangeFlag -> ChangeFlag -> ChangeFlag
48 orChange NoChange c = c
49 orChange SomeChange _ = SomeChange
53 instance Functor TxRes where
54 fmap f (TxRes ch a) = TxRes ch (f a)
56 instance Monad TxRes where
57 return = TxRes NoChange
58 (TxRes NoChange a) >>= k = k a
59 (TxRes SomeChange a) >>= k = let (TxRes _ a') = k a in TxRes SomeChange a'