Mercurial > hg > Members > atton > delta_monad
annotate haskell/DeltaM.hs @ 134:3f48bd08865f
Rename and split with module for haskell codes
author | Yasutaka Higa <e115763@ie.u-ryukyu.ac.jp> |
---|---|
date | Fri, 06 Feb 2015 16:28:54 +0900 |
parents | |
children |
rev | line source |
---|---|
134
3f48bd08865f
Rename and split with module for haskell codes
Yasutaka Higa <e115763@ie.u-ryukyu.ac.jp>
parents:
diff
changeset
|
1 module DeltaM (DeltaM(..), unDeltaM, appendDeltaM, tailDeltaM, headDeltaM, checkOut) where |
3f48bd08865f
Rename and split with module for haskell codes
Yasutaka Higa <e115763@ie.u-ryukyu.ac.jp>
parents:
diff
changeset
|
2 |
3f48bd08865f
Rename and split with module for haskell codes
Yasutaka Higa <e115763@ie.u-ryukyu.ac.jp>
parents:
diff
changeset
|
3 import Control.Applicative |
3f48bd08865f
Rename and split with module for haskell codes
Yasutaka Higa <e115763@ie.u-ryukyu.ac.jp>
parents:
diff
changeset
|
4 import Delta |
3f48bd08865f
Rename and split with module for haskell codes
Yasutaka Higa <e115763@ie.u-ryukyu.ac.jp>
parents:
diff
changeset
|
5 |
3f48bd08865f
Rename and split with module for haskell codes
Yasutaka Higa <e115763@ie.u-ryukyu.ac.jp>
parents:
diff
changeset
|
6 |
3f48bd08865f
Rename and split with module for haskell codes
Yasutaka Higa <e115763@ie.u-ryukyu.ac.jp>
parents:
diff
changeset
|
7 -- DeltaM definition (Delta with Monad) |
3f48bd08865f
Rename and split with module for haskell codes
Yasutaka Higa <e115763@ie.u-ryukyu.ac.jp>
parents:
diff
changeset
|
8 |
3f48bd08865f
Rename and split with module for haskell codes
Yasutaka Higa <e115763@ie.u-ryukyu.ac.jp>
parents:
diff
changeset
|
9 data DeltaM m a = DeltaM (Delta (m a)) deriving (Show) |
3f48bd08865f
Rename and split with module for haskell codes
Yasutaka Higa <e115763@ie.u-ryukyu.ac.jp>
parents:
diff
changeset
|
10 |
3f48bd08865f
Rename and split with module for haskell codes
Yasutaka Higa <e115763@ie.u-ryukyu.ac.jp>
parents:
diff
changeset
|
11 |
3f48bd08865f
Rename and split with module for haskell codes
Yasutaka Higa <e115763@ie.u-ryukyu.ac.jp>
parents:
diff
changeset
|
12 -- DeltaM utils |
3f48bd08865f
Rename and split with module for haskell codes
Yasutaka Higa <e115763@ie.u-ryukyu.ac.jp>
parents:
diff
changeset
|
13 |
3f48bd08865f
Rename and split with module for haskell codes
Yasutaka Higa <e115763@ie.u-ryukyu.ac.jp>
parents:
diff
changeset
|
14 unDeltaM :: DeltaM m a -> Delta (m a) |
3f48bd08865f
Rename and split with module for haskell codes
Yasutaka Higa <e115763@ie.u-ryukyu.ac.jp>
parents:
diff
changeset
|
15 unDeltaM (DeltaM d) = d |
3f48bd08865f
Rename and split with module for haskell codes
Yasutaka Higa <e115763@ie.u-ryukyu.ac.jp>
parents:
diff
changeset
|
16 |
3f48bd08865f
Rename and split with module for haskell codes
Yasutaka Higa <e115763@ie.u-ryukyu.ac.jp>
parents:
diff
changeset
|
17 headDeltaM :: DeltaM m a -> m a |
3f48bd08865f
Rename and split with module for haskell codes
Yasutaka Higa <e115763@ie.u-ryukyu.ac.jp>
parents:
diff
changeset
|
18 headDeltaM (DeltaM d) = headDelta d |
3f48bd08865f
Rename and split with module for haskell codes
Yasutaka Higa <e115763@ie.u-ryukyu.ac.jp>
parents:
diff
changeset
|
19 |
3f48bd08865f
Rename and split with module for haskell codes
Yasutaka Higa <e115763@ie.u-ryukyu.ac.jp>
parents:
diff
changeset
|
20 tailDeltaM :: DeltaM m a -> DeltaM m a |
3f48bd08865f
Rename and split with module for haskell codes
Yasutaka Higa <e115763@ie.u-ryukyu.ac.jp>
parents:
diff
changeset
|
21 tailDeltaM (DeltaM d) = DeltaM $ tailDelta d |
3f48bd08865f
Rename and split with module for haskell codes
Yasutaka Higa <e115763@ie.u-ryukyu.ac.jp>
parents:
diff
changeset
|
22 |
3f48bd08865f
Rename and split with module for haskell codes
Yasutaka Higa <e115763@ie.u-ryukyu.ac.jp>
parents:
diff
changeset
|
23 appendDeltaM :: DeltaM m a -> DeltaM m a -> DeltaM m a |
3f48bd08865f
Rename and split with module for haskell codes
Yasutaka Higa <e115763@ie.u-ryukyu.ac.jp>
parents:
diff
changeset
|
24 appendDeltaM (DeltaM d) (DeltaM dd) = DeltaM (deltaAppend d dd) |
3f48bd08865f
Rename and split with module for haskell codes
Yasutaka Higa <e115763@ie.u-ryukyu.ac.jp>
parents:
diff
changeset
|
25 |
3f48bd08865f
Rename and split with module for haskell codes
Yasutaka Higa <e115763@ie.u-ryukyu.ac.jp>
parents:
diff
changeset
|
26 checkOut :: Int -> DeltaM m a -> m a |
3f48bd08865f
Rename and split with module for haskell codes
Yasutaka Higa <e115763@ie.u-ryukyu.ac.jp>
parents:
diff
changeset
|
27 checkOut 0 (DeltaM (Mono x)) = x |
3f48bd08865f
Rename and split with module for haskell codes
Yasutaka Higa <e115763@ie.u-ryukyu.ac.jp>
parents:
diff
changeset
|
28 checkOut 0 (DeltaM (Delta x _)) = x |
3f48bd08865f
Rename and split with module for haskell codes
Yasutaka Higa <e115763@ie.u-ryukyu.ac.jp>
parents:
diff
changeset
|
29 checkOut n (DeltaM (Mono x)) = x |
3f48bd08865f
Rename and split with module for haskell codes
Yasutaka Higa <e115763@ie.u-ryukyu.ac.jp>
parents:
diff
changeset
|
30 checkOut n (DeltaM (Delta _ d)) = checkOut (n-1) (DeltaM d) |
3f48bd08865f
Rename and split with module for haskell codes
Yasutaka Higa <e115763@ie.u-ryukyu.ac.jp>
parents:
diff
changeset
|
31 |
3f48bd08865f
Rename and split with module for haskell codes
Yasutaka Higa <e115763@ie.u-ryukyu.ac.jp>
parents:
diff
changeset
|
32 |
3f48bd08865f
Rename and split with module for haskell codes
Yasutaka Higa <e115763@ie.u-ryukyu.ac.jp>
parents:
diff
changeset
|
33 -- DeltaM instance definitions |
3f48bd08865f
Rename and split with module for haskell codes
Yasutaka Higa <e115763@ie.u-ryukyu.ac.jp>
parents:
diff
changeset
|
34 |
3f48bd08865f
Rename and split with module for haskell codes
Yasutaka Higa <e115763@ie.u-ryukyu.ac.jp>
parents:
diff
changeset
|
35 instance (Functor m) => Functor (DeltaM m) where |
3f48bd08865f
Rename and split with module for haskell codes
Yasutaka Higa <e115763@ie.u-ryukyu.ac.jp>
parents:
diff
changeset
|
36 fmap f (DeltaM d) = DeltaM $ fmap (fmap f) d |
3f48bd08865f
Rename and split with module for haskell codes
Yasutaka Higa <e115763@ie.u-ryukyu.ac.jp>
parents:
diff
changeset
|
37 |
3f48bd08865f
Rename and split with module for haskell codes
Yasutaka Higa <e115763@ie.u-ryukyu.ac.jp>
parents:
diff
changeset
|
38 instance (Applicative m) => Applicative (DeltaM m) where |
3f48bd08865f
Rename and split with module for haskell codes
Yasutaka Higa <e115763@ie.u-ryukyu.ac.jp>
parents:
diff
changeset
|
39 pure f = DeltaM $ Mono $ pure f |
3f48bd08865f
Rename and split with module for haskell codes
Yasutaka Higa <e115763@ie.u-ryukyu.ac.jp>
parents:
diff
changeset
|
40 (DeltaM (Mono f)) <*> (DeltaM (Mono x)) = DeltaM $ Mono $ f <*> x |
3f48bd08865f
Rename and split with module for haskell codes
Yasutaka Higa <e115763@ie.u-ryukyu.ac.jp>
parents:
diff
changeset
|
41 df@(DeltaM (Mono f)) <*> (DeltaM (Delta x d)) = appendDeltaM (DeltaM $ Mono $ f <*> x) (df <*> (DeltaM d)) |
3f48bd08865f
Rename and split with module for haskell codes
Yasutaka Higa <e115763@ie.u-ryukyu.ac.jp>
parents:
diff
changeset
|
42 (DeltaM (Delta f df)) <*> dx@(DeltaM (Mono x)) = appendDeltaM (DeltaM $ Mono $ f <*> x) ((DeltaM df) <*> dx) |
3f48bd08865f
Rename and split with module for haskell codes
Yasutaka Higa <e115763@ie.u-ryukyu.ac.jp>
parents:
diff
changeset
|
43 (DeltaM (Delta f df)) <*> (DeltaM (Delta x dx)) = appendDeltaM (DeltaM $ Mono $ f <*> x) ((DeltaM df) <*> (DeltaM dx)) |
3f48bd08865f
Rename and split with module for haskell codes
Yasutaka Higa <e115763@ie.u-ryukyu.ac.jp>
parents:
diff
changeset
|
44 |
3f48bd08865f
Rename and split with module for haskell codes
Yasutaka Higa <e115763@ie.u-ryukyu.ac.jp>
parents:
diff
changeset
|
45 |
3f48bd08865f
Rename and split with module for haskell codes
Yasutaka Higa <e115763@ie.u-ryukyu.ac.jp>
parents:
diff
changeset
|
46 mu' :: (Functor m, Monad m) => DeltaM m (DeltaM m a) -> DeltaM m a |
3f48bd08865f
Rename and split with module for haskell codes
Yasutaka Higa <e115763@ie.u-ryukyu.ac.jp>
parents:
diff
changeset
|
47 mu' d@(DeltaM (Mono _)) = DeltaM $ Mono $ (>>= id) $ fmap headDeltaM $ headDeltaM d |
3f48bd08865f
Rename and split with module for haskell codes
Yasutaka Higa <e115763@ie.u-ryukyu.ac.jp>
parents:
diff
changeset
|
48 mu' d@(DeltaM (Delta _ _)) = DeltaM $ Delta ((>>= id) $ fmap headDeltaM $ headDeltaM d) |
3f48bd08865f
Rename and split with module for haskell codes
Yasutaka Higa <e115763@ie.u-ryukyu.ac.jp>
parents:
diff
changeset
|
49 (unDeltaM (mu' (fmap tailDeltaM (tailDeltaM d)))) |
3f48bd08865f
Rename and split with module for haskell codes
Yasutaka Higa <e115763@ie.u-ryukyu.ac.jp>
parents:
diff
changeset
|
50 |
3f48bd08865f
Rename and split with module for haskell codes
Yasutaka Higa <e115763@ie.u-ryukyu.ac.jp>
parents:
diff
changeset
|
51 instance (Functor m, Monad m) => Monad (DeltaM m) where |
3f48bd08865f
Rename and split with module for haskell codes
Yasutaka Higa <e115763@ie.u-ryukyu.ac.jp>
parents:
diff
changeset
|
52 return x = DeltaM $ Mono $ return x |
3f48bd08865f
Rename and split with module for haskell codes
Yasutaka Higa <e115763@ie.u-ryukyu.ac.jp>
parents:
diff
changeset
|
53 d >>= f = mu' $ fmap f d |
3f48bd08865f
Rename and split with module for haskell codes
Yasutaka Higa <e115763@ie.u-ryukyu.ac.jp>
parents:
diff
changeset
|
54 |
3f48bd08865f
Rename and split with module for haskell codes
Yasutaka Higa <e115763@ie.u-ryukyu.ac.jp>
parents:
diff
changeset
|
55 |
3f48bd08865f
Rename and split with module for haskell codes
Yasutaka Higa <e115763@ie.u-ryukyu.ac.jp>
parents:
diff
changeset
|
56 |