Mercurial > hg > Members > atton > delta_monad

changeset 58:1229ee398567

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Mini fixes
author Yasutaka Higa <e115763@ie.u-ryukyu.ac.jp>
date Sat, 22 Nov 2014 12:34:06 +0900
parents dfcd72dc697e
children 46b15f368905
files delta.hs
diffstat 1 files changed, 15 insertions(+), 4 deletions(-) [+]
line wrap: on
line diff
--- a/delta.hs	Sat Nov 22 12:29:32 2014 +0900
+++ b/delta.hs	Sat Nov 22 12:34:06 2014 +0900
@@ -1,20 +1,26 @@
 import Control.Applicative
 import Data.Numbers.Primes -- $ cabal install primes
 
+-- delta definition
+
 data Delta a = Mono a | Delta a (Delta a) deriving Show
 
+-- basic functions
+
 deltaAppend :: Delta a -> Delta a -> Delta a
 deltaAppend (Mono x) d     = Delta x d
 deltaAppend (Delta x d) ds = Delta x (deltaAppend d ds)
 
 headDelta :: Delta a -> Delta a
-headDelta d@(Mono  _)   = d
+headDelta d@(Mono  _) = d
 headDelta (Delta x _) = Mono x
 
 tailDelta :: Delta a -> Delta a
 tailDelta d@(Mono _)   = d
 tailDelta (Delta _ ds) = ds
 
+-- instance definitions
+
 instance Functor Delta where
     fmap f (Mono x)    = Mono  (f x)
     fmap f (Delta x d) = Delta (f x) (fmap f d)
@@ -26,11 +32,13 @@
     (Delta f df) <*> d@(Mono x)  = Delta (f x) (df <*> d)
     (Delta f df) <*> (Delta x d) = Delta (f x) (df <*> d)
 
-
 instance Monad Delta where
     return x = Mono x
-    (Mono x)    >>= f  = f x
-    (Delta x d) >>= f  = (headDelta (f x)) `deltaAppend` (d >>= (tailDelta . f))
+    (Mono x)    >>= f = f x
+    (Delta x d) >>= f = (headDelta (f x)) `deltaAppend` (d >>= (tailDelta . f))
+
+
+-- utils
 
 returnS :: (Show s) => s -> Delta s
 returnS x = Mono x
@@ -38,6 +46,9 @@
 returnSS :: (Show s) => s -> s -> Delta s
 returnSS x y = (returnS x) `deltaAppend` (returnS y)
 
+deltaFromList :: [a] -> Delta a
+deltaFromList = (foldl1 deltaAppend) . (fmap return)
+
 
 -- samples