Commit d70ce271 authored by bos's avatar bos
Browse files

Add a Binary instance for strict Text

Step one towards a fix for gh-115.
parent dc49f022
......@@ -195,7 +195,7 @@ module Data.Text
import Prelude (Char, Bool(..), Int, Maybe(..), String,
Eq(..), Ord(..), Ordering(..), (++),
Read(..), Show(..),
Read(..),
(&&), (||), (+), (-), (.), ($), ($!), (>>),
not, return, otherwise, quot)
#if defined(HAVE_DEEPSEQ)
......@@ -211,17 +211,20 @@ import Control.Monad (foldM)
import Control.Monad.ST (ST)
import qualified Data.Text.Array as A
import qualified Data.List as L
import Data.Binary (Binary(get, put))
import Data.Monoid (Monoid(..))
import Data.String (IsString(..))
import qualified Data.Text.Internal.Fusion as S
import qualified Data.Text.Internal.Fusion.Common as S
import Data.Text.Encoding (decodeUtf8, encodeUtf8)
import Data.Text.Internal.Fusion (stream, reverseStream, unstream)
import Data.Text.Internal.Private (span_)
import Data.Text.Internal (Text(..), empty, empty_, firstf, mul, safe, text)
import Data.Text.Internal (Text(..), empty, firstf, mul, safe, text)
import Data.Text.Show (singleton, unpack)
import qualified Prelude as P
import Data.Text.Unsafe (Iter(..), iter, iter_, lengthWord16, reverseIter,
reverseIter_, unsafeHead, unsafeTail)
import Data.Text.Internal.Unsafe.Char (unsafeChr, unsafeWrite)
import Data.Text.Internal.Unsafe.Char (unsafeChr)
import qualified Data.Text.Internal.Functions as F
import qualified Data.Text.Internal.Encoding.Utf16 as U16
import Data.Text.Internal.Search (indices)
......@@ -230,15 +233,9 @@ import Data.ByteString (ByteString)
import qualified Data.Text.Lazy as L
import Data.Int (Int64)
#endif
#if __GLASGOW_HASKELL__ >= 702
import qualified GHC.CString as GHC
#else
import qualified GHC.Base as GHC
#endif
#if __GLASGOW_HASKELL__ >= 708
import qualified GHC.Exts as Exts
#endif
import GHC.Prim (Addr#)
-- $strict
--
......@@ -324,9 +321,6 @@ instance Eq Text where
instance Ord Text where
compare = compareText
instance Show Text where
showsPrec p ps r = showsPrec p (unpack ps) r
instance Read Text where
readsPrec p str = [(pack x,y) | (x,y) <- readsPrec p str]
......@@ -349,6 +343,10 @@ instance Exts.IsList Text where
instance NFData Text where rnf !_ = ()
#endif
instance Binary Text where
put t = put (encodeUtf8 t)
get = P.fmap decodeUtf8 get
-- | This instance preserves data abstraction at the cost of inefficiency.
-- We omit reflection services for the sake of data abstraction.
--
......@@ -401,54 +399,6 @@ pack :: String -> Text
pack = unstream . S.map safe . S.streamList
{-# INLINE [1] pack #-}
-- | /O(n)/ Convert a 'Text' into a 'String'. Subject to fusion.
unpack :: Text -> String
unpack = S.unstreamList . stream
{-# INLINE [1] unpack #-}
-- | /O(n)/ Convert a literal string into a Text. Subject to fusion.
unpackCString# :: Addr# -> Text
unpackCString# addr# = unstream (S.streamCString# addr#)
{-# NOINLINE unpackCString# #-}
{-# RULES "TEXT literal" forall a.
unstream (S.map safe (S.streamList (GHC.unpackCString# a)))
= unpackCString# a #-}
{-# RULES "TEXT literal UTF8" forall a.
unstream (S.map safe (S.streamList (GHC.unpackCStringUtf8# a)))
= unpackCString# a #-}
{-# RULES "TEXT empty literal"
unstream (S.map safe (S.streamList []))
= empty_ #-}
{-# RULES "TEXT singleton literal" forall a.
unstream (S.map safe (S.streamList [a]))
= singleton_ a #-}
-- | /O(1)/ Convert a character into a Text. Subject to fusion.
-- Performs replacement on invalid scalar values.
singleton :: Char -> Text
singleton = unstream . S.singleton . safe
{-# INLINE [1] singleton #-}
{-# RULES "TEXT singleton" forall a.
unstream (S.singleton (safe a))
= singleton_ a #-}
-- This is intended to reduce inlining bloat.
singleton_ :: Char -> Text
singleton_ c = Text (A.run x) 0 len
where x :: ST s (A.MArray s)
x = do arr <- A.new len
_ <- unsafeWrite arr 0 d
return arr
len | d < '\x10000' = 1
| otherwise = 2
d = safe c
{-# NOINLINE singleton_ #-}
-- -----------------------------------------------------------------------------
-- * Basic functions
......
......@@ -84,12 +84,12 @@ import Control.Exception (evaluate, try)
import Control.Monad.ST (runST)
import Data.ByteString as B
import Data.ByteString.Internal as B hiding (c2w)
import Data.Text ()
import Data.Text.Encoding.Error (OnDecodeError, UnicodeException, strictDecode)
import Data.Text.Internal (Text(..), safe, text)
import Data.Text.Internal.Private (runText)
import Data.Text.Internal.Unsafe.Char (unsafeWrite)
import Data.Text.Internal.Unsafe.Shift (shiftR)
import Data.Text.Show ()
import Data.Text.Unsafe (unsafeDupablePerformIO)
import Data.Word (Word8, Word32)
import Foreign.C.Types (CSize(..))
......
{-# LANGUAGE CPP, MagicHash #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}
#if __GLASGOW_HASKELL__ >= 702
{-# LANGUAGE Trustworthy #-}
#endif
-- |
-- Module : Data.Text.Show
-- Copyright : (c) 2009-2015 Bryan O'Sullivan
--
-- License : BSD-style
-- Maintainer : bos@serpentine.com
-- Stability : experimental
-- Portability : GHC
module Data.Text.Show
(
singleton
, unpack
) where
import Control.Monad.ST (ST)
import Data.Text.Internal (Text(..), empty_, safe)
import Data.Text.Internal.Fusion (stream, unstream)
import Data.Text.Internal.Unsafe.Char (unsafeWrite)
import GHC.Prim (Addr#)
import qualified Data.Text.Array as A
import qualified Data.Text.Internal.Fusion.Common as S
#if __GLASGOW_HASKELL__ >= 702
import qualified GHC.CString as GHC
#else
import qualified GHC.Base as GHC
#endif
instance Show Text where
showsPrec p ps r = showsPrec p (unpack ps) r
-- | /O(n)/ Convert a 'Text' into a 'String'. Subject to fusion.
unpack :: Text -> String
unpack = S.unstreamList . stream
{-# INLINE [1] unpack #-}
-- | /O(n)/ Convert a literal string into a Text. Subject to fusion.
unpackCString# :: Addr# -> Text
unpackCString# addr# = unstream (S.streamCString# addr#)
{-# NOINLINE unpackCString# #-}
{-# RULES "TEXT literal" forall a.
unstream (S.map safe (S.streamList (GHC.unpackCString# a)))
= unpackCString# a #-}
{-# RULES "TEXT literal UTF8" forall a.
unstream (S.map safe (S.streamList (GHC.unpackCStringUtf8# a)))
= unpackCString# a #-}
{-# RULES "TEXT empty literal"
unstream (S.map safe (S.streamList []))
= empty_ #-}
{-# RULES "TEXT singleton literal" forall a.
unstream (S.map safe (S.streamList [a]))
= singleton_ a #-}
-- | /O(1)/ Convert a character into a Text. Subject to fusion.
-- Performs replacement on invalid scalar values.
singleton :: Char -> Text
singleton = unstream . S.singleton . safe
{-# INLINE [1] singleton #-}
{-# RULES "TEXT singleton" forall a.
unstream (S.singleton (safe a))
= singleton_ a #-}
-- This is intended to reduce inlining bloat.
singleton_ :: Char -> Text
singleton_ c = Text (A.run x) 0 len
where x :: ST s (A.MArray s)
x = do arr <- A.new len
_ <- unsafeWrite arr 0 d
return arr
len | d < '\x10000' = 1
| otherwise = 2
d = safe c
{-# NOINLINE singleton_ #-}
......@@ -114,6 +114,7 @@ library
Data.Text.Internal.Lazy.Search
Data.Text.Internal.Private
Data.Text.Read
Data.Text.Show
Data.Text.Internal.Read
Data.Text.Internal.Search
Data.Text.Unsafe
......@@ -135,6 +136,7 @@ library
build-depends:
array,
base == 4.*,
binary,
bytestring,
deepseq,
ghc-prim,
......
......@@ -121,9 +121,13 @@ library
Data.Text.Read
Data.Text.Unsafe
other-modules:
Data.Text.Show
build-depends:
array >= 0.3,
base >= 4.2 && < 5,
binary,
deepseq >= 1.1.0.0,
ghc-prim >= 0.2
......@@ -164,6 +168,7 @@ test-suite tests
QuickCheck >= 2.7,
array,
base,
binary,
bytestring,
deepseq,
directory,
......
Supports Markdown
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment