Mercurial > hg > Members > atton > delta_monad
comparison similar.hs @ 17:279ebcf670c4
Define Similar as Applicative
author | Yasutaka Higa <e115763@ie.u-ryukyu.ac.jp> |
---|---|
date | Tue, 09 Sep 2014 16:21:22 +0900 |
parents | 4b315cf0edb9 |
children | c77397d0677f |
comparison
equal
deleted
inserted
replaced
16:4b315cf0edb9 | 17:279ebcf670c4 |
---|---|
1 import Control.Applicative | |
2 | |
1 data Similar a = Single a | Similar a (Similar a) deriving (Show) | 3 data Similar a = Single a | Similar a (Similar a) deriving (Show) |
2 | 4 |
3 instance (Eq a) => Eq (Similar a) where | 5 instance (Eq a) => Eq (Similar a) where |
4 s == ss = (same s) == (same ss) | 6 s == ss = (same s) == (same ss) |
5 | 7 |
16 similar (Similar x s) ss = Similar x (similar s ss) | 18 similar (Similar x s) ss = Similar x (similar s ss) |
17 | 19 |
18 instance Functor Similar where | 20 instance Functor Similar where |
19 fmap f (Single a) = Single (f a) | 21 fmap f (Single a) = Single (f a) |
20 fmap f (Similar a s) = Similar (f a) (fmap f s) | 22 fmap f (Similar a s) = Similar (f a) (fmap f s) |
23 | |
24 instance Applicative Similar where | |
25 pure = Single | |
26 (Single f) <*> s = fmap f s | |
27 (Similar f s) <*> ss = similar (fmap f ss) (s <*> ss) | |
21 | 28 |
22 mu :: (Similar (Similar a)) -> Similar a | 29 mu :: (Similar (Similar a)) -> Similar a |
23 mu (Single s) = s | 30 mu (Single s) = s |
24 mu (Similar s ss) = similar s (mu ss) | 31 mu (Similar s ss) = similar s (mu ss) |
25 | 32 |
55 *Main> same $ fmap same $ fmap (fmap double) (fmap (plusTwo ) (Single 1)) | 62 *Main> same $ fmap same $ fmap (fmap double) (fmap (plusTwo ) (Single 1)) |
56 *** Exception: same | 63 *** Exception: same |
57 *Main> same $ fmap same $ fmap (fmap double) (fmap (plusTwo ) (Single 2)) | 64 *Main> same $ fmap same $ fmap (fmap double) (fmap (plusTwo ) (Single 2)) |
58 Single 8 | 65 Single 8 |
59 | 66 |
67 - Similar as Applicative Functor | |
68 *Main> Single (\x -> x * x) <*> Single 100 | |
69 Single 10000 | |
70 *Main> Similar (\x -> x * x) (Single (\x -> x * 3)) <*> Single 100 | |
71 Similar 10000 (Single 300) | |
72 *Main> Similar (\x -> x * x) (Single (\x -> x * 3)) <*> (Similar 100 (Single 200)) | |
73 Similar 10000 (Similar 40000 (Similar 300 (Single 600))) | |
74 | |
60 - Similar as Monad | 75 - Similar as Monad |
61 *Main> return 100 >>= double >>= twicePlus | 76 *Main> return 100 >>= double >>= twicePlus |
62 Similar 400 (Single 400) | 77 Similar 400 (Single 400) |
63 *Main> return 100 >>= double >>= twicePlus >>= plusTwo | 78 *Main> return 100 >>= double >>= twicePlus >>= plusTwo |
64 Similar 402 (Similar 800 (Similar 402 (Single 800))) | 79 Similar 402 (Similar 800 (Similar 402 (Single 800))) |