Mercurial > hg > Members > atton > delta_monad

changeset 99:0580e1642477

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Change monad definition on DeltaM. use mu.
author Yasutaka Higa <e115763@ie.u-ryukyu.ac.jp>
date Fri, 23 Jan 2015 17:05:08 +0900
parents b7f0879e854e
children d8cd880f1d78
files delta.hs
diffstat 1 files changed, 15 insertions(+), 9 deletions(-) [+]
line wrap: on
line diff
--- 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