From 227da0060b54202ad1ac533dcd8206ba49d223b0 Mon Sep 17 00:00:00 2001
From: ross <unknown>
Date: Wed, 5 Oct 2005 08:43:26 +0000
Subject: [PATCH] [project @ 2005-10-05 08:43:26 by ross] add Monad and
 MonadPlus instances

---
 Data/Sequence.hs |   38 +++++++++++++++++++++-----------------
 1 file changed, 21 insertions(+), 17 deletions(-)

diff --git a/Data/Sequence.hs b/Data/Sequence.hs
index bc3a743..6f01e0d 100644
--- a/Data/Sequence.hs
+++ b/Data/Sequence.hs
@@ -81,10 +81,14 @@ import Prelude hiding (
 	reverse)
 import qualified Prelude (foldr)
 import qualified Data.List (foldl', intersperse)
+import Control.Monad (MonadPlus(..))
 import Data.FunctorM
 import Data.Typeable
+
 #ifdef __GLASGOW_HASKELL__
 import GHC.Exts (build)
+import Data.Generics.Basics (Data(..), Fixity(..),
+			constrIndex, mkConstr, mkDataType)
 #endif
 
 #if TESTING
@@ -92,11 +96,6 @@ import Control.Monad (liftM, liftM2, liftM3, liftM4)
 import Test.QuickCheck
 #endif
 
-#if __GLASGOW_HASKELL__
-import Data.Generics.Basics (Data(..), Fixity(..),
-			constrIndex, mkConstr, mkDataType)
-#endif
-
 infixr 5 `consTree`
 infixl 5 `snocTree`
 
@@ -107,16 +106,29 @@ infixl 5 |>, :>
 class Sized a where
 	size :: a -> Int
 
-------------------------------------------------------------------------
--- Random access sequences
-------------------------------------------------------------------------
-
 -- | General-purpose finite sequences.
 newtype Seq a = Seq (FingerTree (Elem a))
 
 instance Functor Seq where
 	fmap f (Seq xs) = Seq (fmap (fmap f) xs)
 
+instance Monad Seq where
+	return = singleton
+	xs >>= f = foldl' add empty xs
+	  where add ys x = ys >< f x
+
+instance MonadPlus Seq where
+	mzero = empty
+	mplus = (><)
+
+instance FunctorM Seq where
+	fmapM f = foldlM f' empty
+	  where f' ys x = do
+			y <- f x
+			return $! (ys |> y)
+	fmapM_ f = foldlM f' ()
+	  where f' _ x = f x >> return ()
+
 instance Eq a => Eq (Seq a) where
 	xs == ys = length xs == length ys && toList xs == toList ys
 
@@ -134,14 +146,6 @@ instance Show a => Show (Seq a) where
 		showChar '>'
 #endif
 
-instance FunctorM Seq where
-	fmapM f = foldlM f' empty
-	  where f' ys x = do
-			y <- f x
-			return $! (ys |> y)
-	fmapM_ f = foldlM f' ()
-	  where f' _ x = f x >> return ()
-
 #include "Typeable.h"
 INSTANCE_TYPEABLE1(Seq,seqTc,"Seq")
 
-- 
1.7.10.4