From ac0622fceec62ef1b4a1ed8f1f49ce7b72cff9da Mon Sep 17 00:00:00 2001
From: ross <unknown>
Date: Thu, 20 Oct 2005 23:28:42 +0000
Subject: [PATCH] [project @ 2005-10-20 23:28:42 by ross] revise Read instance
 to match < and > as chars rather than lexemes, as suggested
 by Georg Martius.

---
 Data/Sequence.hs |   59 +++++++++++++++++++++---------------------------------
 1 file changed, 23 insertions(+), 36 deletions(-)

diff --git a/Data/Sequence.hs b/Data/Sequence.hs
index 69276ed..6b53985 100644
--- a/Data/Sequence.hs
+++ b/Data/Sequence.hs
@@ -87,9 +87,13 @@ import Data.Typeable
 
 #ifdef __GLASGOW_HASKELL__
 import GHC.Exts (build)
-import Text.Read (readPrec, lexP, Lexeme(..), (<++), (+++), reset)
+import Text.ParserCombinators.ReadP (char, skipSpaces, between, sepBy, (+++))
+import Text.Read (readPrec, readPrec_to_P, readP_to_Prec, minPrec)
+import Control.Monad (liftM)
 import Data.Generics.Basics (Data(..), Fixity(..),
 			constrIndex, mkConstr, mkDataType)
+#else
+import Data.Char (isSpace)
 #endif
 
 #if TESTING
@@ -148,46 +152,29 @@ instance Show a => Show (Seq a) where
 #endif
 
 instance Read a => Read (Seq a) where
+	-- avoid lex, as < or > might be followed by symbol characters.
 #ifdef __GLASGOW_HASKELL__
-	readPrec = parens $ (symbol "<>" >> return empty) <++ do
-		symbol "<"
-		readEnd empty <++ readRest empty
-	  where readEnd xs = do
-			symbol ">"
-			return xs
-		readRest xs = do
-			x <- reset readPrec
-			let xs' = xs |> x
-			readEnd xs' <++ do
-				symbol ","
-				readRest xs'
-		parens p = p +++ do
-			Punc "(" <- lexP
-			x        <- reset (parens p)
-			Punc ")" <- lexP
-			return x
-		symbol s = do
-			Symbol "<" <- lexP
-			return ()
+	readPrec = readP_to_Prec $ const $
+		parens $
+		between (litChar '<') (litChar '>') $
+		liftM fromList $
+		readPrec_to_P readPrec minPrec `sepBy` litChar ','
+	  where parens p = p +++ between (litChar '(') (litChar ')') (parens p)
+		litChar c = skipSpaces >> char c
 #else
-	readsPrec _ = readParen False $ \ r -> do
-		(tok,s) <- lex r
-		case tok of
-			"<>" -> return (empty,s)
-			"<"  -> do
-				(tok',t) <- lex s
-				case tok' of
-					">" -> return (empty,t)
-					_   -> readRest empty s
-			_    -> []
+	readsPrec _ = readParen False $ \ r ->
+		case dropWhile isSpace r of
+			('<':s) -> case dropWhile isSpace s of
+				('>':t) -> return (empty,t)
+				_       -> readRest empty s
+			_ -> []
 	  where readRest xs s = do
 			(x,t) <- reads s
 			let xs' = xs |> x
-			(tok,u) <- lex t
-			case tok of
-				">" -> return (xs',u)
-				"," -> readRest xs' u
-				_   -> []
+			case dropWhile isSpace t of
+				('>':u) -> return (xs',u)
+				(',':u) -> readRest xs' u
+				_     -> []
 #endif
 
 #include "Typeable.h"
-- 
1.7.10.4