# HG changeset patch
# User Yasutaka Higa <e115763@ie.u-ryukyu.ac.jp>
# Date 1422000308 -32400
# Node ID 0580e1642477381308f0851f307d32073570f346
# Parent  b7f0879e854e9d2286fa09beb46e87f6407f5757
Change monad definition on DeltaM. use mu.

diff -r b7f0879e854e -r 0580e1642477 delta.hs
--- a/delta.hs	Wed Jan 21 17:43:53 2015 +0900
+++ b/delta.hs	Fri Jan 23 17:05:08 2015 +0900
@@ -96,12 +96,10 @@
 -- DeltaM utils
 
 headDeltaM :: DeltaM m a -> m a
-headDeltaM (DeltaM (Mono x))     = x
-headDeltaM (DeltaM (Delta x _ )) = x
+headDeltaM (DeltaM d) = headDelta d
 
 tailDeltaM :: DeltaM m a -> DeltaM m a
-tailDeltaM d@(DeltaM (Mono _))    = d
-tailDeltaM   (DeltaM (Delta _ d)) = DeltaM d
+tailDeltaM (DeltaM d) = DeltaM $ tailDelta d
 
 appendDeltaM :: DeltaM m a -> DeltaM m a -> DeltaM m a
 appendDeltaM (DeltaM d) (DeltaM dd) = DeltaM (deltaAppend d dd)
@@ -125,11 +123,16 @@
     (DeltaM (Delta f df)) <*> dx@(DeltaM (Mono x))  = appendDeltaM (DeltaM $ Mono $ f <*> x) ((DeltaM df) <*> dx)
     (DeltaM (Delta f df)) <*> (DeltaM (Delta x dx)) = appendDeltaM (DeltaM $ Mono $ f <*> x) ((DeltaM df) <*> (DeltaM dx))
 
-instance (Monad m) => Monad (DeltaM m) where
-    return x                   = DeltaM $ Mono $ return x
-    (DeltaM (Mono x))    >>= f = DeltaM $ Mono $ (x >>= headDeltaM . f)
-    (DeltaM (Delta x d)) >>= f = appendDeltaM (DeltaM $ Mono $ (x >>= (headDeltaM . f)))
-                                              ((DeltaM d) >>= tailDeltaM . f)
+
+mu' :: (Functor m, Monad m) => DeltaM m (DeltaM m a) -> DeltaM m a
+mu' (DeltaM (Mono x))    = DeltaM $ Mono $ x >>= headDeltaM
+mu' (DeltaM (Delta x d)) = appendDeltaM (DeltaM $ Mono $ x >>= headDeltaM)
+                                        (mu' $ fmap tailDeltaM $ DeltaM d )
+
+instance (Functor m, Monad m) => Monad (DeltaM m) where
+    return x = DeltaM $ Mono $ return x
+    d >>= f  = mu' $ fmap f d
+
 
 
 -- DeltaM examples
@@ -145,6 +148,9 @@
 dmap :: (m a -> b) -> DeltaM m a -> Delta b
 dmap f (DeltaM d) = fmap f d
 
+deltaWithLogFromList :: (Show a) => [a] -> DeltaWithLog a
+deltaWithLogFromList xs = DeltaM $ deltaFromList $ fmap returnW xs
+
 
 -- example : prime filter
 -- usage   : runWriter $ checkOut 0 $ primeCountM 30  -- run specific version