### changeset 58:1229ee398567

Mini fixes
author Yasutaka Higa Sat, 22 Nov 2014 12:34:06 +0900 dfcd72dc697e 46b15f368905 delta.hs 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 (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)

-
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
```