# HG changeset patch
# User Yasutaka Higa <e115763@ie.u-ryukyu.ac.jp>
# Date 1411387472 -32400
# Node ID c77397d0677f8a5f3a071d5541df7e92f8549c4a
# Parent  279ebcf670c4d68006c34a1e77fb252fab2ad023
Try define Similar as Monad

diff -r 279ebcf670c4 -r c77397d0677f similar.hs
--- a/similar.hs	Tue Sep 09 16:21:22 2014 +0900
+++ b/similar.hs	Mon Sep 22 21:04:32 2014 +0900
@@ -1,17 +1,63 @@
 import Control.Applicative
+import Data.Numbers.Primes -- $ cabal install primes
+
+data Similar a = Single [String] a | Similar [String] a [String] a deriving (Show)
 
-data Similar a = Single a | Similar a (Similar a) deriving (Show)
+original :: (Similar a) -> Similar a
+original (Similar xs x _ _) = Single xs x
+original s                  = s
+
+similar :: (Similar a) -> Similar a
+similar (Similar _ _ ys y) = Single ys y
+similar s                  = s
+
+mergeSimilar :: Similar a -> Similar a -> Similar a
+mergeSimilar (Single xs x) (Single ys y) = Similar xs x ys y
 
 instance (Eq a) => Eq (Similar a) where
-    s == ss = (same s) == (same ss)
+    s == ss = (original s) == (original ss)
+
+instance Functor Similar where
+    fmap f (Single xs x)       = Single  xs (f x)
+    fmap f (Similar xs x ys y) = Similar xs (f x) ys (f y)
+
+similarLogAppend :: [String] -> Similar a -> Similar a
+similarLogAppend ls (Single xs x)       = Single  (ls ++ xs) x
+similarLogAppend ls (Similar xs x ys y) = Similar (ls ++ xs) x (ls ++ ys) y
+
+
+instance Monad Similar where
+    return                    = Single []
+    (Single  xs x)      >>= f = similarLogAppend xs (original (f x))
+    (Similar xs x ys y) >>= f = mergeSimilar (similarLogAppend xs (original (f x))) (similarLogAppend ys (similar (f y)))
+
+
+{-
+
 
+
+-- samples
+{-
+
+generator :: Int -> Similar [Int]
+generator x = return [1..x]
+
+primeFilter :: [Int] -> Similar [Int]
+primeFilter xs = return $ filter isPrime xs
+
+count :: [Int] -> Similar Int
+count xs = return $ length xs
+
+primeCount :: Int -> Int
+primeCount x = value $ generator x >>= primeFilter >>= count
+-}
+
+
+{-
 same :: (Eq a) => Similar a -> a
 same (Single x)    = x
 same (Similar x s) = if x == (same s) then x else (error "same")
 
-value :: Similar a -> a
-value (Single x)    = x
-value (Similar x s) = value s
 
 similar :: Similar a -> Similar a -> Similar a
 similar (Single x) ss    = Similar x ss
@@ -30,10 +76,6 @@
 mu (Single s)     = s
 mu (Similar s ss) = similar s (mu ss)
 
-instance Monad Similar where
-    return              = Single
-    (Single x)    >>= f = f x
-    (Similar x s) >>= f = mu $ Similar (f x) (fmap f s)
 
 
 -- samples
@@ -91,4 +133,5 @@
 800
 
 -}
-
+-}
+-}