Repository : ssh://darcs.haskell.org//srv/darcs/packages/bytestring On branch : master
http://hackage.haskell.org/trac/ghc/changeset/ddce9a614a3cf9d110100df93079ec88e52466b8 >--------------------------------------------------------------- commit ddce9a614a3cf9d110100df93079ec88e52466b8 Author: Duncan Coutts <[email protected]> Date: Sun Nov 6 18:05:08 2011 +0000 Move the IsString instance so it is not an orphan >--------------------------------------------------------------- Data/ByteString/Char8.hs | 10 ---------- Data/ByteString/Internal.hs | 9 +++++++++ Data/ByteString/Lazy/Char8.hs | 10 ---------- Data/ByteString/Lazy/Internal.hs | 11 ++++++++++- 4 files changed, 19 insertions(+), 21 deletions(-) diff --git a/Data/ByteString/Char8.hs b/Data/ByteString/Char8.hs index 4b255ec..556cd73 100644 --- a/Data/ByteString/Char8.hs +++ b/Data/ByteString/Char8.hs @@ -273,10 +273,6 @@ import GHC.Ptr (Ptr(..)) import GHC.ST (ST(..)) #endif -#if MIN_VERSION_base(3,0,0) -import Data.String (IsString(..)) -#endif - #define STRICT1(f) f a | a `seq` False = undefined #define STRICT2(f) f a b | a `seq` b `seq` False = undefined #define STRICT3(f) f a b c | a `seq` b `seq` c `seq` False = undefined @@ -289,12 +285,6 @@ singleton :: Char -> ByteString singleton = B.singleton . c2w {-# INLINE singleton #-} -#if MIN_VERSION_base(3,0,0) -instance IsString ByteString where - fromString = pack - {-# INLINE fromString #-} -#endif - -- | /O(n)/ Convert a 'String' into a 'ByteString' -- -- For applications with large numbers of string literals, pack can be a diff --git a/Data/ByteString/Internal.hs b/Data/ByteString/Internal.hs index 1c66d53..082b3ac 100644 --- a/Data/ByteString/Internal.hs +++ b/Data/ByteString/Internal.hs @@ -81,6 +81,10 @@ import Foreign.C.String (CString) import Control.DeepSeq (NFData) +#if MIN_VERSION_base(3,0,0) +import Data.String (IsString(..)) +#endif + #ifndef __NHC__ import Control.Exception (assert) #endif @@ -181,6 +185,11 @@ instance Show ByteString where instance Read ByteString where readsPrec p str = [ (packChars x, y) | (x, y) <- readsPrec p str ] +#if MIN_VERSION_base(3,0,0) +instance IsString ByteString where + fromString = packChars +#endif + instance Data ByteString where gfoldl f z txt = z packBytes `f` (unpackBytes txt) toConstr _ = error "Data.ByteString.ByteString.toConstr" diff --git a/Data/ByteString/Lazy/Char8.hs b/Data/ByteString/Lazy/Char8.hs index d1828f2..47337a4 100644 --- a/Data/ByteString/Lazy/Char8.hs +++ b/Data/ByteString/Lazy/Char8.hs @@ -216,10 +216,6 @@ import Control.Exception (bracket) import IO (bracket) #endif -#if __GLASGOW_HASKELL__ >= 608 -import Data.String (IsString(..)) -#endif - #define STRICT1(f) f a | a `seq` False = undefined #define STRICT2(f) f a b | a `seq` b `seq` False = undefined #define STRICT3(f) f a b c | a `seq` b `seq` c `seq` False = undefined @@ -234,12 +230,6 @@ singleton :: Char -> ByteString singleton = L.singleton . c2w {-# INLINE singleton #-} -#if __GLASGOW_HASKELL__ >= 608 -instance IsString ByteString where - fromString = pack - {-# INLINE fromString #-} -#endif - -- | /O(n)/ Convert a 'String' into a 'ByteString'. pack :: [Char] -> ByteString pack = L.pack. List.map c2w diff --git a/Data/ByteString/Lazy/Internal.hs b/Data/ByteString/Lazy/Internal.hs index fddfd45..049a300 100644 --- a/Data/ByteString/Lazy/Internal.hs +++ b/Data/ByteString/Lazy/Internal.hs @@ -45,7 +45,11 @@ import qualified Data.ByteString.Internal as S import Data.Word (Word8) import Foreign.Storable (Storable(sizeOf)) -import Control.DeepSeq (NFData, rnf) +import Control.DeepSeq (NFData, rnf) + +#if MIN_VERSION_base(3,0,0) +import Data.String (IsString(..)) +#endif import Data.Typeable (Typeable) #if MIN_VERSION_base(4,1,0) @@ -80,6 +84,11 @@ instance Show ByteString where instance Read ByteString where readsPrec p str = [ (packChars x, y) | (x, y) <- readsPrec p str ] +#if MIN_VERSION_base(3,0,0) +instance IsString ByteString where + fromString = packChars +#endif + instance Data ByteString where gfoldl f z txt = z packBytes `f` unpackBytes txt toConstr _ = error "Data.ByteString.Lazy.ByteString.toConstr" _______________________________________________ Cvs-libraries mailing list [email protected] http://www.haskell.org/mailman/listinfo/cvs-libraries
