# HG changeset patch
# User Yasutaka Higa <e115763@ie.u-ryukyu.ac.jp>
# Date 1409641954 -32400
# Node ID 7c7efee7891f0877e8b2b87f0d37c50518298c55
# Parent  41c71f67c103854f6dbb05693f09ca332cc03b4f
Define Monad style Similer

diff -r 41c71f67c103 -r 7c7efee7891f similer.hs
--- a/similer.hs	Tue Sep 02 11:48:53 2014 +0900
+++ b/similer.hs	Tue Sep 02 16:12:34 2014 +0900
@@ -1,16 +1,35 @@
-data Similer a b = Similer a (a -> b) b
+{-# LANGUAGE GADTs, MultiParamTypeClasses #-}
+
+data Similer a = (Eq a) => Similer a (a -> a) a
+
+instance (Eq a) => Eq (Similer a) where
+  s == ss = same s == same ss
+
+same :: Similer a -> a
+same (Similer x f y) = if (f x) == y then y else undefined
+
+mu :: (Eq a) => Similer (Similer a) -> Similer a
+mu (Similer a f b) = if ((f a) == b) then b else undefined
 
-instance Functor (Similer a) where
-  fmap g (Similer a f b) = Similer a (g . f) $ g b
+class EqFunctor f where
+  eqmap :: (Eq a, Eq b) => (a -> b) -> f a -> f b
+
+instance EqFunctor Similer where
+  eqmap f s = Similer fs id fs
+    where fs = f $ same s
 
-eq :: (Eq a) => Similer a b -> Similer a b -> Bool
-eq (Similer a _ _ ) (Similer b _ _) = a == b
+class EqMonad m where
+  (>>=) :: (Eq a, Eq b) => m a -> (a -> m b) -> m b
+  return ::(Eq a) =>  a -> m a
 
+instance EqMonad Similer where
+  return x = Similer x id x
+  s >>= f  = mu (eqmap f s)
+
+{-
 eta :: a -> Similer a a
 eta a = Similer a id a
 
-mu :: (Eq b) => Similer a (Similer b c) -> Similer b c
-mu (Similer a f b) = if (eq (f a) b) then b else undefined
 
 double :: Int -> Int
 double x = (2 * x)
@@ -21,8 +40,6 @@
 plusTwo :: Int -> Int
 plusTwo x = x + 2
 
-same :: (Show b, Eq b) => Similer a b -> b
-same (Similer x f y) = if (f x) == y then y else (error ("not same :" ++ show y))
 
 similer :: (Show b, Eq b) => (a -> b) -> (a -> b) -> a -> b
 similer f g x = same $ Similer x g (f x)
@@ -32,3 +49,4 @@
 sameExample            = map (similer twicePlus double)  [1..10]
 nonSameExample         = map (similer twicePlus plusTwo) [1..10]
 nonSameExampleSpecific = map (similer twicePlus plusTwo) [2]
+-}