Repository : ssh://darcs.haskell.org//srv/darcs/packages/vector On branch : master
http://hackage.haskell.org/trac/ghc/changeset/6bc9bbc80c3e66a8412be4e48232022617ccb783 >--------------------------------------------------------------- commit 6bc9bbc80c3e66a8412be4e48232022617ccb783 Author: Roman Leshchinskiy <[email protected]> Date: Fri Aug 26 22:04:27 2011 +0000 Follow containers convention in Show instances and add Read instances >--------------------------------------------------------------- Data/Vector.hs | 7 ++++++- Data/Vector/Generic.hs | 23 ++++++++++++++++++++++- Data/Vector/Primitive.hs | 7 ++++++- Data/Vector/Storable.hs | 10 ++++++---- Data/Vector/Unboxed.hs | 8 +++++++- 5 files changed, 47 insertions(+), 8 deletions(-) diff --git a/Data/Vector.hs b/Data/Vector.hs index 6b3cc98..70e6b5e 100644 --- a/Data/Vector.hs +++ b/Data/Vector.hs @@ -178,6 +178,7 @@ import qualified Prelude import Data.Typeable ( Typeable ) import Data.Data ( Data(..) ) +import Text.Read ( Read(..), readListPrecDefault ) import Data.Monoid ( Monoid(..) ) import qualified Control.Applicative as Applicative @@ -191,7 +192,11 @@ data Vector a = Vector {-# UNPACK #-} !Int deriving ( Typeable ) instance Show a => Show (Vector a) where - show = (Prelude.++ " :: Data.Vector.Vector") . ("fromList " Prelude.++) . show . toList + showsPrec = G.showsPrec + +instance Read a => Read (Vector a) where + readPrec = G.readPrec + readListPrec = readListPrecDefault instance Data a => Data (Vector a) where gfoldl = G.gfoldl diff --git a/Data/Vector/Generic.hs b/Data/Vector/Generic.hs index b8cd8b6..b8f2e81 100644 --- a/Data/Vector/Generic.hs +++ b/Data/Vector/Generic.hs @@ -153,6 +153,9 @@ module Data.Vector.Generic ( -- ** Comparisons eq, cmp, + -- ** Show and Read + showsPrec, readPrec, + -- ** @Data@ and @Typeable@ gfoldl, dataCast, mkType ) where @@ -187,8 +190,10 @@ import Prelude hiding ( length, null, all, any, and, or, sum, product, maximum, minimum, scanl, scanl1, scanr, scanr1, enumFromTo, enumFromThenTo, - mapM, mapM_, sequence, sequence_ ) + mapM, mapM_, sequence, sequence_, + showsPrec ) +import qualified Text.Read as Read import Data.Typeable ( Typeable1, gcast1 ) #include "vector.h" @@ -1982,6 +1987,22 @@ cmp :: (Vector v a, Ord a) => v a -> v a -> Ordering {-# INLINE cmp #-} cmp xs ys = compare (stream xs) (stream ys) +-- Show +-- ---- + +-- | Generic definition of 'Prelude.showsPrec' +showsPrec :: (Vector v a, Show a) => Int -> v a -> ShowS +{-# INLINE showsPrec #-} +showsPrec p v = showParen (p > 10) $ showString "fromList " . shows (toList v) + +-- | Generic definition of 'Text.Read.readPrec' +readPrec :: (Vector v a, Read a) => Read.ReadPrec (v a) +{-# INLINE readPrec #-} +readPrec = Read.parens $ Read.prec 10 $ do + Read.Ident "fromList" <- Read.lexP + xs <- Read.readPrec + return (fromList xs) + -- Data and Typeable -- ----------------- diff --git a/Data/Vector/Primitive.hs b/Data/Vector/Primitive.hs index 56ae9c4..d76479d 100644 --- a/Data/Vector/Primitive.hs +++ b/Data/Vector/Primitive.hs @@ -162,6 +162,7 @@ import qualified Prelude import Data.Typeable ( Typeable ) import Data.Data ( Data(..) ) +import Text.Read ( Read(..), readListPrecDefault ) import Data.Monoid ( Monoid(..) ) @@ -172,7 +173,11 @@ data Vector a = Vector {-# UNPACK #-} !Int deriving ( Typeable ) instance (Show a, Prim a) => Show (Vector a) where - show = (Prelude.++ " :: Data.Vector.Primitive.Vector") . ("fromList " Prelude.++) . show . toList + showsPrec = G.showsPrec + +instance (Read a, Prim a) => Read (Vector a) where + readPrec = G.readPrec + readListPrec = readListPrecDefault instance (Data a, Prim a) => Data (Vector a) where gfoldl = G.gfoldl diff --git a/Data/Vector/Storable.hs b/Data/Vector/Storable.hs index a0985cc..dccd292 100644 --- a/Data/Vector/Storable.hs +++ b/Data/Vector/Storable.hs @@ -165,6 +165,7 @@ import qualified Prelude import Data.Typeable ( Typeable ) import Data.Data ( Data(..) ) +import Text.Read ( Read(..), readListPrecDefault ) import Data.Monoid ( Monoid(..) ) @@ -176,10 +177,11 @@ data Vector a = Vector {-# UNPACK #-} !Int deriving ( Typeable ) instance (Show a, Storable a) => Show (Vector a) where - show = (Prelude.++ " :: Data.Vector.Storable.Vector") - . ("fromList " Prelude.++) - . show - . toList + showsPrec = G.showsPrec + +instance (Read a, Storable a) => Read (Vector a) where + readPrec = G.readPrec + readListPrec = readListPrecDefault instance (Data a, Storable a) => Data (Vector a) where gfoldl = G.gfoldl diff --git a/Data/Vector/Unboxed.hs b/Data/Vector/Unboxed.hs index 3d98bed..8198a60 100644 --- a/Data/Vector/Unboxed.hs +++ b/Data/Vector/Unboxed.hs @@ -184,6 +184,8 @@ import Prelude hiding ( length, null, mapM, mapM_ ) import qualified Prelude +import Text.Read ( Read(..), readListPrecDefault ) + import Data.Monoid ( Monoid(..) ) #include "vector.h" @@ -224,7 +226,11 @@ instance Unbox a => Monoid (Vector a) where mconcat = concat instance (Show a, Unbox a) => Show (Vector a) where - show = (Prelude.++ " :: Data.Vector.Unboxed.Vector") . ("fromList " Prelude.++) . show . toList + showsPrec = G.showsPrec + +instance (Read a, Unbox a) => Read (Vector a) where + readPrec = G.readPrec + readListPrec = readListPrecDefault -- Length information -- ------------------ _______________________________________________ Cvs-libraries mailing list [email protected] http://www.haskell.org/mailman/listinfo/cvs-libraries
