import Prelude hiding (
null, length, take, drop, splitAt, foldl, foldl1, foldr, foldr1,
reverse)
-import qualified Prelude (foldr)
-import qualified Data.List (foldl', intersperse)
-import Control.Monad (MonadPlus(..))
+import qualified Data.List (foldl')
+import Control.Monad (MonadPlus(..), liftM2)
import Data.FunctorM
import Data.Typeable
#ifdef __GLASGOW_HASKELL__
import GHC.Exts (build)
-import Text.Read (readPrec, lexP, Lexeme(..), (<++), (+++), reset)
+import Text.Read (Lexeme(Ident), lexP, parens, prec,
+ readPrec, readListPrec, readListPrecDefault)
import Data.Generics.Basics (Data(..), Fixity(..),
constrIndex, mkConstr, mkDataType)
#endif
#if TESTING
-import Control.Monad (liftM, liftM2, liftM3, liftM4)
+import Control.Monad (liftM, liftM3, liftM4)
import Test.QuickCheck
#endif
showsPrec p (Seq x) = showsPrec p x
#else
instance Show a => Show (Seq a) where
- showsPrec _ xs = showChar '<' .
- flip (Prelude.foldr ($)) (Data.List.intersperse (showChar ',')
- (map shows (toList xs))) .
- showChar '>'
+ showsPrec p xs = showParen (p > 10) $
+ showString "fromList " . shows (toList xs)
#endif
instance Read a => Read (Seq a) where
#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 = parens $ prec 10 $ do
+ Ident "fromList" <- lexP
+ xs <- readPrec
+ return (fromList xs)
+
+ readListPrec = readListPrecDefault
#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
- _ -> []
- 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
- _ -> []
+ readsPrec p = readParen (p > 10) $ \ r -> do
+ ("fromList",s) <- lex r
+ (xs,t) <- reads s
+ return (fromList xs,t)
#endif
#include "Typeable.h"
= EmptyL -- ^ empty sequence
| a :< Seq a -- ^ leftmost element and the rest of the sequence
#ifndef __HADDOCK__
- deriving (Eq, Show)
+# if __GLASGOW_HASKELL__
+ deriving (Eq, Ord, Show, Read, Data)
+# else
+ deriving (Eq, Ord, Show, Read)
+# endif
#else
instance Eq a => Eq (ViewL a)
+instance Ord a => Ord (ViewL a)
instance Show a => Show (ViewL a)
+instance Read a => Read (ViewL a)
+instance Data a => Data (ViewL a)
#endif
+INSTANCE_TYPEABLE1(ViewL,viewLTc,"ViewL")
instance Functor ViewL where
fmap _ EmptyL = EmptyL
fmap f (x :< xs) = f x :< fmap f xs
+instance FunctorM ViewL where
+ fmapM _ EmptyL = return EmptyL
+ fmapM f (x :< xs) = liftM2 (:<) (f x) (fmapM f xs)
+ fmapM_ _ EmptyL = return ()
+ fmapM_ f (x :< xs) = f x >> fmapM_ f xs >> return ()
+
-- | /O(1)/. Analyse the left end of a sequence.
viewl :: Seq a -> ViewL a
viewl (Seq xs) = case viewLTree xs of
| Seq a :> a -- ^ the sequence minus the rightmost element,
-- and the rightmost element
#ifndef __HADDOCK__
- deriving (Eq, Show)
+# if __GLASGOW_HASKELL__
+ deriving (Eq, Ord, Show, Read, Data)
+# else
+ deriving (Eq, Ord, Show, Read)
+# endif
#else
instance Eq a => Eq (ViewR a)
+instance Ord a => Ord (ViewR a)
instance Show a => Show (ViewR a)
+instance Read a => Read (ViewR a)
+instance Data a => Data (ViewR a)
#endif
+INSTANCE_TYPEABLE1(ViewR,viewRTc,"ViewR")
+
instance Functor ViewR where
fmap _ EmptyR = EmptyR
fmap f (xs :> x) = fmap f xs :> f x
+instance FunctorM ViewR where
+ fmapM _ EmptyR = return EmptyR
+ fmapM f (xs :> x) = liftM2 (:>) (fmapM f xs) (f x)
+ fmapM_ _ EmptyR = return ()
+ fmapM_ f (xs :> x) = fmapM_ f xs >> f x >> return ()
+
-- | /O(1)/. Analyse the right end of a sequence.
viewr :: Seq a -> ViewR a
viewr (Seq xs) = case viewRTree xs of