Mercurial > hg > Members > atton > delta_monad
annotate similer.hs @ 11:e8a5df54480e
Define sample for Monad style
author | Yasutaka Higa <e115763@ie.u-ryukyu.ac.jp> |
---|---|
date | Tue, 02 Sep 2014 16:25:53 +0900 |
parents | 7c7efee7891f |
children |
rev | line source |
---|---|
11
e8a5df54480e
Define sample for Monad style
Yasutaka Higa <e115763@ie.u-ryukyu.ac.jp>
parents:
10
diff
changeset
|
1 {-# LANGUAGE GADTs #-} |
10
7c7efee7891f
Define Monad style Similer
Yasutaka Higa <e115763@ie.u-ryukyu.ac.jp>
parents:
9
diff
changeset
|
2 |
7c7efee7891f
Define Monad style Similer
Yasutaka Higa <e115763@ie.u-ryukyu.ac.jp>
parents:
9
diff
changeset
|
3 data Similer a = (Eq a) => Similer a (a -> a) a |
7c7efee7891f
Define Monad style Similer
Yasutaka Higa <e115763@ie.u-ryukyu.ac.jp>
parents:
9
diff
changeset
|
4 |
7c7efee7891f
Define Monad style Similer
Yasutaka Higa <e115763@ie.u-ryukyu.ac.jp>
parents:
9
diff
changeset
|
5 instance (Eq a) => Eq (Similer a) where |
7c7efee7891f
Define Monad style Similer
Yasutaka Higa <e115763@ie.u-ryukyu.ac.jp>
parents:
9
diff
changeset
|
6 s == ss = same s == same ss |
7c7efee7891f
Define Monad style Similer
Yasutaka Higa <e115763@ie.u-ryukyu.ac.jp>
parents:
9
diff
changeset
|
7 |
11
e8a5df54480e
Define sample for Monad style
Yasutaka Higa <e115763@ie.u-ryukyu.ac.jp>
parents:
10
diff
changeset
|
8 same :: (Eq a) => Similer a -> a |
10
7c7efee7891f
Define Monad style Similer
Yasutaka Higa <e115763@ie.u-ryukyu.ac.jp>
parents:
9
diff
changeset
|
9 same (Similer x f y) = if (f x) == y then y else undefined |
7c7efee7891f
Define Monad style Similer
Yasutaka Higa <e115763@ie.u-ryukyu.ac.jp>
parents:
9
diff
changeset
|
10 |
7c7efee7891f
Define Monad style Similer
Yasutaka Higa <e115763@ie.u-ryukyu.ac.jp>
parents:
9
diff
changeset
|
11 mu :: (Eq a) => Similer (Similer a) -> Similer a |
7c7efee7891f
Define Monad style Similer
Yasutaka Higa <e115763@ie.u-ryukyu.ac.jp>
parents:
9
diff
changeset
|
12 mu (Similer a f b) = if ((f a) == b) then b else undefined |
0
7a82a5e50499
Initial commit. define to Functor for Similer
Yasutaka Higa <e115763@ie.u-ryukyu.ac.jp>
parents:
diff
changeset
|
13 |
10
7c7efee7891f
Define Monad style Similer
Yasutaka Higa <e115763@ie.u-ryukyu.ac.jp>
parents:
9
diff
changeset
|
14 class EqFunctor f where |
7c7efee7891f
Define Monad style Similer
Yasutaka Higa <e115763@ie.u-ryukyu.ac.jp>
parents:
9
diff
changeset
|
15 eqmap :: (Eq a, Eq b) => (a -> b) -> f a -> f b |
7c7efee7891f
Define Monad style Similer
Yasutaka Higa <e115763@ie.u-ryukyu.ac.jp>
parents:
9
diff
changeset
|
16 |
7c7efee7891f
Define Monad style Similer
Yasutaka Higa <e115763@ie.u-ryukyu.ac.jp>
parents:
9
diff
changeset
|
17 instance EqFunctor Similer where |
7c7efee7891f
Define Monad style Similer
Yasutaka Higa <e115763@ie.u-ryukyu.ac.jp>
parents:
9
diff
changeset
|
18 eqmap f s = Similer fs id fs |
7c7efee7891f
Define Monad style Similer
Yasutaka Higa <e115763@ie.u-ryukyu.ac.jp>
parents:
9
diff
changeset
|
19 where fs = f $ same s |
0
7a82a5e50499
Initial commit. define to Functor for Similer
Yasutaka Higa <e115763@ie.u-ryukyu.ac.jp>
parents:
diff
changeset
|
20 |
10
7c7efee7891f
Define Monad style Similer
Yasutaka Higa <e115763@ie.u-ryukyu.ac.jp>
parents:
9
diff
changeset
|
21 class EqMonad m where |
7c7efee7891f
Define Monad style Similer
Yasutaka Higa <e115763@ie.u-ryukyu.ac.jp>
parents:
9
diff
changeset
|
22 (>>=) :: (Eq a, Eq b) => m a -> (a -> m b) -> m b |
7c7efee7891f
Define Monad style Similer
Yasutaka Higa <e115763@ie.u-ryukyu.ac.jp>
parents:
9
diff
changeset
|
23 return ::(Eq a) => a -> m a |
3
3c5fbce357af
Define >>= for Similer
Yasutaka Higa <e115763@ie.u-ryukyu.ac.jp>
parents:
2
diff
changeset
|
24 |
10
7c7efee7891f
Define Monad style Similer
Yasutaka Higa <e115763@ie.u-ryukyu.ac.jp>
parents:
9
diff
changeset
|
25 instance EqMonad Similer where |
7c7efee7891f
Define Monad style Similer
Yasutaka Higa <e115763@ie.u-ryukyu.ac.jp>
parents:
9
diff
changeset
|
26 return x = Similer x id x |
7c7efee7891f
Define Monad style Similer
Yasutaka Higa <e115763@ie.u-ryukyu.ac.jp>
parents:
9
diff
changeset
|
27 s >>= f = mu (eqmap f s) |
7c7efee7891f
Define Monad style Similer
Yasutaka Higa <e115763@ie.u-ryukyu.ac.jp>
parents:
9
diff
changeset
|
28 |
11
e8a5df54480e
Define sample for Monad style
Yasutaka Higa <e115763@ie.u-ryukyu.ac.jp>
parents:
10
diff
changeset
|
29 similer :: (Eq a) => (a -> a) -> (a -> a) -> a -> a |
e8a5df54480e
Define sample for Monad style
Yasutaka Higa <e115763@ie.u-ryukyu.ac.jp>
parents:
10
diff
changeset
|
30 similer f g x = same $ Similer x g (f x) |
e8a5df54480e
Define sample for Monad style
Yasutaka Higa <e115763@ie.u-ryukyu.ac.jp>
parents:
10
diff
changeset
|
31 |
0
7a82a5e50499
Initial commit. define to Functor for Similer
Yasutaka Higa <e115763@ie.u-ryukyu.ac.jp>
parents:
diff
changeset
|
32 |
3
3c5fbce357af
Define >>= for Similer
Yasutaka Higa <e115763@ie.u-ryukyu.ac.jp>
parents:
2
diff
changeset
|
33 |
8
6e0285628ead
Define similer function
Yasutaka Higa <e115763@ie.u-ryukyu.ac.jp>
parents:
6
diff
changeset
|
34 double :: Int -> Int |
6e0285628ead
Define similer function
Yasutaka Higa <e115763@ie.u-ryukyu.ac.jp>
parents:
6
diff
changeset
|
35 double x = (2 * x) |
4
66609010d477
Define Similer example as Functor
Yasutaka Higa <e115763@ie.u-ryukyu.ac.jp>
parents:
3
diff
changeset
|
36 |
8
6e0285628ead
Define similer function
Yasutaka Higa <e115763@ie.u-ryukyu.ac.jp>
parents:
6
diff
changeset
|
37 twicePlus :: Int -> Int |
6e0285628ead
Define similer function
Yasutaka Higa <e115763@ie.u-ryukyu.ac.jp>
parents:
6
diff
changeset
|
38 twicePlus x = x + x |
4
66609010d477
Define Similer example as Functor
Yasutaka Higa <e115763@ie.u-ryukyu.ac.jp>
parents:
3
diff
changeset
|
39 |
8
6e0285628ead
Define similer function
Yasutaka Higa <e115763@ie.u-ryukyu.ac.jp>
parents:
6
diff
changeset
|
40 plusTwo :: Int -> Int |
6e0285628ead
Define similer function
Yasutaka Higa <e115763@ie.u-ryukyu.ac.jp>
parents:
6
diff
changeset
|
41 plusTwo x = x + 2 |
4
66609010d477
Define Similer example as Functor
Yasutaka Higa <e115763@ie.u-ryukyu.ac.jp>
parents:
3
diff
changeset
|
42 |
11
e8a5df54480e
Define sample for Monad style
Yasutaka Higa <e115763@ie.u-ryukyu.ac.jp>
parents:
10
diff
changeset
|
43 -- samples |
6 | 44 |
11
e8a5df54480e
Define sample for Monad style
Yasutaka Higa <e115763@ie.u-ryukyu.ac.jp>
parents:
10
diff
changeset
|
45 {- |
e8a5df54480e
Define sample for Monad style
Yasutaka Higa <e115763@ie.u-ryukyu.ac.jp>
parents:
10
diff
changeset
|
46 *Main> same $ Main.return 100 Main.>>= (\x -> Similer x twicePlus $ double x) |
e8a5df54480e
Define sample for Monad style
Yasutaka Higa <e115763@ie.u-ryukyu.ac.jp>
parents:
10
diff
changeset
|
47 200 |
6 | 48 |
11
e8a5df54480e
Define sample for Monad style
Yasutaka Higa <e115763@ie.u-ryukyu.ac.jp>
parents:
10
diff
changeset
|
49 *Main> same $ Main.return 2 Main.>>= (\x -> Similer x plusTwo $ double x) |
e8a5df54480e
Define sample for Monad style
Yasutaka Higa <e115763@ie.u-ryukyu.ac.jp>
parents:
10
diff
changeset
|
50 4 |
e8a5df54480e
Define sample for Monad style
Yasutaka Higa <e115763@ie.u-ryukyu.ac.jp>
parents:
10
diff
changeset
|
51 |
e8a5df54480e
Define sample for Monad style
Yasutaka Higa <e115763@ie.u-ryukyu.ac.jp>
parents:
10
diff
changeset
|
52 *Main> same $ Main.return 100 Main.>>= (\x -> Similer x plusTwo $ double x) |
e8a5df54480e
Define sample for Monad style
Yasutaka Higa <e115763@ie.u-ryukyu.ac.jp>
parents:
10
diff
changeset
|
53 *** Exception: Prelude.undefined |
10
7c7efee7891f
Define Monad style Similer
Yasutaka Higa <e115763@ie.u-ryukyu.ac.jp>
parents:
9
diff
changeset
|
54 -} |