Mercurial > hg > Members > atton > similar_monad

changeset 17:279ebcf670c4

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
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
files similar.hs
diffstat 1 files changed, 15 insertions(+), 0 deletions(-) [+]
line wrap: on
line diff
--- a/similar.hs	Tue Sep 09 13:29:43 2014 +0900
+++ b/similar.hs	Tue Sep 09 16:21:22 2014 +0900
@@ -1,3 +1,5 @@
+import Control.Applicative
+
 data Similar a = Single a | Similar a (Similar a) deriving (Show)
 
 instance (Eq a) => Eq (Similar a) where
@@ -19,6 +21,11 @@
    fmap f (Single a)    = Single (f a)
    fmap f (Similar a s) = Similar (f a) (fmap f s)
 
+instance Applicative Similar where
+    pure                 = Single
+    (Single f)    <*> s  = fmap f s
+    (Similar f s) <*> ss = similar (fmap f ss) (s <*> ss)
+
 mu :: (Similar (Similar a)) -> Similar a
 mu (Single s)     = s
 mu (Similar s ss) = similar s (mu ss)
@@ -57,6 +64,14 @@
 *Main> same $ fmap same $ fmap (fmap double)  (fmap (plusTwo   ) (Single 2))
 Single 8
 
+- Similar as Applicative Functor
+*Main> Single (\x -> x * x) <*> Single 100
+Single 10000
+*Main> Similar  (\x -> x * x) (Single (\x -> x * 3)) <*> Single 100
+Similar 10000 (Single 300)
+*Main> Similar  (\x -> x * x) (Single (\x -> x * 3)) <*> (Similar 100 (Single 200))
+Similar 10000 (Similar 40000 (Similar 300 (Single 600)))
+
 - Similar as Monad
 *Main>  return 100 >>= double  >>= twicePlus
 Similar 400 (Single 400)