text (empty) → 0.1
raw patch · 16 files changed
+3313/−0 lines, 16 filesdep +basedep +bytestringdep +ghc-primsetup-changed
Dependencies added: base, bytestring, ghc-prim
Files
- Data/Text.hs +982/−0
- Data/Text/Array.hs +345/−0
- Data/Text/Encoding.hs +95/−0
- Data/Text/Encoding/Fusion.hs +336/−0
- Data/Text/Encoding/Utf16.hs +42/−0
- Data/Text/Encoding/Utf32.hs +23/−0
- Data/Text/Encoding/Utf8.hs +151/−0
- Data/Text/Foreign.hs +89/−0
- Data/Text/Fusion.hs +923/−0
- Data/Text/Internal.hs +63/−0
- Data/Text/Unsafe.hs +78/−0
- Data/Text/UnsafeChar.hs +77/−0
- LICENSE +26/−0
- README +35/−0
- Setup.lhs +3/−0
- text.cabal +45/−0
+ Data/Text.hs view
@@ -0,0 +1,982 @@+{-# LANGUAGE BangPatterns #-}+{-# OPTIONS_GHC -fno-warn-orphans #-}++-- |+-- Module : Data.Text+-- Copyright : (c) Tom Harper 2008-2009,+-- (c) Bryan O'Sullivan 2009,+-- (c) Duncan Coutts 2009+--+-- License : BSD-style+-- Maintainer : rtharper@aftereternity.co.uk, bos@serpentine.com,+-- duncan@haskell.org+-- Stability : experimental+-- Portability : GHC+--+-- A time and space-efficient implementation of Unicode text using+-- packed Word16 arrays. Suitable for performance critical use, both+-- in terms of large data quantities and high speed.+--+-- This module is intended to be imported @qualified@, to avoid name+-- clashes with "Prelude" functions, e.g.+--+-- > import qualified Data.Text as T++module Data.Text+ (+ -- * Fusion+ -- $fusion++ -- * Types+ Text++ -- * Creation and elimination+ , pack+ , unpack+ , singleton+ , empty++ -- * Basic interface+ , cons+ , snoc+ , append+ , uncons+ , head+ , last+ , tail+ , init+ , null+ , length++ -- * Transformations+ , map+ , intercalate+ , intersperse+ , transpose+ , reverse++ -- * Folds+ , foldl+ , foldl'+ , foldl1+ , foldl1'+ , foldr+ , foldr1++ -- ** Special folds+ , concat+ , concatMap+ , any+ , all+ , maximum+ , minimum++ -- * Construction++ -- ** Scans+ , scanl+ , scanl1+ , scanr+ , scanr1++ -- ** Accumulating maps+ , mapAccumL+ , mapAccumR++ -- ** Generation and unfolding+ , replicate+ , unfoldr+ , unfoldrN++ -- * Substrings++ -- ** Breaking strings+ , take+ , drop+ , takeWhile+ , dropWhile+ , splitAt+ , span+ , break+ , group+ , groupBy+ , inits+ , tails++ -- ** Breaking into many substrings+ , split+ , splitWith+ , breakSubstring++ -- ** Breaking into lines and words+ , lines+ --, lines'+ , words+ , unlines+ , unwords++ -- * Predicates+ , isPrefixOf+ , isSuffixOf+ , isInfixOf++ -- * Searching+ , elem+ , filter+ , find+ , partition++ -- , findSubstring+ + -- * Indexing+ , index+ , findIndex+ , findIndices+ , elemIndex+ , elemIndices+ , count++ -- * Zipping and unzipping+ , zipWith++ -- -* Ordered text+ , -- sort+ ) where++import Prelude (Char, Bool(..), Functor(..), Int, Maybe(..), String,+ Eq(..), (++),+ Read(..), Show(..),+ (&&), (||), (+), (-), (<), (>), (<=), (>=), (.), ($),+ not, return, otherwise)+import Control.Exception (assert)+import Data.Char (isSpace)+import Control.Monad.ST (ST)+import qualified Data.Text.Array as A+import qualified Data.List as L+import Data.Monoid (Monoid(..))+import Data.Word (Word16)+import Data.String (IsString(..))++import qualified Data.Text.Fusion as S+import Data.Text.Fusion (Stream(..), Step(..), stream, reverseStream, unstream)+import Data.Text.Internal (Text(..), empty, text)+import qualified Prelude as P+import Data.Text.Unsafe (iter, iter_, unsafeHead, unsafeTail)+import Data.Text.UnsafeChar (unsafeChr)+import qualified Data.Text.Encoding.Utf16 as U16++-- $fusion+--+-- Most of the functions in this module are subject to /array fusion/,+-- meaning that a pipeline of functions will usually allocate at most+-- one 'Text' value.++instance Eq Text where+ t1 == t2 = (stream t1) `S.eq` (stream t2)++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]++instance Monoid Text where+ mempty = empty+ mappend = append+ mconcat = concat++instance IsString Text where+ fromString = pack++-- -----------------------------------------------------------------------------+-- * Conversion to/from 'Text'++-- | /O(n)/ Convert a 'String' into a 'Text'.+--+-- This function is subject to array fusion.+pack :: String -> Text+pack str = (unstream (stream_list str))+ where+ stream_list s0 = S.Stream next s0 (P.length s0) -- total guess+ where+ next [] = S.Done+ next (x:xs) = S.Yield x xs+{-# INLINE [1] pack #-}+-- TODO: Has to do validation! -- No, it doesn't, the++-- | /O(n)/ Convert a Text into a String.+-- Subject to array fusion.+unpack :: Text -> String+unpack txt = (unstream_list (stream txt))+ where+ unstream_list (S.Stream next s0 _len) = unfold s0+ where+ unfold !s = case next s of+ S.Done -> []+ S.Skip s' -> unfold s'+ S.Yield x s' -> x : unfold s'+{-# INLINE [1] unpack #-}++-- | /O(1)/ Convert a character into a Text.+-- Subject to array fusion.+singleton :: Char -> Text+singleton c = unstream (Stream next (c:[]) 1)+ where+ {-# INLINE next #-}+ next (k:ks) = Yield k ks+ next [] = Done+{-# INLINE [1] singleton #-}++-- -----------------------------------------------------------------------------+-- * Basic functions++-- | /O(n)/ Adds a character to the front of a 'Text'. This function+-- is more costly than its 'List' counterpart because it requires+-- copying a new array. Subject to array fusion.+cons :: Char -> Text -> Text+cons c t = unstream (S.cons c (stream t))+{-# INLINE cons #-}++-- | /O(n)/ Adds a character to the end of a 'Text'. This copies the+-- entire array in the process. Subject to array fusion.+snoc :: Text -> Char -> Text+snoc t c = unstream (S.snoc (stream t) c)+{-# INLINE snoc #-}++-- | /O(n)/ Appends one 'Text' to the other by copying both of them+-- into a new 'Text'. Subject to array fusion.+append :: Text -> Text -> Text+append (Text arr1 off1 len1) (Text arr2 off2 len2) = Text (A.run x) 0 len+ where+ len = len1+len2+ x = do+ arr <- A.unsafeNew len :: ST s (A.MArray s Word16)+ copy arr1 off1 (len1+off1) arr 0+ copy arr2 off2 (len2+off2) arr len1+ return arr+ where+ copy arr i max arr' j+ | i >= max = return ()+ | otherwise = do A.unsafeWrite arr' j (arr `A.unsafeIndex` i)+ copy arr (i+1) max arr' (j+1)+{-# INLINE append #-}++{-# RULES+"TEXT append -> fused" [~1] forall t1 t2.+ append t1 t2 = unstream (S.append (stream t1) (stream t2))+"TEXT append -> unfused" [1] forall t1 t2.+ unstream (S.append (stream t1) (stream t2)) = append t1 t2+ #-}++-- | /O(1)/ Returns the first character of a 'Text', which must be+-- non-empty. Subject to array fusion.+head :: Text -> Char+head t = S.head (stream t)+{-# INLINE head #-}++-- | /O(1)/ Returns the first character and rest of a 'Text', or+-- 'Nothing' if empty. Subject to array fusion.+uncons :: Text -> Maybe (Char, Text)+uncons t@(Text arr off len)+ | len <= 0 = Nothing+ | otherwise = Just (c, textP arr (off+d) (len-d))+ where (c,d) = iter t 0+{-# INLINE uncons #-}++-- | Lifted from Control.Arrow and specialized.+second :: (b -> c) -> (a,b) -> (a,c)+second f (a, b) = (a, f b)++{-# RULES+"TEXT uncons -> fused" [~1] forall t.+ uncons t = fmap (second unstream) (S.uncons (stream t))+"TEXT uncons -> unfused" [1] forall t.+ fmap (second unstream) (S.uncons (stream t)) = uncons t+ #-}++-- | /O(1)/ Returns the last character of a 'Text', which must be+-- non-empty. Subject to array fusion.+last :: Text -> Char+last (Text arr off len)+ | len <= 0 = emptyError "last"+ | n < 0xDC00 || n > 0xDFFF = unsafeChr n+ | otherwise = U16.chr2 n0 n+ where n = A.unsafeIndex arr (off+len-1)+ n0 = A.unsafeIndex arr (off+len-2)+{-# INLINE [1] last #-}++{-# RULES+"TEXT last -> fused" [~1] forall t.+ last t = S.last (stream t)+"TEXT last -> unfused" [1] forall t.+ S.last (stream t) = last t+ #-}++-- | Construct a 'Text' without invisibly pinning its byte array in+-- memory if its length has dwindled to zero.+textP :: A.Array Word16 -> Int -> Int -> Text+textP arr off len | len == 0 = empty+ | otherwise = text arr off len+{-# INLINE textP #-}++-- | /O(1)/ Returns all characters after the head of a 'Text', which+-- must be non-empty. Subject to array fusion.+tail :: Text -> Text+tail t@(Text arr off len)+ | len <= 0 = emptyError "tail"+ | otherwise = textP arr (off+d) (len-d)+ where d = iter_ t 0+{-# INLINE [1] tail #-}++{-# RULES+"TEXT tail -> fused" [~1] forall t.+ tail t = unstream (S.tail (stream t))+"TEXT tail -> unfused" [1] forall t.+ unstream (S.tail (stream t)) = tail t+ #-}++-- | /O(1)/ Returns all but the last character of a 'Text', which must+-- be non-empty. Subject to array fusion.+init :: Text -> Text+init (Text arr off len) | len <= 0 = emptyError "init"+ | n >= 0xDC00 && n <= 0xDFFF = textP arr off (len-2)+ | otherwise = textP arr off (len-1)+ where+ n = A.unsafeIndex arr (off+len-1)+{-# INLINE [1] init #-}++{-# RULES+"TEXT init -> fused" [~1] forall t.+ init t = unstream (S.init (stream t))+"TEXT init -> unfused" [1] forall t.+ unstream (S.init (stream t)) = init t+ #-}++-- | /O(1)/ Tests whether a 'Text' is empty or not. Subject to array+-- fusion.+null :: Text -> Bool+null (Text _arr _off len) = assert (len >= 0) $ len <= 0+{-# INLINE [1] null #-}++{-# RULES+"TEXT null -> fused" [~1] forall t.+ null t = S.null (stream t)+"TEXT null -> unfused" [1] forall t.+ S.null (stream t) = null t+ #-}++-- | /O(n)/ Returns the number of characters in a 'Text'.+-- Subject to array fusion.+length :: Text -> Int+length t = S.length (stream t)+{-# INLINE length #-}++-- -----------------------------------------------------------------------------+-- * Transformations+-- | /O(n)/ 'map' @f @xs is the 'Text' obtained by applying @f@ to+-- each element of @xs@. Subject to array fusion.+map :: (Char -> Char) -> Text -> Text+map f t = unstream (S.map f (stream t))+{-# INLINE [1] map #-}++-- | /O(n)/ The 'intercalate' function takes a 'Text' and a list of+-- 'Text's and concatenates the list after interspersing the first+-- argument between each element of the list.+intercalate :: Text -> [Text] -> Text+intercalate t ts = unstream (S.intercalate (stream t) (L.map stream ts))+{-# INLINE intercalate #-}++-- | /O(n)/ The 'intersperse' function takes a character and places it+-- between the characters of a 'Text'. Subject to array fusion.+intersperse :: Char -> Text -> Text+intersperse c t = unstream (S.intersperse c (stream t))+{-# INLINE intersperse #-}++-- | /O(n)/ Reverse the characters of a string. Subject to array fusion.+reverse :: Text -> Text+reverse t = S.reverse (stream t)+{-# INLINE reverse #-}++-- | /O(n)/ The 'transpose' function transposes the rows and columns+-- of its 'Text' argument. Note that this function uses 'pack',+-- 'unpack', and the list version of transpose, and is thus not very+-- efficient.+transpose :: [Text] -> [Text]+transpose ts = P.map pack (L.transpose (P.map unpack ts))++-- -----------------------------------------------------------------------------+-- * Reducing 'Text's (folds)++-- | /O(n)/ 'foldl', applied to a binary operator, a starting value+-- (typically the left-identity of the operator), and a 'Text',+-- reduces the 'Text' using the binary operator, from left to right.+-- Subject to array fusion.+foldl :: (b -> Char -> b) -> b -> Text -> b+foldl f z t = S.foldl f z (stream t)+{-# INLINE foldl #-}++-- | /O(n)/ A strict version of 'foldl'.+-- Subject to array fusion.+foldl' :: (b -> Char -> b) -> b -> Text -> b+foldl' f z t = S.foldl' f z (stream t)+{-# INLINE foldl' #-}++-- | /O(n)/ A variant of 'foldl' that has no starting value argument,+-- and thus must be applied to a non-empty 'Text'. Subject to array+-- fusion.+foldl1 :: (Char -> Char -> Char) -> Text -> Char+foldl1 f t = S.foldl1 f (stream t)+{-# INLINE foldl1 #-}++-- | /O(n)/ A strict version of 'foldl1'.+-- Subject to array fusion.+foldl1' :: (Char -> Char -> Char) -> Text -> Char+foldl1' f t = S.foldl1' f (stream t)+{-# INLINE foldl1' #-}++-- | /O(n)/ 'foldr', applied to a binary operator, a starting value+-- (typically the right-identity of the operator), and a 'Text',+-- reduces the 'Text' using the binary operator, from right to left.+-- Subject to array fusion.+foldr :: (Char -> b -> b) -> b -> Text -> b+foldr f z t = S.foldr f z (stream t)+{-# INLINE foldr #-}++-- | /O(n)/ A variant of 'foldr' that has no starting value argument, and+-- thust must be applied to a non-empty 'Text'. Subject to array+-- fusion.+foldr1 :: (Char -> Char -> Char) -> Text -> Char+foldr1 f t = S.foldr1 f (stream t)+{-# INLINE foldr1 #-}++-- -----------------------------------------------------------------------------+-- ** Special folds++-- | /O(n)/ Concatenate a list of 'Text's. Subject to array fusion.+concat :: [Text] -> Text+concat ts = unstream (S.concat (L.map stream ts))+{-# INLINE concat #-}++-- | /O(n)/ Map a function over a 'Text' that results in a 'Text', and+-- concatenate the results. This function is subject to array fusion.+--+-- Note: if in 'concatMap' @f@ @t@, @f@ is defined in terms of fusible+-- functions, it will also be fusible.+concatMap :: (Char -> Text) -> Text -> Text+concatMap f t = unstream (S.concatMap (stream . f) (stream t))+{-# INLINE concatMap #-}++-- | /O(n)/ 'any' @p@ @t@ determines whether any character in the+-- 'Text' @t@ satisifes the predicate @p@. Subject to array fusion.+any :: (Char -> Bool) -> Text -> Bool+any p t = S.any p (stream t)+{-# INLINE any #-}++-- | /O(n)/ 'all' @p@ @t@ determines whether all characters in the+-- 'Text' @t@ satisify the predicate @p@. Subject to array fusion.+all :: (Char -> Bool) -> Text -> Bool+all p t = S.all p (stream t)+{-# INLINE all #-}++-- | /O(n)/ 'maximum' returns the maximum value from a 'Text', which+-- must be non-empty. Subject to array fusion.+maximum :: Text -> Char+maximum t = S.maximum (stream t)+{-# INLINE maximum #-}++-- | /O(n)/ 'minimum' returns the minimum value from a 'Text', which+-- must be non-empty. Subject to array fusion.+minimum :: Text -> Char+minimum t = S.minimum (stream t)+{-# INLINE minimum #-}++-- -----------------------------------------------------------------------------+-- * Building 'Text's++-- | /O(n)/ 'scanl' is similar to 'foldl', but returns a list of+-- successive reduced values from the left. This function is subject+-- to array fusion.+--+-- > scanl f z [x1, x2, ...] == [z, z `f` x1, (z `f` x1) `f` x2, ...]+--+-- Note that+--+-- > last (scanl f z xs) == foldl f z xs.+scanl :: (Char -> Char -> Char) -> Char -> Text -> Text+scanl f z t = unstream (S.scanl f z (stream t))+{-# INLINE scanl #-}++-- | /O(n)/ 'scanl1' is a variant of 'scanl' that has no starting+-- value argument. This function is subject to array fusion.+--+-- > scanl1 f [x1, x2, ...] == [x1, x1 `f` x2, ...]+scanl1 :: (Char -> Char -> Char) -> Text -> Text+scanl1 f t | null t = empty+ | otherwise = scanl f (unsafeHead t) (unsafeTail t)+{-# INLINE scanl1 #-}++-- | /O(n)/ 'scanr' is the right-to-left dual of 'scanl'.+--+-- > scanr f v t == reverse (scanl (flip f) v t)+scanr :: (Char -> Char -> Char) -> Char -> Text -> Text+scanr f z = S.reverse . S.reverseScanr f z . reverseStream+{-# INLINE scanr #-}++-- | /O(n)/ 'scanr1' is a variant of 'scanr' that has no starting+-- value argument. This function is subject to array fusion.+scanr1 :: (Char -> Char -> Char) -> Text -> Text+scanr1 f t | null t = empty+ | otherwise = scanr f (last t) (init t)+{-# INLINE scanr1 #-}++-- | /O(n)/ Like a combination of 'map' and 'foldl'. Applies a+-- function to each element of a 'Text', passing an accumulating+-- parameter from left to right, and returns a final 'Text'.+mapAccumL :: (a -> Char -> (a,Char)) -> a -> Text -> (a, Text)+mapAccumL f s t = case uncons t of+ Nothing -> (s, empty)+ Just (x, xs) -> (s'', cons y ys)+ where (s', y ) = f s x+ (s'',ys) = mapAccumL f s' xs++-- | The 'mapAccumR' function behaves like a combination of 'map' and+-- 'foldr'; it applies a function to each element of a 'Text', passing+-- an accumulating parameter from right to left, and returning a final+-- value of this accumulator together with the new 'Text'.+mapAccumR :: (a -> Char -> (a,Char)) -> a -> Text -> (a, Text)+mapAccumR f s t = case uncons t of+ Nothing -> (s, empty)+ Just (x, xs) -> (s'', cons y ys)+ where (s'',y ) = f s' x+ (s', ys) = mapAccumR f s xs++-- -----------------------------------------------------------------------------+-- ** Generating and unfolding 'Text's++-- | /O(n)/ 'replicate' @n@ @c@ is a 'Text' of length @n@ with @c@ the+-- value of every element.+replicate :: Int -> Char -> Text+replicate n c = unstream (S.replicate n c)+{-# INLINE replicate #-}++-- | /O(n)/, where @n@ is the length of the result. The 'unfoldr'+-- function is analogous to the List 'L.unfoldr'. 'unfoldr' builds a+-- 'Text' from a seed value. The function takes the element and+-- returns 'Nothing' if it is done producing the 'Text', otherwise+-- 'Just' @(a,b)@. In this case, @a@ is the next 'Char' in the+-- string, and @b@ is the seed value for further production.+unfoldr :: (a -> Maybe (Char,a)) -> a -> Text+unfoldr f s = unstream (S.unfoldr f s)+{-# INLINE unfoldr #-}++-- | /O(n)/ Like 'unfoldr', 'unfoldrN' builds a 'Text' from a seed+-- value. However, the length of the result should be limited by the+-- first argument to 'unfoldrN'. This function is more efficient than+-- 'unfoldr' when the maximum length of the result is known and+-- correct, otherwise its performance is similar to 'unfoldr'.+unfoldrN :: Int -> (a -> Maybe (Char,a)) -> a -> Text+unfoldrN n f s = unstream (S.unfoldrN n f s)+{-# INLINE unfoldrN #-}++-- -----------------------------------------------------------------------------+-- * Substrings++-- | /O(n)/ 'take' @n@, applied to a 'Text', returns the prefix of the+-- 'Text' of length @n@, or the 'Text' itself if @n@ is greater than+-- the length of the Text.+take :: Int -> Text -> Text+take n t@(Text arr off len)+ | n <= 0 = empty+ | n >= len = t+ | otherwise = Text arr off (loop 0 0)+ where+ loop !i !cnt+ | i >= len || cnt >= n = i+ | otherwise = loop (i+d) (cnt+1)+ where d = iter_ t i+{-# INLINE [1] take #-}++{-# RULES+"TEXT take -> fused" [~1] forall n t.+ take n t = unstream (S.take n (stream t))+"TEXT take -> unfused" [1] forall n t.+ unstream (S.take n (stream t)) = take n t+ #-}++-- | /O(n)/ 'drop' @n@, applied to a 'Text', returns the suffix of the+-- 'Text' of length @n@, or the empty 'Text' if @n@ is greater than the+-- length of the 'Text'.+drop :: Int -> Text -> Text+drop n t@(Text arr off len)+ | n <= 0 = t+ | n >= len = empty+ | otherwise = loop 0 0+ where end = off + len+ loop !i !cnt+ | i >= end || cnt >= n = Text arr (off+i) (len-i)+ | otherwise = loop (i+d) (cnt+1)+ where d = iter_ t i+{-# INLINE [1] drop #-}++{-# RULES+"TEXT drop -> fused" [~1] forall n t.+ drop n t = unstream (S.drop n (stream t))+"TEXT drop -> unfused" [1] forall n t.+ unstream (S.drop n (stream t)) = drop n t+ #-}++-- | /O(n)/ 'takeWhile', applied to a predicate @p@ and a 'Text', returns+-- the longest prefix (possibly empty) of elements that satisfy @p@.+-- This function is subject to array fusion.+takeWhile :: (Char -> Bool) -> Text -> Text+takeWhile p t@(Text arr off len) = loop 0+ where loop !i | i >= len = t+ | p c = loop (i+d)+ | otherwise = textP arr off i+ where (c,d) = iter t i+{-# INLINE [1] takeWhile #-}++{-# RULES+"TEXT takeWhile -> fused" [~1] forall p t.+ takeWhile p t = unstream (S.takeWhile p (stream t))+"TEXT takeWhile -> unfused" [1] forall p t.+ unstream (S.takeWhile p (stream t)) = takeWhile p t+ #-}++-- | /O(n)/ 'dropWhile' @p@ @xs@ returns the suffix remaining after+-- 'takeWhile' @p@ @xs@. This function is subject to array fusion.+dropWhile :: (Char -> Bool) -> Text -> Text+dropWhile p t@(Text arr off len) = loop 0 0+ where loop !i !l | l >= len = empty+ | p c = loop (i+d) (l+d)+ | otherwise = Text arr (off+i) (len-l)+ where (c,d) = iter t i+{-# INLINE [1] dropWhile #-}++{-# RULES+"TEXT dropWhile -> fused" [~1] forall p t.+ dropWhile p t = unstream (S.dropWhile p (stream t))+"TEXT dropWhile -> unfused" [1] forall p t.+ unstream (S.dropWhile p (stream t)) = dropWhile p t+ #-}++-- | /O(n)/ 'splitAt' @n t@ returns a pair whose first element is a+-- prefix of @t@ of length @n@, and whose second is the remainder of+-- the string. It is equivalent to @('take' n t, 'drop' n t)@.+splitAt :: Int -> Text -> (Text, Text)+splitAt n t@(Text arr off len)+ | n <= 0 = (empty, t)+ | n >= len = (t, empty)+ | otherwise = (Text arr off k, Text arr (off+k) (len-k))+ where k = loop 0 0+ loop !i !cnt+ | i >= len || cnt >= n = i+ | otherwise = loop (i+d) (cnt+1)+ where d = iter_ t i+{-# INLINE splitAt #-}++-- | /O(n)/ 'span', applied to a predicate @p@ and text @t@, returns a+-- pair whose first element is the longest prefix (possibly empty) of+-- @t@ of elements that satisfy @p@, and whose second is the remainder+-- of the list.+span :: (Char -> Bool) -> Text -> (Text, Text)+span p t@(Text arr off len) = (textP arr off k, textP arr (off+k) (len-k))+ where k = loop 0+ loop !i | i >= len || not (p c) = i+ | otherwise = loop (i+d)+ where (c,d) = iter t i+{-# INLINE span #-}++-- | /O(n)/ 'break' is like 'span', but the prefix returned is over+-- elements that fail the predicate @p@.+break :: (Char -> Bool) -> Text -> (Text, Text)+break p = span (not . p)+{-# INLINE break #-}++-- | /O(n)/ Group characters in a string according to a predicate.+groupBy :: (Char -> Char -> Bool) -> Text -> [Text]+groupBy p = loop+ where+ loop t@(Text arr off len)+ | null t = []+ | otherwise = text arr off n : loop (text arr (off+n) (len-n))+ where (c,d) = iter t 0+ n = d + findAIndexOrEnd (not . p c) (Text arr (off+d) (len-d))++-- | Returns the /array/ index (in units of 'Word16') at which a+-- character may be found. This is /not/ the same as the logical+-- index returned by e.g. 'findIndex'.+findAIndexOrEnd :: (Char -> Bool) -> Text -> Int+findAIndexOrEnd q t@(Text _arr _off len) = go 0+ where go !i | i >= len || q c = i+ | otherwise = go (i+d)+ where (c,d) = iter t i+ +-- | /O(n)/ Group characters in a string by equality.+group :: Text -> [Text]+group = groupBy (==)++-- | /O(n)/ Return all initial segments of the given 'Text', shortest+-- first.+inits :: Text -> [Text]+inits t@(Text arr off len) = loop 0+ where loop i | i >= len = [t]+ | otherwise = Text arr off i : loop (i + iter_ t i)++-- | /O(n)/ Return all final segments of the given 'Text', longest+-- first.+tails :: Text -> [Text]+tails t | null t = [empty]+ | otherwise = t : tails (unsafeTail t)++-- | /O(n)/ Break a 'Text' into pieces separated by the 'Char'+-- argument, consuming the delimiter. I.e.+--+-- > split '\n' "a\nb\nd\ne" == ["a","b","d","e"]+-- > split 'a' "aXaXaXa" == ["","X","X","X",""]+-- > split 'x' "x" == ["",""]+-- +-- and+--+-- > intercalate (singleton c) . split c == id+-- > split == splitWith . (==)+-- +-- As for all splitting functions in this library, this function does+-- not copy the substrings, it just constructs new 'Text's that are+-- slices of the original.+split :: Char -> Text -> [Text]+split c = splitWith (==c)+{-# INLINE split #-}++-- | /O(n)/ Splits a 'Text' into components delimited by separators,+-- where the predicate returns True for a separator element. The+-- resulting components do not contain the separators. Two adjacent+-- separators result in an empty component in the output. eg.+--+-- > splitWith (=='a') "aabbaca" == ["","","bb","c",""]+-- > splitWith (=='a') [] == []+splitWith :: (Char -> Bool) -> Text -> [Text]+splitWith p = loop+ where loop s | null s = []+ | otherwise = if null s'+ then [s]+ else l : loop (unsafeTail s')+ where (l, s') = break p s+{-# INLINE splitWith #-}++-- ----------------------------------------------------------------------------+-- * Searching++-------------------------------------------------------------------------------+-- ** Searching by equality++-- | /O(n)/ 'elem' is the 'Text' membership predicate.+elem :: Char -> Text -> Bool+elem c t = S.elem c (stream t)+{-# INLINE elem #-}++-------------------------------------------------------------------------------+-- ** Searching with a predicate++-- | /O(n)/ The 'find' function takes a predicate and a 'Text',+-- and returns the first element in matching the predicate, or 'Nothing'+-- if there is no such element.+find :: (Char -> Bool) -> Text -> Maybe Char+find p t = S.find p (stream t)+{-# INLINE find #-}++-- | /O(n)/ The 'partition' function takes a predicate and a 'Text',+-- and returns the pair of 'Text's with elements which do and do not+-- satisfy the predicate, respectively; i.e.+--+-- > partition p t == (filter p t, filter (not . p) t)+partition :: (Char -> Bool) -> Text -> (Text, Text)+partition p t = (filter p t, filter (not . p) t)+{-# INLINE partition #-}++-- | /O(n)/ Break a string on a substring, returning a pair of the+-- part of the string prior to the match, and the rest of the string.+--+-- The following relationship holds:+--+-- > break (==c) l == breakSubstring (singleton c) l+--+-- For example, to tokenise a string, dropping delimiters:+--+-- > tokenise x y = h : if null t then [] else tokenise x (drop (length x) t)+-- > where (h,t) = breakSubstring x y+--+-- To skip to the first occurence of a string:+--+-- > snd (breakSubstring x y)+--+-- To take the parts of a string before a delimiter:+--+-- > fst (breakSubstring x y)+--+breakSubstring :: Text -- ^ String to search for+ -> Text -- ^ String to search in+ -> (Text,Text) -- ^ Head and tail of string broken at substring++breakSubstring pat src = search 0 src+ where+ search !n !s+ | null s = (src,empty) -- not found+ | pat `isPrefixOf` s = (take n src,s)+ | otherwise = search (n+1) (unsafeTail s)+{-# INLINE breakSubstring #-}++-- | /O(n)/ 'filter', applied to a predicate and a 'Text',+-- returns a 'Text' containing those characters that satisfy the+-- predicate.+filter :: (Char -> Bool) -> Text -> Text+filter p t = unstream (S.filter p (stream t))+{-# INLINE filter #-}+++-------------------------------------------------------------------------------+-- ** Indexing 'Text's++-- | /O(1)/ 'Text' index (subscript) operator, starting from 0.+index :: Text -> Int -> Char+index t n = S.index (stream t) n+{-# INLINE index #-}++-- | /O(n)/ The 'findIndex' function takes a predicate and a 'Text'+-- and returns the index of the first element in the 'Text' satisfying+-- the predicate. This function is subject to fusion.+findIndex :: (Char -> Bool) -> Text -> Maybe Int+findIndex p t = S.findIndex p (stream t)+{-# INLINE findIndex #-}++-- | The 'findIndices' function extends 'findIndex', by returning the+-- indices of all elements satisfying the predicate, in ascending+-- order. This function is subject to fusion.+findIndices :: (Char -> Bool) -> Text -> [Int]+findIndices p t = S.findIndices p (stream t)+{-# INLINE findIndices #-}++-- | /O(n)/ The 'elemIndex' function returns the index of the first+-- element in the given 'Text' which is equal to the query element, or+-- 'Nothing' if there is no such element. This function is subject to+-- fusion.+elemIndex :: Char -> Text -> Maybe Int+elemIndex c t = S.elemIndex c (stream t)+{-# INLINE elemIndex #-}++-- | /O(n)/ The 'elemIndices' function returns the index of every+-- element in the given 'Text' which is equal to the query+-- element. This function is subject to fusion.+elemIndices :: Char -> Text -> [Int]+elemIndices c t = S.elemIndices c (stream t)+{-# INLINE elemIndices #-}++-- | /O(n)/ The 'count' function returns the number of times the query+-- element appears in the given 'Text'. This function is subject to+-- fusion.+count :: Char -> Text -> Int+count c t = S.count c (stream t)+{-# INLINE count #-}++-------------------------------------------------------------------------------+-- * Zipping++-- | /O(n)/ 'zipWith' generalises 'zip' by zipping with the function+-- given as the first argument, instead of a tupling function.+zipWith :: (Char -> Char -> Char) -> Text -> Text -> Text+zipWith f t1 t2 = unstream (S.zipWith f (stream t1) (stream t2))++-- | /O(n)/ Breaks a 'Text' up into a list of words, delimited by 'Char's+-- representing white space.+words :: Text -> [Text]+words t@(Text arr off len) = loop 0 0+ where+ loop !start !n+ | n >= len = if start == n+ then []+ else [Text arr (start+off) (n-start)]+ | isSpace c =+ if start == n+ then loop (start+1) (start+1)+ else Text arr (start+off) (n-start) : loop (n+d) (n+d)+ | otherwise = loop start (n+d)+ where (c,d) = iter t n+{-# INLINE words #-}++-- | /O(n)/ Breaks a 'Text' up into a list of 'Text's at+-- newline 'Char's. The resulting strings do not contain newlines.+lines :: Text -> [Text]+lines ps | null ps = []+ | otherwise = h : if null t+ then []+ else lines (unsafeTail t)+ where (h,t) = span (/= '\n') ps+{-# INLINE lines #-}++-- | /O(n)/ Portably breaks a 'Text' up into a list of 'Text's at line+-- boundaries.+--+-- A line boundary is considered to be either a line feed, a carriage+-- return immediately followed by a line feed, or a carriage return.+-- This accounts for both Unix and Windows line ending conventions,+-- and for the old convention used on Mac OS 9 and earlier.+{-+lines' :: Text -> [Text]+lines' ps | null ps = []+ | otherwise = h : case uncons t of+ Nothing -> []+ Just (c,t')+ | c == '\n' -> lines t'+ | c == '\r' -> case uncons t' of+ Just ('\n',t'') -> lines t''+ _ -> lines t'+ where (h,t) = span notEOL ps+ notEOL c = c /= '\n' && c /= '\r'+{-# INLINE lines' #-}+-}++-- | /O(n)/ Joins lines, after appending a terminating newline to+-- each.+unlines :: [Text] -> Text+unlines = concat . L.map (`snoc` '\n')+{-# INLINE unlines #-}++-- | /O(n)/ Joins words using single space characters.+unwords :: [Text] -> Text+unwords = intercalate (singleton ' ')+{-# INLINE unwords #-}++-- | /O(n)/ The 'isPrefixOf' function takes two 'Text's and returns+-- 'True' iff the first is a prefix of the second. This function is+-- subject to fusion.+isPrefixOf :: Text -> Text -> Bool+isPrefixOf a@(Text _ _ alen) b@(Text _ _ blen) =+ alen <= blen && S.isPrefixOf (stream a) (stream b)+{-# INLINE [1] isPrefixOf #-}++{-# RULES+"TEXT isPrefixOf -> fused" [~1] forall s t.+ isPrefixOf s t = S.isPrefixOf (stream s) (stream t)+"TEXT isPrefixOf -> unfused" [1] forall s t.+ S.isPrefixOf (stream s) (stream t) = isPrefixOf s t+ #-}++-- | /O(n)/ The 'isSuffixOf' function takes two 'Text's and returns+-- 'True' iff the first is a suffix of the second.+isSuffixOf :: Text -> Text -> Bool+isSuffixOf a@(Text _aarr _aoff alen) b@(Text barr boff blen) =+ d >= 0 && a == b'+ where d = blen - alen+ b' | d == 0 = b+ | otherwise = Text barr (boff+d) alen+{-# INLINE isSuffixOf #-}++-- | /O(n)/ The 'isInfixOf' function takes two 'Text's and returns+-- 'True' iff the first is contained, wholly and intact, anywhere+-- within the second.+isInfixOf :: Text -> Text -> Bool+isInfixOf needle haystack = L.any (isPrefixOf needle) (tails haystack)+{-# INLINE isInfixOf #-}++emptyError :: String -> a+emptyError fun = P.error ("Data.Text." ++ fun ++ ": empty input")
+ Data/Text/Array.hs view
@@ -0,0 +1,345 @@+{-# LANGUAGE BangPatterns, CPP, ExistentialQuantification, MagicHash,+ Rank2Types, ScopedTypeVariables, UnboxedTuples #-}+-- |+-- Module : Data.Text.Array+-- Copyright : (c) Bryan O'Sullivan 2009+--+-- License : BSD-style+-- Maintainer : bos@serpentine.com,+-- Stability : experimental+-- Portability : portable+--+-- Packed, unboxed, heap-resident arrays. Suitable for performance+-- critical use, both in terms of large data quantities and high+-- speed.+--+-- This module is intended to be imported @qualified@, to avoid name+-- clashes with "Prelude" functions, e.g.+--+-- > import qualified Data.Text.Array as A+--+-- The names in this module resemble those in the 'Data.Array' family+-- of modules, but are shorter due to the assumption of qualifid+-- naming.+module Data.Text.Array+ (+ -- * Types+ IArray(..)+ , Elt(..)+ , Array+ , MArray++ -- * Functions+ , empty+ , new+ , unsafeNew+ , unsafeFreeze+ , run+ , run2+ , toList+ , copy+ , unsafeCopy+ ) where++#if 0+#define BOUNDS_CHECKING+-- This fugly hack is brought by GHC's apparent reluctance to deal+-- with MagicHash and UnboxedTuples when inferring types. Eek!+#define CHECK_BOUNDS(_func_,_len_,_k_) \+if (_k_) < 0 || (_k_) >= (_len_) then error ("Data.Text.Array." ++ (_func_) ++ ": bounds error, offset " ++ show (_k_) ++ ", length " ++ show (_len_)) else+#else+#define CHECK_BOUNDS(_func_,_len_,_k_)+#endif++#if defined(__GLASGOW_HASKELL__)+#include "MachDeps.h"++import GHC.Base (ByteArray#, MutableByteArray#, Int(..), indexIntArray#,+ indexWord16Array#, newByteArray#, readIntArray#,+ readWord16Array#, unsafeCoerce#, writeIntArray#,+ writeWord16Array#, (+#), (*#))+import GHC.Prim (Int#)+import GHC.ST (ST(..), runST)+import GHC.Word (Word16(..))++#elif defined(__HUGS__)++import Hugs.ByteArray (ByteArray, MutableByteArray, readByteArray,+ newMutableByteArray, readMutableByteArray,+ unsafeFreezeMutableByteArray, writeMutableByteArray)+import Foreign.Storable (Storable, sizeOf)+import Hugs.ST (ST(..), runST)++#else+# error not implemented for this compiler+#endif++import Control.Exception (assert)+import Data.Typeable (Typeable1(..), Typeable2(..), TyCon, mkTyCon, mkTyConApp)+import Data.Word (Word16)+import Prelude hiding (length, read)++#include "Typeable.h"++-- | Immutable array type.+data Array e = Array+ {-# UNPACK #-} !Int -- length (in units of e, not bytes)+#if defined(__GLASGOW_HASKELL__)+ ByteArray#+#elif defined(__HUGS__)+ !ByteArray+#endif++INSTANCE_TYPEABLE1(Array,arrayTc,"Array")++-- | Mutable array type, for use in the ST monad.+data MArray s e = MArray+ {-# UNPACK #-} !Int -- length (in units of e, not bytes)+#if defined(__GLASGOW_HASKELL__)+ (MutableByteArray# s)+#elif defined(__HUGS__)+ !(MutableByteArray s)+#endif++INSTANCE_TYPEABLE2(MArray,mArrayTc,"MArray")++-- | Operations supported by all arrays.+class IArray a where+ -- | Return the length of an array.+ length :: a -> Int++instance IArray (Array e) where+ length (Array len _ba) = len+ {-# INLINE length #-}++instance (Elt e, Show e) => Show (Array e) where+ show = show . toList++instance IArray (MArray s e) where+ length (MArray len _ba) = len+ {-# INLINE length #-}++check :: IArray a => String -> a -> Int -> (a -> Int -> b) -> b+check func ary i f+ | i >= 0 && i < length ary = f ary i+ | otherwise = error ("Data.Array.Flat." ++ func ++ ": index out of bounds")+{-# INLINE check #-}++-- | Operations supported by all elements that can be stored in+-- arrays.+class Elt e where+ -- | Indicate how many bytes would be used for an array of the+ -- given size.+ bytesInArray :: Int -> e -> Int+ -- | Unchecked read of an immutable array. May return garbage or+ -- crash on an out-of-bounds access.+ unsafeIndex :: Array e -> Int -> e+ -- | Unchecked read of a mutable array. May return garbage or+ -- crash on an out-of-bounds access.+ unsafeRead :: MArray s e -> Int -> ST s e+ -- | Unchecked write of a mutable array. May return garbage or+ -- crash on an out-of-bounds access.+ unsafeWrite :: MArray s e -> Int -> e -> ST s ()++ -- | Read an immutable array. An invalid index results in a+ -- runtime error.+ index :: Array e -> Int -> e+ index ary i = check "index" ary i unsafeIndex+ {-# INLINE index #-}++ -- | Read a mutable array. An invalid index results in a runtime+ -- error.+ read :: Array e -> Int -> ST s e+ read ary i = check "read" ary i read+ {-# INLINE read #-}++ -- | Write a mutable array. An invalid index results in a runtime+ -- error.+ write :: Array e -> Int -> ST s e+ write ary i = check "write" ary i write+ {-# INLINE write #-}++-- | Freeze a mutable array. Do not mutate the 'MArray' afterwards!+unsafeFreeze :: MArray s e -> ST s (Array e)++#if defined(__GLASGOW_HASKELL__)++iNT_SCALE :: Int# -> Int#+iNT_SCALE n# = scale# *# n# where I# scale# = SIZEOF_INT++wORD16_SCALE :: Int# -> Int#+wORD16_SCALE n# = scale# *# n# where I# scale# = SIZEOF_WORD16++-- | Create an uninitialized mutable array.+unsafeNew :: forall s e. Elt e => Int -> ST s (MArray s e)+unsafeNew n = assert (n >= 0) . ST $ \s1# ->+ case bytesInArray n (undefined :: e) of+ len@(I# len#) ->+#if defined(BOUNDS_CHECKING)+ if len < 0 then error (show ("unsafeNew",len)) else+#endif+ case newByteArray# len# s1# of+ (# s2#, marr# #) -> (# s2#, MArray n marr# #)+{-# INLINE unsafeNew #-}++unsafeFreeze (MArray len mba#) = ST $ \s# ->+ (# s#, Array len (unsafeCoerce# mba#) #)+{-# INLINE unsafeFreeze #-}++-- | Create a mutable array, with its elements initialized with the+-- given value.+new :: forall s e. Elt e => Int -> e -> ST s (MArray s e)++#elif defined(__HUGS__)++unsafeIndexArray :: Storable e => Array e -> Int -> e+unsafeIndexArray (Array off len arr) i =+ assert (i >= 0 && i < len) $ readByteArray arr (off + i)++unsafeReadMArray :: Storable e => MArray s e -> Int -> ST s e+unsafeReadMArray (MArray _len marr) i =+ assert (i >= 0 && i < len) $ readMutableByteArray marr++unsafeWriteMArray :: Storable e => MArray s e -> Int -> e -> ST s ()+unsafeWriteMArray (MArray len marr) i =+ assert (i >= 0 && i < len) $ writeMutableByteArray marr++-- | Create an uninitialized mutable array.+unsafeNew :: (Storable e) => Int -> ST s (MArray s e)+unsafeNew n = new undefined+ where new :: (Storable e) => e -> ST s (MArray s e)+ new unused = do+ marr <- newMutableByteArray (n * sizeOf unused)+ return (MArray n marr)++unsafeFreeze (MArray len mba) = do+ ba <- unsafeFreezeMutableByteArray mba+ return (Array 0 len ba)++-- | Create a mutable array, with its elements initialized with the+-- given value.+new :: (Storable e) => Int -> e -> ST s (MArray s e)+#endif++new len initVal = do+ marr <- unsafeNew len+ sequence_ [unsafeWrite marr i initVal | i <- [0..len-1]]+ return marr++instance Elt Int where+#if defined(__GLASGOW_HASKELL__)++ bytesInArray (I# i#) _ = I# (iNT_SCALE i#)+ {-# INLINE bytesInArray #-}++ unsafeIndex (Array len ba#) i@(I# i#) =+ CHECK_BOUNDS("unsafeIndex",len,i)+ case indexIntArray# ba# i# of r# -> (I# r#)+ {-# INLINE unsafeIndex #-}++ unsafeRead (MArray len mba#) i@(I# i#) = ST $ \s# ->+ CHECK_BOUNDS("unsafeRead",len,i)+ case readIntArray# mba# i# s# of+ (# s2#, r# #) -> (# s2#, I# r# #)+ {-# INLINE unsafeRead #-}++ unsafeWrite (MArray len marr#) i@(I# i#) (I# e#) = ST $ \s1# ->+ CHECK_BOUNDS("unsafeWrite",len,i)+ case writeIntArray# marr# i# e# s1# of+ s2# -> (# s2#, () #)+ {-# INLINE unsafeWrite #-}++#elif defined(__HUGS__)++ bytesInArray n w = sizeOf w * n+ unsafeIndex = unsafeIndexArray+ unsafeRead = unsafeReadMArray+ unsafeWrite = unsafeWriteMArray++#endif++instance Elt Word16 where+#if defined(__GLASGOW_HASKELL__)++ bytesInArray (I# i#) _ = I# (wORD16_SCALE i#)+ {-# INLINE bytesInArray #-}++ unsafeIndex (Array len ba#) i@(I# i#) =+ CHECK_BOUNDS("unsafeIndex",len,i)+ case indexWord16Array# ba# i# of r# -> (W16# r#)+ {-# INLINE unsafeIndex #-}++ unsafeRead (MArray len mba#) i@(I# i#) = ST $ \s# ->+ CHECK_BOUNDS("unsafeRead",len,i)+ case readWord16Array# mba# i# s# of+ (# s2#, r# #) -> (# s2#, W16# r# #)+ {-# INLINE unsafeRead #-}++ unsafeWrite (MArray len marr#) i@(I# i#) (W16# e#) = ST $ \s1# ->+ CHECK_BOUNDS("unsafeWrite",len,i)+ case writeWord16Array# marr# i# e# s1# of+ s2# -> (# s2#, () #)+ {-# INLINE unsafeWrite #-}++#elif defined(__HUGS__)++ bytesInArray n w = sizeOf w * n+ unsafeIndex = unsafeIndexArray+ unsafeRead = unsafeReadMArray+ unsafeWrite = unsafeWriteMArray++#endif++-- | Convert an immutable array to a list.+toList :: Elt e => Array e -> [e]+toList a = loop 0+ where loop i | i < len = unsafeIndex a i : loop (i+1)+ | otherwise = []+ len = length a++-- | An empty immutable array.+empty :: Elt e => Array e+empty = runST (unsafeNew 0 >>= unsafeFreeze)++-- | Run an action in the ST monad and return an immutable array of+-- its result.+run :: Elt e => (forall s. ST s (MArray s e)) -> Array e+run k = runST (k >>= unsafeFreeze)++-- | Run an action in the ST monad and return an immutable array of+-- its result paired with whatever else the action returns.+run2 :: Elt e => (forall s. ST s (MArray s e, a)) -> (Array e, a)+run2 k = runST (do+ (marr,b) <- k+ arr <- unsafeFreeze marr+ return (arr,b))++-- | Copy an array in its entirety. The destination array must be at+-- least as big as the source.+copy :: Elt e => MArray s e -- ^ source array+ -> MArray s e -- ^ destination array+ -> ST s ()+copy src dest+ | length dest >= length src = copy_loop 0+ | otherwise = fail "Data.Text.Array.copy: array too small"+ where+ len = length src+ copy_loop i+ | i >= len = return ()+ | otherwise = do unsafeRead src i >>= unsafeWrite dest i+ copy_loop (i+1)+{-# INLINE copy #-}++-- | Unsafely copy the elements of an array.+unsafeCopy :: Elt e =>+ MArray s e -> Int -> MArray s e -> Int -> Int -> ST s ()+unsafeCopy src sidx dest didx count =+ assert (sidx + count <= length src) .+ assert (didx + count <= length dest) $+ copy_loop sidx didx 0+ where+ copy_loop !i !j !c+ | c >= count = return ()+ | otherwise = do unsafeRead src i >>= unsafeWrite dest j+ copy_loop (i+1) (j+1) (c+1)+{-# INLINE unsafeCopy #-}
+ Data/Text/Encoding.hs view
@@ -0,0 +1,95 @@+-- |+-- Module : Data.Text.Encoding+-- Copyright : (c) Tom Harper 2008-2009,+-- (c) Bryan O'Sullivan 2009,+-- (c) Duncan Coutts 2009+--+-- License : BSD-style+-- Maintainer : rtharper@aftereternity.co.uk, bos@serpentine.com,+-- duncan@haskell.org+-- Stability : experimental+-- Portability : portable+--+-- Functions for converting 'Text' values to and from 'ByteString',+-- using several standard encodings.+--+-- To make use of a much larger variety of encodings, use the @text-icu@+-- package.++module Data.Text.Encoding+ (+ -- * Decoding ByteStrings to Text+ decodeASCII+ , decodeUtf8+ , decodeUtf16LE+ , decodeUtf16BE+ , decodeUtf32LE+ , decodeUtf32BE++ -- * Encoding Text to ByteStrings+ , encodeUtf8+ , encodeUtf16LE+ , encodeUtf16BE+ , encodeUtf32LE+ , encodeUtf32BE+ ) where+ +import Data.ByteString (ByteString)+import qualified Data.Text.Fusion as F+import qualified Data.Text.Encoding.Fusion as E+import Data.Text.Internal (Text)++-- | Decode a 'ByteString' containing 7-bit ASCII encoded text.+decodeASCII :: ByteString -> Text+decodeASCII bs = F.unstream (E.streamASCII bs)+{-# INLINE decodeASCII #-}++-- | Decode a 'ByteString' containing UTF-8 encoded text.+decodeUtf8 :: ByteString -> Text+decodeUtf8 bs = F.unstream (E.streamUtf8 bs)+{-# INLINE decodeUtf8 #-}++-- | Encode text using UTF-8 encoding.+encodeUtf8 :: Text -> ByteString+encodeUtf8 txt = E.unstream (E.restreamUtf8 (F.stream txt))+{-# INLINE encodeUtf8 #-}++-- | Decode text from little endian UTF-16 encoding.+decodeUtf16LE :: ByteString -> Text+decodeUtf16LE bs = F.unstream (E.streamUtf16LE bs)+{-# INLINE decodeUtf16LE #-}++-- | Decode text from big endian UTF-16 encoding.+decodeUtf16BE :: ByteString -> Text+decodeUtf16BE bs = F.unstream (E.streamUtf16BE bs)+{-# INLINE decodeUtf16BE #-}++-- | Encode text using little endian UTF-16 encoding.+encodeUtf16LE :: Text -> ByteString+encodeUtf16LE txt = E.unstream (E.restreamUtf16LE (F.stream txt))+{-# INLINE encodeUtf16LE #-}++-- | Encode text using big endian UTF-16 encoding.+encodeUtf16BE :: Text -> ByteString+encodeUtf16BE txt = E.unstream (E.restreamUtf16BE (F.stream txt))+{-# INLINE encodeUtf16BE #-}++-- | Decode text from little endian UTF-32 encoding.+decodeUtf32LE :: ByteString -> Text+decodeUtf32LE bs = F.unstream (E.streamUtf32LE bs)+{-# INLINE decodeUtf32LE #-}++-- | Decode text from big endian UTF-32 encoding.+decodeUtf32BE :: ByteString -> Text+decodeUtf32BE bs = F.unstream (E.streamUtf32BE bs)+{-# INLINE decodeUtf32BE #-}++-- | Encode text using little endian UTF-32 encoding.+encodeUtf32LE :: Text -> ByteString+encodeUtf32LE txt = E.unstream (E.restreamUtf32LE (F.stream txt))+{-# INLINE encodeUtf32LE #-}++-- | Encode text using big endian UTF-32 encoding.+encodeUtf32BE :: Text -> ByteString+encodeUtf32BE txt = E.unstream (E.restreamUtf32BE (F.stream txt))+{-# INLINE encodeUtf32BE #-}
+ Data/Text/Encoding/Fusion.hs view
@@ -0,0 +1,336 @@+{-# LANGUAGE BangPatterns #-}++-- |+-- Module : Data.Text.Encoding+-- Copyright : (c) Tom Harper 2008-2009,+-- (c) Bryan O'Sullivan 2009,+-- (c) Duncan Coutts 2009+--+-- License : BSD-style+-- Maintainer : rtharper@aftereternity.co.uk, bos@serpentine.com,+-- duncan@haskell.org+-- Stability : experimental+-- Portability : portable+--+-- Fusible 'Stream'-oriented functions for converting between 'Text'+-- and several common encodings.++module Data.Text.Encoding.Fusion+ (+ -- * Streaming+ streamASCII+ , streamUtf8+ , streamUtf16LE+ , streamUtf16BE+ , streamUtf32LE+ , streamUtf32BE++ -- * Unstreaming+ , unstream++ -- * Restreaming+ -- Restreaming is the act of converting from one 'Stream'+ -- representation to another.+ , restreamUtf8+ , restreamUtf16LE+ , restreamUtf16BE+ , restreamUtf32LE+ , restreamUtf32BE+ ) where++import Control.Exception (assert)+import Data.Bits (shiftL, shiftR, (.&.))+import Data.ByteString as B+import Data.ByteString.Internal (ByteString(..), mallocByteString, memcpy)+import Data.Char (ord)+import Data.Text.Fusion (Step(..), Stream(..))+import Data.Text.UnsafeChar (unsafeChr, unsafeChr8, unsafeChr32)+import Data.Word (Word8, Word16, Word32)+import Foreign.ForeignPtr (withForeignPtr, ForeignPtr)+import Foreign.Storable (pokeByteOff)+import System.IO.Unsafe (unsafePerformIO)+import qualified Data.ByteString as B+import qualified Data.ByteString.Unsafe as B+import qualified Data.Text.Encoding.Utf8 as U8+import qualified Data.Text.Encoding.Utf16 as U16+import qualified Data.Text.Encoding.Utf32 as U32++-- Specialised, strict Maybe-like type.+data M = N+ | J {-# UNPACK #-} !Word8+ deriving (Eq, Ord, Show)++-- Restreaming state.+data S s = S {-# UNPACK #-} !s+ {-# UNPACK #-} !M {-# UNPACK #-} !M {-# UNPACK #-} !M++streamASCII :: ByteString -> Stream Char+streamASCII bs = Stream next 0 l+ where+ l = B.length bs+ {-# INLINE next #-}+ next i+ | i >= l = Done+ | otherwise = Yield (unsafeChr8 x1) (i+1)+ where+ x1 = B.unsafeIndex bs i+{-# INLINE [0] streamASCII #-}++-- | /O(n)/ Convert a 'ByteString' into a 'Stream Char', using UTF-8+-- encoding.+streamUtf8 :: ByteString -> Stream Char+streamUtf8 bs = Stream next 0 l+ where+ l = B.length bs+ {-# INLINE next #-}+ next i+ | i >= l = Done+ | U8.validate1 x1 = Yield (unsafeChr8 x1) (i+1)+ | i+1 < l && U8.validate2 x1 x2 = Yield (U8.chr2 x1 x2) (i+2)+ | i+2 < l && U8.validate3 x1 x2 x3 = Yield (U8.chr3 x1 x2 x3) (i+3)+ | i+3 < l && U8.validate4 x1 x2 x3 x4 = Yield (U8.chr4 x1 x2 x3 x4) (i+4)+ | otherwise = encodingError "UTF-8"+ where+ x1 = idx i+ x2 = idx (i + 1)+ x3 = idx (i + 2)+ x4 = idx (i + 3)+ idx = B.unsafeIndex bs+{-# INLINE [0] streamUtf8 #-}++-- | /O(n)/ Convert a 'ByteString' into a 'Stream Char', using little+-- endian UTF-16 encoding.+streamUtf16LE :: ByteString -> Stream Char+streamUtf16LE bs = Stream next 0 l+ where+ l = B.length bs+ {-# INLINE next #-}+ next i+ | i >= l = Done+ | i+1 < l && U16.validate1 x1 = Yield (unsafeChr x1) (i+2)+ | i+3 < l && U16.validate2 x1 x2 = Yield (U16.chr2 x1 x2) (i+4)+ | otherwise = encodingError "UTF-16LE"+ where+ x1 = idx i + (idx (i + 1) `shiftL` 8)+ x2 = idx (i + 2) + (idx (i + 3) `shiftL` 8)+ idx = fromIntegral . B.unsafeIndex bs :: Int -> Word16+{-# INLINE [0] streamUtf16LE #-}++-- | /O(n)/ Convert a 'ByteString' into a 'Stream Char', using big+-- endian UTF-16 encoding.+streamUtf16BE :: ByteString -> Stream Char+streamUtf16BE bs = Stream next 0 l+ where+ l = B.length bs+ {-# INLINE next #-}+ next i+ | i >= l = Done+ | i+1 < l && U16.validate1 x1 = Yield (unsafeChr x1) (i+2)+ | i+3 < l && U16.validate2 x1 x2 = Yield (U16.chr2 x1 x2) (i+4)+ | otherwise = encodingError "UTF16-BE"+ where+ x1 = (idx i `shiftL` 8) + idx (i + 1)+ x2 = (idx (i + 2) `shiftL` 8) + idx (i + 3)+ idx = fromIntegral . B.unsafeIndex bs :: Int -> Word16+{-# INLINE [0] streamUtf16BE #-}++-- | /O(n)/ Convert a 'ByteString' into a 'Stream Char', using big+-- endian UTF-32 encoding.+streamUtf32BE :: ByteString -> Stream Char+streamUtf32BE bs = Stream next 0 l+ where+ l = B.length bs+ {-# INLINE next #-}+ next i+ | i >= l = Done+ | i+3 < l && U32.validate x = Yield (unsafeChr32 x) (i+4)+ | otherwise = encodingError "UTF-32BE"+ where+ x = shiftL x1 24 + shiftL x2 16 + shiftL x3 8 + x4+ x1 = idx i+ x2 = idx (i+1)+ x3 = idx (i+2)+ x4 = idx (i+3)+ idx = fromIntegral . B.unsafeIndex bs :: Int -> Word32+{-# INLINE [0] streamUtf32BE #-}++-- | /O(n)/ Convert a 'ByteString' into a 'Stream Char', using little+-- endian UTF-32 encoding.+streamUtf32LE :: ByteString -> Stream Char+streamUtf32LE bs = Stream next 0 l+ where+ l = B.length bs+ {-# INLINE next #-}+ next i+ | i >= l = Done+ | i+3 < l && U32.validate x = Yield (unsafeChr32 x) (i+4)+ | otherwise = encodingError "UTF-32LE"+ where+ x = shiftL x4 24 + shiftL x3 16 + shiftL x2 8 + x1+ x1 = idx i+ x2 = idx $ i+1+ x3 = idx $ i+2+ x4 = idx $ i+3+ idx = fromIntegral . B.unsafeIndex bs :: Int -> Word32+{-# INLINE [0] streamUtf32LE #-}++-- | /O(n)/ Convert a Stream Char into a UTF-8 encoded Stream Word8.+restreamUtf8 :: Stream Char -> Stream Word8+restreamUtf8 (Stream next0 s0 len) =+ Stream next (S s0 N N N) (len*2)+ where+ {-# INLINE next #-}+ next (S s N N N) = case next0 s of+ Done -> Done+ Skip s' -> Skip (S s' N N N)+ Yield x xs+ | n <= 0x7F -> Yield c (S xs N N N)+ | n <= 0x07FF -> Yield a2 (S xs (J b2) N N)+ | n <= 0xFFFF -> Yield a3 (S xs (J b3) (J c3) N)+ | otherwise -> Yield a4 (S xs (J b4) (J c4) (J d4))+ where+ n = ord x+ c = fromIntegral n+ (a2,b2) = U8.ord2 x+ (a3,b3,c3) = U8.ord3 x+ (a4,b4,c4,d4) = U8.ord4 x+ next (S s (J x2) N N) = Yield x2 (S s N N N)+ next (S s (J x2) x3 N) = Yield x2 (S s x3 N N)+ next (S s (J x2) x3 x4) = Yield x2 (S s x3 x4 N)+ next _ = internalError "restreamUtf8"+{-# INLINE restreamUtf8 #-}++restreamUtf16BE :: Stream Char -> Stream Word8+restreamUtf16BE (Stream next0 s0 len) =+ Stream next (S s0 N N N) (len*2)+ where+ {-# INLINE next #-}+ next (S s N N N) = case next0 s of+ Done -> Done+ Skip s' -> Skip (S s' N N N)+ Yield x xs+ | n < 0x10000 -> Yield (fromIntegral $ n `shiftR` 8) $+ S xs (J $ fromIntegral n) N N+ | otherwise -> Yield c1 $+ S xs (J c2) (J c3) (J c4)+ where+ n = ord x+ n1 = n - 0x10000+ c1 = fromIntegral (n1 `shiftR` 18 + 0xD8)+ c2 = fromIntegral (n1 `shiftR` 10)+ n2 = n1 .&. 0x3FF+ c3 = fromIntegral (n2 `shiftR` 8 + 0xDC)+ c4 = fromIntegral n2+ next (S s (J x2) N N) = Yield x2 (S s N N N)+ next (S s (J x2) x3 N) = Yield x2 (S s x3 N N)+ next (S s (J x2) x3 x4) = Yield x2 (S s x3 x4 N)+ next _ = internalError "restreamUtf16BE"+{-# INLINE restreamUtf16BE #-}++restreamUtf16LE :: Stream Char -> Stream Word8+restreamUtf16LE (Stream next0 s0 len) =+ Stream next (S s0 N N N) (len*2)+ where+ {-# INLINE next #-}+ next (S s N N N) = case next0 s of+ Done -> Done+ Skip s' -> Skip (S s' N N N)+ Yield x xs+ | n < 0x10000 -> Yield (fromIntegral n) $+ S xs (J (fromIntegral $ shiftR n 8)) N N+ | otherwise -> Yield c1 $+ S xs (J c2) (J c3) (J c4)+ where+ n = ord x+ n1 = n - 0x10000+ c2 = fromIntegral (shiftR n1 18 + 0xD8)+ c1 = fromIntegral (shiftR n1 10)+ n2 = n1 .&. 0x3FF+ c4 = fromIntegral (shiftR n2 8 + 0xDC)+ c3 = fromIntegral n2+ next (S s (J x2) N N) = Yield x2 (S s N N N)+ next (S s (J x2) x3 N) = Yield x2 (S s x3 N N)+ next (S s (J x2) x3 x4) = Yield x2 (S s x3 x4 N)+ next _ = internalError "restreamUtf16LE"+{-# INLINE restreamUtf16LE #-}++restreamUtf32BE :: Stream Char -> Stream Word8+restreamUtf32BE (Stream next0 s0 len) =+ Stream next (S s0 N N N) (len*2)+ where+ {-# INLINE next #-}+ next (S s N N N) = case next0 s of+ Done -> Done+ Skip s' -> Skip (S s' N N N)+ Yield x xs -> Yield c1 (S xs (J c2) (J c3) (J c4))+ where+ n = ord x+ c1 = fromIntegral $ shiftR n 24+ c2 = fromIntegral $ shiftR n 16+ c3 = fromIntegral $ shiftR n 8+ c4 = fromIntegral n+ next (S s (J x2) N N) = Yield x2 (S s N N N)+ next (S s (J x2) x3 N) = Yield x2 (S s x3 N N)+ next (S s (J x2) x3 x4) = Yield x2 (S s x3 x4 N)+ next _ = internalError "restreamUtf32BE"+{-# INLINE restreamUtf32BE #-}++restreamUtf32LE :: Stream Char -> Stream Word8+restreamUtf32LE (Stream next0 s0 len) =+ Stream next (S s0 N N N) (len*2)+ where+ {-# INLINE next #-}+ next (S s N N N) = case next0 s of+ Done -> Done+ Skip s' -> Skip (S s' N N N)+ Yield x xs -> Yield c1 (S xs (J c2) (J c3) (J c4))+ where+ n = ord x+ c4 = fromIntegral $ shiftR n 24+ c3 = fromIntegral $ shiftR n 16+ c2 = fromIntegral $ shiftR n 8+ c1 = fromIntegral n+ next (S s (J x2) N N) = Yield x2 (S s N N N)+ next (S s (J x2) x3 N) = Yield x2 (S s x3 N N)+ next (S s (J x2) x3 x4) = Yield x2 (S s x3 x4 N)+ next _ = internalError "restreamUtf32LE"+{-# INLINE restreamUtf32LE #-}+++-- | /O(n)/ Convert a 'Stream' 'Word8' to a 'ByteString'.+unstream :: Stream Word8 -> ByteString+unstream (Stream next s0 len) = unsafePerformIO $ do+ fp0 <- mallocByteString len+ loop fp0 len 0 s0+ where+ loop !fp !n !off !s = case next s of+ Done -> trimUp fp n off+ Skip s' -> loop fp n off s'+ Yield x s'+ | n == off -> realloc fp n off s' x+ | otherwise -> do+ withForeignPtr fp $ \p -> pokeByteOff p off x+ loop fp n (off+1) s'+ {-# NOINLINE realloc #-}+ realloc fp n off s x = do+ let n' = n+n+ fp' <- copy0 fp n n'+ withForeignPtr fp' $ \p -> pokeByteOff p off x+ loop fp' n' (off+1) s+ {-# NOINLINE trimUp #-}+ trimUp fp _ off = return $! PS fp 0 off+ copy0 :: ForeignPtr Word8 -> Int -> Int -> IO (ForeignPtr Word8)+ copy0 !src !srcLen !destLen = assert (srcLen <= destLen) $ do+ dest <- mallocByteString destLen+ withForeignPtr src $ \src' ->+ withForeignPtr dest $ \dest' ->+ memcpy dest' src' (fromIntegral destLen)+ return dest++internalError :: String -> a+internalError func =+ error $ "Data.Text.Encoding.Fusion." ++ func ++ ": internal error"++encodingError :: String -> a+encodingError encoding =+ error $ "Data.Text.Encoding.Fusion: Bad " ++ encoding ++ " stream"
+ Data/Text/Encoding/Utf16.hs view
@@ -0,0 +1,42 @@+{-# LANGUAGE MagicHash #-}++-- |+-- Module : Data.Text.Encoding.Utf16+-- Copyright : (c) Tom Harper 2008-2009,+-- (c) Bryan O'Sullivan 2009,+-- (c) Duncan Coutts 2009+--+-- License : BSD-style+-- Maintainer : rtharper@aftereternity.co.uk, bos@serpentine.com,+-- duncan@haskell.org+-- Stability : experimental+-- Portability : GHC+--+-- Basic UTF-16 validation and character manipulation.+module Data.Text.Encoding.Utf16+ (+ chr2+ , validate1+ , validate2+ ) where++import GHC.Exts+import GHC.Word (Word16(..))++chr2 :: Word16 -> Word16 -> Char+chr2 (W16# a#) (W16# b#) = C# (chr# (upper# +# lower# +# 0x10000#))+ where+ x# = word2Int# a#+ y# = word2Int# b#+ upper# = uncheckedIShiftL# (x# -# 0xD800#) 10#+ lower# = y# -# 0xDC00#+{-# INLINE chr2 #-}++validate1 :: Word16 -> Bool+validate1 x1 = (x1 >= 0 && x1 < 0xD800) || x1 > 0xDFFF+{-# INLINE validate1 #-}++validate2 :: Word16 -> Word16 -> Bool+validate2 x1 x2 = x1 >= 0xD800 && x1 <= 0xDBFF &&+ x2 >= 0xDC00 && x2 <= 0xDFFF+{-# INLINE validate2 #-}
+ Data/Text/Encoding/Utf32.hs view
@@ -0,0 +1,23 @@+-- |+-- Module : Data.Text.Encoding.Utf16+-- Copyright : (c) Tom Harper 2008-2009,+-- (c) Bryan O'Sullivan 2009,+-- (c) Duncan Coutts 2009+--+-- License : BSD-style+-- Maintainer : rtharper@aftereternity.co.uk, bos@serpentine.com,+-- duncan@haskell.org+-- Stability : experimental+-- Portability : portable+--+-- Basic UTF-32 validation.+module Data.Text.Encoding.Utf32+ (+ validate+ ) where++import Data.Word (Word32)++validate :: Word32 -> Bool+validate x1 = (x1 >= 0x0 && x1 < 0xD800) || (x1 > 0xDFFF && x1 <= 0x10FFFF)+{-# INLINE validate #-}
+ Data/Text/Encoding/Utf8.hs view
@@ -0,0 +1,151 @@+{-# LANGUAGE MagicHash #-}++-- |+-- Module : Data.Text.Encoding.Utf16+-- Copyright : (c) Tom Harper 2008-2009,+-- (c) Bryan O'Sullivan 2009,+-- (c) Duncan Coutts 2009+--+-- License : BSD-style+-- Maintainer : rtharper@aftereternity.co.uk, bos@serpentine.com,+-- duncan@haskell.org+-- Stability : experimental+-- Portability : GHC+--+-- Basic UTF-8 validation and character manipulation.+module Data.Text.Encoding.Utf8+ (+ -- Decomposition+ ord2+ , ord3+ , ord4+ -- Construction+ , chr2+ , chr3+ , chr4+ -- * Validation+ , validate1+ , validate2+ , validate3+ , validate4+ ) where++import Control.Exception (assert)+import Data.Char (ord)+import Data.Bits (shiftR, (.&.))+import GHC.Exts+import GHC.Word (Word8(..))++default(Int)++between :: Word8 -- ^ byte to check+ -> Word8 -- ^ lower bound+ -> Word8 -- ^ upper bound+ -> Bool+between x y z = x >= y && x <= z+{-# INLINE between #-}++ord2 :: Char -> (Word8,Word8)+ord2 c = assert (n >= 0x80 && n <= 0x07ff) (x1,x2)+ where+ n = ord c+ x1 = fromIntegral $ (n `shiftR` 6) + 0xC0+ x2 = fromIntegral $ (n .&. 0x3F) + 0x80++ord3 :: Char -> (Word8,Word8,Word8)+ord3 c = assert (n >= 0x0800 && n <= 0xffff) (x1,x2,x3)+ where+ n = ord c+ x1 = fromIntegral $ (n `shiftR` 12) + 0xE0+ x2 = fromIntegral $ ((n `shiftR` 6) .&. 0x3F) + 0x80+ x3 = fromIntegral $ (n .&. 0x3F) + 0x80++ord4 :: Char -> (Word8,Word8,Word8,Word8)+ord4 c = assert (n >= 0x10000) (x1,x2,x3,x4)+ where+ n = ord c+ x1 = fromIntegral $ (n `shiftR` 18) + 0xF0+ x2 = fromIntegral $ ((n `shiftR` 12) .&. 0x3F) + 0x80+ x3 = fromIntegral $ ((n `shiftR` 6) .&. 0x3F) + 0x80+ x4 = fromIntegral $ (n .&. 0x3F) + 0x80++chr2 :: Word8 -> Word8 -> Char+chr2 (W8# x1#) (W8# x2#) = C# (chr# (z1# +# z2#))+ where+ y1# = word2Int# x1#+ y2# = word2Int# x2#+ z1# = uncheckedIShiftL# (y1# -# 0xC0#) 6#+ z2# = y2# -# 0x80#+{-# INLINE chr2 #-}++chr3 :: Word8 -> Word8 -> Word8 -> Char+chr3 (W8# x1#) (W8# x2#) (W8# x3#) = C# (chr# (z1# +# z2# +# z3#))+ where+ y1# = word2Int# x1#+ y2# = word2Int# x2#+ y3# = word2Int# x3#+ z1# = uncheckedIShiftL# (y1# -# 0xE0#) 12#+ z2# = uncheckedIShiftL# (y2# -# 0x80#) 6#+ z3# = y3# -# 0x80#+{-# INLINE chr3 #-}++chr4 :: Word8 -> Word8 -> Word8 -> Word8 -> Char+chr4 (W8# x1#) (W8# x2#) (W8# x3#) (W8# x4#) =+ C# (chr# (z1# +# z2# +# z3# +# z4#))+ where+ y1# = word2Int# x1#+ y2# = word2Int# x2#+ y3# = word2Int# x3#+ y4# = word2Int# x4#+ z1# = uncheckedIShiftL# (y1# -# 0xF0#) 18#+ z2# = uncheckedIShiftL# (y2# -# 0x80#) 12#+ z3# = uncheckedIShiftL# (y3# -# 0x80#) 6#+ z4# = y4# -# 0x80#+{-# INLINE chr4 #-}++validate1 :: Word8 -> Bool+validate1 x1 = between x1 0x00 0x7F+{-# INLINE validate1 #-}++validate2 :: Word8 -> Word8 -> Bool+validate2 x1 x2 = between x1 0xC2 0xDF && between x2 0x80 0xBF+{-# INLINE validate2 #-}++validate3 :: Word8 -> Word8 -> Word8 -> Bool+{-# INLINE validate3 #-}+validate3 x1 x2 x3 = validate3_1 ||+ validate3_2 ||+ validate3_3 ||+ validate3_4+ where+ validate3_1 = (x1 == 0xE0) &&+ between x2 0xA0 0xBF &&+ between x3 0x80 0xBF+ validate3_2 = between x1 0xE1 0xEC &&+ between x2 0x80 0xBF &&+ between x3 0x80 0xBF+ validate3_3 = x1 == 0xED &&+ between x2 0x80 0x9F &&+ between x3 0x80 0xBF+ validate3_4 = between x1 0xEE 0xEF &&+ between x2 0x80 0xBF &&+ between x3 0x80 0xBF++validate4 :: Word8 -> Word8 -> Word8 -> Word8 -> Bool+{-# INLINE validate4 #-}+validate4 x1 x2 x3 x4 = validate4_1 ||+ validate4_2 ||+ validate4_3+ where + validate4_1 = x1 == 0xF0 &&+ between x2 0x90 0xBF &&+ between x3 0x80 0xBF &&+ between x4 0x80 0xBF+ validate4_2 = between x1 0xF1 0xF3 &&+ between x2 0x80 0xBF &&+ between x3 0x80 0xBF &&+ between x4 0x80 0xBF+ validate4_3 = x1 == 0xF4 &&+ between x2 0x80 0x8F &&+ between x3 0x80 0xBF &&+ between x4 0x80 0xBF
+ Data/Text/Foreign.hs view
@@ -0,0 +1,89 @@+{-# LANGUAGE BangPatterns #-}+-- |+-- Module : Data.Text.Foreign+-- Copyright : (c) Bryan O'Sullivan 2009+--+-- License : BSD-style+-- Maintainer : rtharper@aftereternity.co.uk, bos@serpentine.com,+-- duncan@haskell.org+-- Stability : experimental+-- Portability : GHC+--+-- Support for using 'Text' data with native code via the Haskell+-- foreign function interface.++module Data.Text.Foreign+ (+ -- * Interoperability with native code+ -- $interop++ -- * Safe conversion functions+ fromPtr+ , useAsPtr+ -- * Unsafe conversion code+ , lengthWord16+ , unsafeCopyToPtr+ ) where++import Control.Exception (assert)+import Control.Monad.ST (unsafeIOToST)+import Data.Text.Internal (Text(..), empty)+import qualified Data.Text.Array as A+import Data.Word (Word16)+import Foreign.Marshal.Alloc (allocaBytes)+import Foreign.Ptr (Ptr, castPtr, plusPtr)+import Foreign.Storable (peek, poke)++-- $interop+--+-- The 'Text' type is implemented using arrays that are not guaranteed+-- to have a fixed address in the Haskell heap. All communication with+-- native code must thus occur by copying data back and forth.+--+-- The 'Text' type's internal representation is UTF-16, using the+-- platform's native endianness. This makes copied data suitable for+-- use with native libraries that use a similar representation, such+-- as ICU. To interoperate with native libraries that use different+-- internal representations, such as UTF-8 or UTF-32, consider using+-- the functions in the 'Data.Text.Encoding' module.++-- | /O(n)/ Create a new 'Text' from a 'Ptr' 'Word16' by copying the+-- contents of the array.+fromPtr :: Ptr Word16 -- ^ source array+ -> Int -- ^ length of source array (in 'Word16' units)+ -> IO Text+fromPtr _ 0 = return empty+fromPtr ptr len = assert (len > 0) $ return (Text arr 0 len)+ where+ arr = A.run (A.unsafeNew len >>= copy)+ copy marr = loop ptr 0+ where+ loop !p !i | i == len = return marr+ | otherwise = do+ A.unsafeWrite marr i =<< unsafeIOToST (peek p)+ loop (p `plusPtr` 2) (i + 1)++-- | /O(1)/ Return the length of a 'Text' in units of 'Word16'. This+-- is useful for sizing a target array appropriately before using+-- 'unsafeCopyToPtr'.+lengthWord16 :: Text -> Int+lengthWord16 (Text _arr _off len) = len++-- | /O(n)/ Copy a 'Text' to an array. The array is assumed to be big+-- enough to hold the contents of the entire 'Text'.+unsafeCopyToPtr :: Text -> Ptr Word16 -> IO ()+unsafeCopyToPtr (Text arr off len) ptr = loop ptr off+ where+ end = off + len+ loop !p !i | i == end = return ()+ | otherwise = do+ poke p (A.unsafeIndex arr i)+ loop (p `plusPtr` 2) (i + 1)++-- | /O(n)/ Perform an action on a temporary, mutable copy of a+-- 'Text'. The copy is freed as soon as the action returns.+useAsPtr :: Text -> (Ptr Word16 -> Int -> IO a) -> IO a+useAsPtr t@(Text _arr _off len) action =+ allocaBytes (len * 2) $ \buf -> do+ unsafeCopyToPtr t buf+ action (castPtr buf) len
+ Data/Text/Fusion.hs view
@@ -0,0 +1,923 @@+{-# LANGUAGE ExistentialQuantification, BangPatterns, MagicHash #-}++-- |+-- Module : Data.Text.Fusion+-- Copyright : (c) Tom Harper 2008-2009,+-- (c) Bryan O'Sullivan 2009,+-- (c) Duncan Coutts 2009+--+-- License : BSD-style+-- Maintainer : rtharper@aftereternity.co.uk, bos@serpentine.com,+-- duncan@haskell.org+-- Stability : experimental+-- Portability : GHC+--+-- Text manipulation functions represented as fusible operations over+-- streams.+module Data.Text.Fusion+ (+ -- * Types+ Stream(..)+ , Step(..)++ -- * Creation and elimination+ , stream+ , unstream+ , reverseStream+ , empty++ -- * Basic interface+ , cons+ , snoc+ , append+ , uncons+ , head+ , tail+ , last+ , init+ , null+ , length+ , eq++ -- * Transformations+ , map+ , intercalate+ , intersperse+ , reverse++ -- * Folds+ , foldl+ , foldl'+ , foldl1+ , foldl1'+ , foldr+ , foldr1++ -- ** Special folds+ , concat+ , concatMap+ , any+ , all+ , maximum+ , minimum++ -- * Construction+ -- ** Scans+ , scanl+ , reverseScanr++ -- ** Accumulating maps+ , mapAccumL+ + -- ** Generation and unfolding+ , replicate+ , unfoldr+ , unfoldrN++ -- * Substrings+ -- ** Breaking strings+ , take+ , drop+ , takeWhile+ , dropWhile++ -- * Predicates+ , isPrefixOf++ -- * Searching+ , elem+ , filter++ -- * Indexing+ , find+ , index+ , findIndex+ , findIndices+ , findIndexOrEnd+ , elemIndex+ , elemIndices+ , count++ -- * Zipping and unzipping+ , zipWith+ ) where++import Prelude (Bool(..), Char, Either(..), Eq(..), Maybe(..), Monad(..),+ Num(..), Ord(..), String, ($), (++), (.), (&&),+ fromIntegral, otherwise)+import Control.Monad (liftM2)+import Control.Monad.ST (runST)+import qualified Data.List as L+import GHC.Exts (Int(..), (+#))+import Data.Bits ((.&.), shiftR)+import Data.Char (ord)+import Data.Text.Internal (Text(..))+import Data.Text.UnsafeChar (unsafeChr, unsafeWrite, unsafeWriteRev)+import qualified Data.Text.Array as A+import qualified Data.Text.Internal as I+import qualified Data.Text.Encoding.Utf16 as U16+import qualified Prelude as P++default(Int)++infixl 2 :!:+data PairS a b = !a :!: !b++-- | Allow a function over a stream to switch between two states.+data Switch = S1 | S2++data Stream a =+ forall s. Stream+ (s -> Step s a) -- stepper function+ !s -- current state+ {-# UNPACK #-}!Int -- length hint++-- The length hint in a Stream has two roles. If its value is zero,+-- we trust it, and treat the stream as empty. Otherwise, we treat it+-- as a hint: it should usually be accurate, so we use it when+-- unstreaming to decide what size array to allocate. However, the+-- unstreaming functions must be able to cope with the hint being too+-- small or too large.+--+-- The size hint tries to track the UTF-16 code points in a stream,+-- but often counts the number of characters instead. It can easily+-- undercount if, for instance, a transformed stream contains astral+-- plane characters (those above 0x10000).++data Step s a = Done+ | Skip !s+ | Yield !a !s++-- | /O(n)/ Convert a 'Text' into a 'Stream Char'.+stream :: Text -> Stream Char+stream (Text arr off len) = Stream next off len+ where+ end = off+len+ {-# INLINE next #-}+ next !i+ | i >= end = Done+ | n >= 0xD800 && n <= 0xDBFF = Yield (U16.chr2 n n2) (i + 2)+ | otherwise = Yield (unsafeChr n) (i + 1)+ where+ n = A.unsafeIndex arr i+ n2 = A.unsafeIndex arr (i + 1)+{-# INLINE [0] stream #-}++-- | /O(n)/ Convert a 'Text' into a 'Stream Char', but iterate+-- backwards.+reverseStream :: Text -> Stream Char+reverseStream (Text arr off len) = Stream next (off+len-1) len+ where+ {-# INLINE next #-}+ next !i+ | i < off = Done+ | n >= 0xDC00 && n <= 0xDFFF = Yield (U16.chr2 n2 n) (i - 2)+ | otherwise = Yield (unsafeChr n) (i - 1)+ where+ n = A.unsafeIndex arr i+ n2 = A.unsafeIndex arr (i - 1)+{-# INLINE [0] reverseStream #-}++-- | /O(n)/ Convert a Stream Char into a Text.+unstream :: Stream Char -> Text+unstream (Stream next0 s0 len)+ | len == 0 = I.empty+ | otherwise = Text (P.fst a) 0 (P.snd a)+ where+ a = runST (A.unsafeNew len >>= (\arr -> loop arr len s0 0))+ loop arr !top !s !i+ | i + 1 >= top = case next0 s of+ Done -> liftM2 (,) (A.unsafeFreeze arr) (return i)+ _ -> do+ arr' <- A.unsafeNew (top*2)+ A.copy arr arr' >> loop arr' (top*2) s i+ | otherwise = case next0 s of+ Done -> liftM2 (,) (A.unsafeFreeze arr) (return i)+ Skip s' -> loop arr top s' i+ Yield x s' -> unsafeWrite arr i x >>= loop arr top s'+{-# INLINE [0] unstream #-}+{-# RULES "STREAM stream/unstream fusion" forall s. stream (unstream s) = s #-}++-- | The empty stream.+empty :: Stream Char+empty = Stream next () 0+ where next _ = Done+{-# INLINE [0] empty #-}++-- | /O(n)/ Determines if two streams are equal.+eq :: Ord a => Stream a -> Stream a -> Bool+eq (Stream next1 s1 _) (Stream next2 s2 _) = cmp (next1 s1) (next2 s2)+ where+ cmp Done Done = True+ cmp Done _ = False+ cmp _ Done = False+ cmp (Skip s1') (Skip s2') = cmp (next1 s1') (next2 s2')+ cmp (Skip s1') x2 = cmp (next1 s1') x2+ cmp x1 (Skip s2') = cmp x1 (next2 s2')+ cmp (Yield x1 s1') (Yield x2 s2') = x1 == x2 &&+ cmp (next1 s1') (next2 s2')+{-# SPECIALISE eq :: Stream Char -> Stream Char -> Bool #-}++streamError :: String -> String -> a+streamError func msg = P.error $ "Data.Text.Fusion." ++ func ++ ": " ++ msg++internalError :: String -> a+internalError func = streamError func "Internal error"++emptyError :: String -> a+emptyError func = internalError func "Empty input"++-- ----------------------------------------------------------------------------+-- * Basic stream functions++-- | /O(n)/ Adds a character to the front of a Stream Char.+cons :: Char -> Stream Char -> Stream Char+cons w (Stream next0 s0 len) = Stream next (S2 :!: s0) (len+2)+ where+ {-# INLINE next #-}+ next (S2 :!: s) = Yield w (S1 :!: s)+ next (S1 :!: s) = case next0 s of+ Done -> Done+ Skip s' -> Skip (S1 :!: s')+ Yield x s' -> Yield x (S1 :!: s')+{-# INLINE [0] cons #-}++-- | /O(n)/ Adds a character to the end of a stream.+snoc :: Stream Char -> Char -> Stream Char+snoc (Stream next0 xs0 len) w = Stream next (Just xs0) (len+2)+ where+ {-# INLINE next #-}+ next (Just xs) = case next0 xs of+ Done -> Yield w Nothing+ Skip xs' -> Skip (Just xs')+ Yield x xs' -> Yield x (Just xs')+ next Nothing = Done+{-# INLINE [0] snoc #-}++-- | /O(n)/ Appends one Stream to the other.+append :: Stream Char -> Stream Char -> Stream Char+append (Stream next0 s01 len1) (Stream next1 s02 len2) =+ Stream next (Left s01) (len1 + len2)+ where+ {-# INLINE next #-}+ next (Left s1) = case next0 s1 of+ Done -> Skip (Right s02)+ Skip s1' -> Skip (Left s1')+ Yield x s1' -> Yield x (Left s1')+ next (Right s2) = case next1 s2 of+ Done -> Done+ Skip s2' -> Skip (Right s2')+ Yield x s2' -> Yield x (Right s2')+{-# INLINE [0] append #-}++-- | /O(1)/ Returns the first character of a Text, which must be non-empty.+-- Subject to array fusion.+head :: Stream Char -> Char+head (Stream next s0 _len) = loop_head s0+ where+ loop_head !s = case next s of+ Yield x _ -> x+ Skip s' -> loop_head s'+ Done -> streamError "head" "Empty stream"+{-# INLINE [0] head #-}++-- | /O(1)/ Returns the first character and remainder of a 'Stream+-- Char', or 'Nothing' if empty. Subject to array fusion.+uncons :: Stream Char -> Maybe (Char, Stream Char)+uncons (Stream next s0 len) = loop_uncons s0+ where+ loop_uncons !s = case next s of+ Yield x s1 -> Just (x, Stream next s1 (len-1))+ Skip s' -> loop_uncons s'+ Done -> Nothing+{-# INLINE [0] uncons #-}++-- | /O(n)/ Returns the last character of a 'Stream Char', which must+-- be non-empty.+last :: Stream Char -> Char+last (Stream next s0 _len) = loop0_last s0+ where+ loop0_last !s = case next s of+ Done -> emptyError "last"+ Skip s' -> loop0_last s'+ Yield x s' -> loop_last x s'+ loop_last !x !s = case next s of+ Done -> x+ Skip s' -> loop_last x s'+ Yield x' s' -> loop_last x' s'+{-# INLINE[0] last #-}++-- | /O(1)/ Returns all characters after the head of a Stream Char, which must+-- be non-empty.+tail :: Stream Char -> Stream Char+tail (Stream next0 s0 len) = Stream next (False :!: s0) (len-1)+ where+ {-# INLINE next #-}+ next (False :!: s) = case next0 s of+ Done -> emptyError "tail"+ Skip s' -> Skip (False :!: s')+ Yield _ s' -> Skip (True :!: s')+ next (True :!: s) = case next0 s of+ Done -> Done+ Skip s' -> Skip (True :!: s')+ Yield x s' -> Yield x (True :!: s')+{-# INLINE [0] tail #-}+++-- | /O(1)/ Returns all but the last character of a Stream Char, which+-- must be non-empty.+init :: Stream Char -> Stream Char+init (Stream next0 s0 len) = Stream next (Nothing :!: s0) (len-1)+ where+ {-# INLINE next #-}+ next (Nothing :!: s) = case next0 s of+ Done -> emptyError "init"+ Skip s' -> Skip (Nothing :!: s')+ Yield x s' -> Skip (Just x :!: s')+ next (Just x :!: s) = case next0 s of+ Done -> Done+ Skip s' -> Skip (Just x :!: s')+ Yield x' s' -> Yield x (Just x' :!: s')+{-# INLINE [0] init #-}++-- | /O(1)/ Tests whether a Stream Char is empty or not.+null :: Stream Char -> Bool+null (Stream next s0 _len) = loop_null s0+ where+ loop_null !s = case next s of+ Done -> True+ Yield _ _ -> False+ Skip s' -> loop_null s'+{-# INLINE[0] null #-}++-- | /O(n)/ Returns the number of characters in a text.+length :: Stream Char -> Int+length (Stream next s0 _len) = loop_length 0# s0+ where++ loop_length z# s = case next s of+ Done -> (I# z#)+ Skip s' -> loop_length z# s'+ Yield _ s' -> loop_length (z# +# 1#) s'+{-# INLINE[0] length #-}++-- ----------------------------------------------------------------------------+-- * Stream transformations++-- | /O(n)/ 'map' @f @xs is the Stream Char obtained by applying @f@ to each element of+-- @xs@.+map :: (Char -> Char) -> Stream Char -> Stream Char+map f (Stream next0 s0 len) = Stream next s0 len+ where+ {-# INLINE next #-}+ next !s = case next0 s of+ Done -> Done+ Skip s' -> Skip s'+ Yield x s' -> Yield (f x) s'+{-# INLINE [0] map #-}++{-#+ RULES "STREAM map/map fusion" forall f g s.+ map f (map g s) = map (\x -> f (g x)) s+ #-}++-- | /O(n)/ Take a character and place it between each of the+-- characters of a 'Stream Char'.+intersperse :: Char -> Stream Char -> Stream Char+intersperse c (Stream next0 s0 len) = Stream next (s0 :!: Nothing :!: S1) len+ where+ {-# INLINE next #-}+ next (s :!: Nothing :!: S1) = case next0 s of+ Done -> Done+ Skip s' -> Skip (s' :!: Nothing :!: S1)+ Yield x s' -> Skip (s' :!: Just x :!: S1)+ next (s :!: Just x :!: S1) = Yield x (s :!: Nothing :!: S2)+ next (s :!: Nothing :!: S2) = case next0 s of+ Done -> Done+ Skip s' -> Skip (s' :!: Nothing :!: S2)+ Yield x s' -> Yield c (s' :!: Just x :!: S1)+ next _ = internalError "intersperse"+{-# INLINE [0] intersperse #-}++-- | /O(n)/ Reverse the characters of a string.+reverse :: Stream Char -> Text+reverse (Stream next s len0)+ | len0 == 0 = I.empty+ | otherwise = Text arr off' len'+ where+ len0' = max len0 4+ (arr, (off', len')) = A.run2 (A.unsafeNew len0 >>= loop s (len0'-1) len0')+ loop !s0 !i !len marr =+ case next s0 of+ Done -> return (marr, (j, len-j))+ where j = i + 1+ Skip s1 -> loop s1 i len marr+ Yield x s1 | i < least -> do+ let newLen = len * 2+ marr' <- A.unsafeNew newLen+ A.unsafeCopy marr 0 marr' (newLen-len) len+ write s1 (len+i) newLen marr'+ | otherwise -> write s1 i len marr+ where n = ord x+ least | n < 0x10000 = 0+ | otherwise = 1+ m = n - 0x10000+ lo = fromIntegral $ (m `shiftR` 10) + 0xD800+ hi = fromIntegral $ (m .&. 0x3FF) + 0xDC00+ write s i len marr+ | n < 0x10000 = do+ A.unsafeWrite marr i (fromIntegral n)+ loop s (i-1) len marr+ | otherwise = do+ A.unsafeWrite marr (i-1) lo+ A.unsafeWrite marr i hi+ loop s (i-2) len marr+{-# INLINE [0] reverse #-}++-- ----------------------------------------------------------------------------+-- * Reducing Streams (folds)++-- | foldl, applied to a binary operator, a starting value (typically the+-- left-identity of the operator), and a Stream, reduces the Stream using the+-- binary operator, from left to right.+foldl :: (b -> Char -> b) -> b -> Stream Char -> b+foldl f z0 (Stream next s0 _len) = loop_foldl z0 s0+ where+ loop_foldl z !s = case next s of+ Done -> z+ Skip s' -> loop_foldl z s'+ Yield x s' -> loop_foldl (f z x) s'+{-# INLINE [0] foldl #-}++-- | A strict version of foldl.+foldl' :: (b -> Char -> b) -> b -> Stream Char -> b+foldl' f z0 (Stream next s0 _len) = loop_foldl' z0 s0+ where+ loop_foldl' !z !s = case next s of+ Done -> z+ Skip s' -> loop_foldl' z s'+ Yield x s' -> loop_foldl' (f z x) s'+{-# INLINE [0] foldl' #-}++-- | foldl1 is a variant of foldl that has no starting value argument,+-- and thus must be applied to non-empty Streams.+foldl1 :: (Char -> Char -> Char) -> Stream Char -> Char+foldl1 f (Stream next s0 _len) = loop0_foldl1 s0+ where+ loop0_foldl1 !s = case next s of+ Skip s' -> loop0_foldl1 s'+ Yield x s' -> loop_foldl1 x s'+ Done -> emptyError "foldl1"+ loop_foldl1 z !s = case next s of+ Done -> z+ Skip s' -> loop_foldl1 z s'+ Yield x s' -> loop_foldl1 (f z x) s'+{-# INLINE [0] foldl1 #-}++-- | A strict version of foldl1.+foldl1' :: (Char -> Char -> Char) -> Stream Char -> Char+foldl1' f (Stream next s0 _len) = loop0_foldl1' s0+ where+ loop0_foldl1' !s = case next s of+ Skip s' -> loop0_foldl1' s'+ Yield x s' -> loop_foldl1' x s'+ Done -> emptyError "foldl1"+ loop_foldl1' !z !s = case next s of+ Done -> z+ Skip s' -> loop_foldl1' z s'+ Yield x s' -> loop_foldl1' (f z x) s'+{-# INLINE [0] foldl1' #-}++-- | 'foldr', applied to a binary operator, a starting value (typically the+-- right-identity of the operator), and a stream, reduces the stream using the+-- binary operator, from right to left.+foldr :: (Char -> b -> b) -> b -> Stream Char -> b+foldr f z (Stream next s0 _len) = loop_foldr s0+ where+ loop_foldr !s = case next s of+ Done -> z+ Skip s' -> loop_foldr s'+ Yield x s' -> f x (loop_foldr s')+{-# INLINE [0] foldr #-}++-- | foldr1 is a variant of 'foldr' that has no starting value argument,+-- and thus must be applied to non-empty streams.+-- Subject to array fusion.+foldr1 :: (Char -> Char -> Char) -> Stream Char -> Char+foldr1 f (Stream next s0 _len) = loop0_foldr1 s0+ where+ loop0_foldr1 !s = case next s of+ Done -> emptyError "foldr1"+ Skip s' -> loop0_foldr1 s'+ Yield x s' -> loop_foldr1 x s'++ loop_foldr1 x !s = case next s of+ Done -> x+ Skip s' -> loop_foldr1 x s'+ Yield x' s' -> f x (loop_foldr1 x' s')+{-# INLINE [0] foldr1 #-}++intercalate :: Stream Char -> [Stream Char] -> Stream Char+intercalate s = concat . (L.intersperse s)+{-# INLINE [0] intercalate #-}++-- ----------------------------------------------------------------------------+-- ** Special folds++-- | /O(n)/ Concatenate a list of streams. Subject to array fusion.+concat :: [Stream Char] -> Stream Char+concat = L.foldr append (Stream next Done 0)+ where+ next Done = Done+ next _ = internalError "concat"++-- | Map a function over a stream that results in a stream and concatenate the+-- results.+concatMap :: (Char -> Stream Char) -> Stream Char -> Stream Char+concatMap f = foldr (append . f) empty++-- | /O(n)/ any @p @xs determines if any character in the stream+-- @xs@ satisifes the predicate @p@.+any :: (Char -> Bool) -> Stream Char -> Bool+any p (Stream next0 s0 _len) = loop_any s0+ where+ loop_any !s = case next0 s of+ Done -> False+ Skip s' -> loop_any s'+ Yield x s' | p x -> True+ | otherwise -> loop_any s'+{-# INLINE [0] any #-}++-- | /O(n)/ all @p @xs determines if all characters in the 'Text'+-- @xs@ satisify the predicate @p@.+all :: (Char -> Bool) -> Stream Char -> Bool+all p (Stream next0 s0 _len) = loop_all s0+ where+ loop_all !s = case next0 s of+ Done -> True+ Skip s' -> loop_all s'+ Yield x s' | p x -> loop_all s'+ | otherwise -> False+{-# INLINE [0] all #-}++-- | /O(n)/ maximum returns the maximum value from a stream, which must be+-- non-empty.+maximum :: Stream Char -> Char+maximum (Stream next0 s0 _len) = loop0_maximum s0+ where+ loop0_maximum !s = case next0 s of+ Done -> emptyError "maximum"+ Skip s' -> loop0_maximum s'+ Yield x s' -> loop_maximum x s'+ loop_maximum !z !s = case next0 s of+ Done -> z+ Skip s' -> loop_maximum z s'+ Yield x s'+ | x > z -> loop_maximum x s'+ | otherwise -> loop_maximum z s'+{-# INLINE [0] maximum #-}++-- | /O(n)/ minimum returns the minimum value from a 'Text', which must be+-- non-empty.+minimum :: Stream Char -> Char+minimum (Stream next0 s0 _len) = loop0_minimum s0+ where+ loop0_minimum !s = case next0 s of+ Done -> emptyError "minimum"+ Skip s' -> loop0_minimum s'+ Yield x s' -> loop_minimum x s'+ loop_minimum !z !s = case next0 s of+ Done -> z+ Skip s' -> loop_minimum z s'+ Yield x s'+ | x < z -> loop_minimum x s'+ | otherwise -> loop_minimum z s'+{-# INLINE [0] minimum #-}++-- -----------------------------------------------------------------------------+-- * Building streams++scanl :: (Char -> Char -> Char) -> Char -> Stream Char -> Stream Char+scanl f z0 (Stream next0 s0 len) = Stream next (S1 :!: z0 :!: s0) (len+1)+ where+ {-# INLINE next #-}+ next (S1 :!: z :!: s) = Yield z (S2 :!: z :!: s)+ next (S2 :!: z :!: s) = case next0 s of+ Yield x s' -> let !x' = f z x+ in Yield x' (S2 :!: x' :!: s')+ Skip s' -> Skip (S2 :!: z :!: s')+ Done -> Done+{-# INLINE [0] scanl #-}++-- | /O(n)/ Perform the equivalent of 'scanr' over a list, only with+-- the input and result reversed.+reverseScanr :: (Char -> Char -> Char) -> Char -> Stream Char -> Stream Char+reverseScanr f z0 (Stream next0 s0 len) = Stream next (S1 :!: z0 :!: s0) (len+1)+ where+ {-# INLINE next #-}+ next (S1 :!: z :!: s) = Yield z (S2 :!: z :!: s)+ next (S2 :!: z :!: s) = case next0 s of+ Yield x s' -> let !x' = f x z+ in Yield x' (S2 :!: x' :!: s')+ Skip s' -> Skip (S2 :!: z :!: s')+ Done -> Done+{-# INLINE reverseScanr #-}++-- -----------------------------------------------------------------------------+-- ** Accumulating maps++-- | /O(n)/ Like a combination of 'map' and 'foldl'. Applies a+-- function to each element of a stream, passing an accumulating+-- parameter from left to right, and returns a final stream.+--+-- /Note/: Unlike the version over lists, this function does not+-- return a final value for the accumulator, because the nature of+-- streams precludes it.+mapAccumL :: (a -> b -> (a,b)) -> a -> Stream b -> Stream b+mapAccumL f z0 (Stream next0 s0 len) = Stream next (s0 :!: z0) len+ where+ {-# INLINE next #-}+ next (s :!: z) = case next0 s of+ Yield x s' -> let (z',y) = f z x+ in Yield y (s' :!: z')+ Skip s' -> Skip (s' :!: z)+ Done -> Done+{-# INLINE [0] mapAccumL #-}++-- -----------------------------------------------------------------------------+-- ** Generating and unfolding streams++replicate :: Int -> Char -> Stream Char+replicate n c+ | n < 0 = empty+ | otherwise = Stream next 0 n+ where+ {-# INLINE next #-}+ next i | i >= n = Done+ | otherwise = Yield c (i + 1)+{-# INLINE [0] replicate #-}++-- | /O(n)/, where @n@ is the length of the result. The unfoldr function+-- is analogous to the List 'unfoldr'. unfoldr builds a stream+-- from a seed value. The function takes the element and returns+-- Nothing if it is done producing the stream or returns Just+-- (a,b), in which case, a is the next Char in the string, and b is+-- the seed value for further production.+unfoldr :: (a -> Maybe (Char,a)) -> a -> Stream Char+unfoldr f s0 = Stream next s0 1+ where+ {-# INLINE next #-}+ next !s = case f s of+ Nothing -> Done+ Just (w, s') -> Yield w s'+{-# INLINE [0] unfoldr #-}++-- | /O(n)/ Like 'unfoldr', 'unfoldrN' builds a stream from a seed+-- value. However, the length of the result is limited by the+-- first argument to 'unfoldrN'. This function is more efficient than+-- 'unfoldr' when the length of the result is known.+unfoldrN :: Int -> (a -> Maybe (Char,a)) -> a -> Stream Char+unfoldrN n f s0 | n < 0 = empty+ | otherwise = Stream next (0 :!: s0) (n*2)+ where+ {-# INLINE next #-}+ next (z :!: s) = case f s of+ Nothing -> Done+ Just (w, s') | z >= n -> Done+ | otherwise -> Yield w ((z + 1) :!: s')+-------------------------------------------------------------------------------+-- * Substreams++-- | /O(n)/ take n, applied to a stream, returns the prefix of the+-- stream of length @n@, or the stream itself if @n@ is greater than the+-- length of the stream.+take :: Int -> Stream Char -> Stream Char+take n0 (Stream next0 s0 len) = Stream next (n0 :!: s0) len+ where+ {-# INLINE next #-}+ next (n :!: s) | n <= 0 = Done+ | otherwise = case next0 s of+ Done -> Done+ Skip s' -> Skip (n :!: s')+ Yield x s' -> Yield x ((n-1) :!: s')+{-# INLINE [0] take #-}++-- | /O(n)/ drop n, applied to a stream, returns the suffix of the+-- stream of length @n@, or the empty stream if @n@ is greater than the+-- length of the stream.+drop :: Int -> Stream Char -> Stream Char+drop n0 (Stream next0 s0 len) = Stream next (Just ((max 0 n0)) :!: s0) (len - n0)+ where+ {-# INLINE next #-}+ next (Just !n :!: s)+ | n == 0 = Skip (Nothing :!: s)+ | otherwise = case next0 s of+ Done -> Done+ Skip s' -> Skip (Just n :!: s')+ Yield _ s' -> Skip (Just (n-1) :!: s')+ next (Nothing :!: s) = case next0 s of+ Done -> Done+ Skip s' -> Skip (Nothing :!: s')+ Yield x s' -> Yield x (Nothing :!: s')+{-# INLINE [0] drop #-}++-- | takeWhile, applied to a predicate @p@ and a stream, returns the+-- longest prefix (possibly empty) of elements that satisfy p.+takeWhile :: (Char -> Bool) -> Stream Char -> Stream Char+takeWhile p (Stream next0 s0 len) = Stream next s0 len+ where+ {-# INLINE next #-}+ next !s = case next0 s of+ Done -> Done+ Skip s' -> Skip s'+ Yield x s' | p x -> Yield x s'+ | otherwise -> Done+{-# INLINE [0] takeWhile #-}++-- | dropWhile @p @xs returns the suffix remaining after takeWhile @p @xs.+dropWhile :: (Char -> Bool) -> Stream Char -> Stream Char+dropWhile p (Stream next0 s0 len) = Stream next (S1 :!: s0) len+ where+ {-# INLINE next #-}+ next (S1 :!: s) = case next0 s of+ Done -> Done+ Skip s' -> Skip (S1 :!: s')+ Yield x s' | p x -> Skip (S1 :!: s')+ | otherwise -> Yield x (S2 :!: s')+ next (S2 :!: s) = case next0 s of+ Done -> Done+ Skip s' -> Skip (S2 :!: s')+ Yield x s' -> Yield x (S2 :!: s')+{-# INLINE [0] dropWhile #-}++-- | /O(n)/ The 'isPrefixOf' function takes two 'Stream's and returns+-- 'True' iff the first is a prefix of the second.+isPrefixOf :: (Eq a) => Stream a -> Stream a -> Bool+isPrefixOf (Stream next1 s1 _) (Stream next2 s2 _) = loop (next1 s1) (next2 s2)+ where+ loop Done _ = True+ loop _ Done = False+ loop (Skip s1') (Skip s2') = loop (next1 s1') (next2 s2')+ loop (Skip s1') x2 = loop (next1 s1') x2+ loop x1 (Skip s2') = loop x1 (next2 s2')+ loop (Yield x1 s1') (Yield x2 s2') = x1 == x2 &&+ loop (next1 s1') (next2 s2')+{-# INLINE [0] isPrefixOf #-}+{-# SPECIALISE isPrefixOf :: Stream Char -> Stream Char -> Bool #-}++-- ----------------------------------------------------------------------------+-- * Searching++-------------------------------------------------------------------------------+-- ** Searching by equality++-- | /O(n)/ elem is the stream membership predicate.+elem :: Char -> Stream Char -> Bool+elem w (Stream next s0 _len) = loop_elem s0+ where+ loop_elem !s = case next s of+ Done -> False+ Skip s' -> loop_elem s'+ Yield x s' | x == w -> True+ | otherwise -> loop_elem s'+{-# INLINE [0] elem #-}++-------------------------------------------------------------------------------+-- ** Searching with a predicate++-- | /O(n)/ The 'find' function takes a predicate and a stream,+-- and returns the first element in matching the predicate, or 'Nothing'+-- if there is no such element.++find :: (Char -> Bool) -> Stream Char -> Maybe Char+find p (Stream next s0 _len) = loop_find s0+ where+ loop_find !s = case next s of+ Done -> Nothing+ Skip s' -> loop_find s'+ Yield x s' | p x -> Just x+ | otherwise -> loop_find s'+{-# INLINE [0] find #-}++-- | /O(n)/ 'filter', applied to a predicate and a stream,+-- returns a stream containing those characters that satisfy the+-- predicate.+filter :: (Char -> Bool) -> Stream Char -> Stream Char+filter p (Stream next0 s0 len) = Stream next s0 len+ where+ {-# INLINE next #-}+ next !s = case next0 s of+ Done -> Done+ Skip s' -> Skip s'+ Yield x s' | p x -> Yield x s'+ | otherwise -> Skip s'+{-# INLINE [0] filter #-}++{-# RULES+ "Stream filter/filter fusion" forall p q s.+ filter p (filter q s) = filter (\x -> q x && p x) s+ #-}++-------------------------------------------------------------------------------+-- ** Indexing streams++-- | /O(1)/ stream index (subscript) operator, starting from 0.+index :: Stream Char -> Int -> Char+index (Stream next s0 _len) n0+ | n0 < 0 = streamError "index" "Negative index"+ | otherwise = loop_index n0 s0+ where+ loop_index !n !s = case next s of+ Done -> streamError "index" "Index too large"+ Skip s' -> loop_index n s'+ Yield x s' | n == 0 -> x+ | otherwise -> loop_index (n-1) s'+{-# INLINE [0] index #-}++-- | The 'findIndex' function takes a predicate and a stream and+-- returns the index of the first element in the stream+-- satisfying the predicate.+findIndex :: (Char -> Bool) -> Stream Char -> Maybe Int+findIndex p s = case findIndices p s of+ (i:_) -> Just i+ _ -> Nothing+{-# INLINE [0] findIndex #-}++-- | The 'findIndices' function takes a predicate and a stream and+-- returns all indices of the elements in the stream+-- satisfying the predicate.+findIndices :: (Char -> Bool) -> Stream Char -> [Int]+findIndices p (Stream next s0 _len) = loop_findIndex 0 s0+ where+ loop_findIndex !i !s = case next s of+ Done -> []+ Skip s' -> loop_findIndex i s' -- hmm. not caught by QC+ Yield x s' | p x -> i : loop_findIndex (i+1) s'+ | otherwise -> loop_findIndex (i+1) s'+{-# INLINE [0] findIndices #-}++-- | The 'findIndexOrEnd' function takes a predicate and a stream and+-- returns the index of the first element in the stream+-- satisfying the predicate.+findIndexOrEnd :: (Char -> Bool) -> Stream Char -> Int+findIndexOrEnd p (Stream next s0 _len) = loop_findIndex 0 s0+ where+ loop_findIndex !i !s = case next s of+ Done -> i+ Skip s' -> loop_findIndex i s' -- hmm. not caught by QC+ Yield x s' | p x -> i+ | otherwise -> loop_findIndex (i+1) s'+{-# INLINE [0] findIndexOrEnd #-}++-- | /O(n)/ The 'elemIndex' function returns the index of the first+-- element in the given stream which is equal to the query+-- element, or 'Nothing' if there is no such element.+elemIndex :: Char -> Stream Char -> Maybe Int+elemIndex a s = case elemIndices a s of+ (i:_) -> Just i+ _ -> Nothing+{-# INLINE [0] elemIndex #-}++-- | /O(n)/ The 'elemIndices' function returns the index of every+-- element in the given stream which is equal to the query element.+elemIndices :: Char -> Stream Char -> [Int]+elemIndices a (Stream next s0 _len) = loop 0 s0+ where+ loop !i !s = case next s of+ Done -> []+ Skip s' -> loop i s'+ Yield x s' | a == x -> i : loop (i+1) s'+ | otherwise -> loop (i+1) s'+{-# INLINE [0] elemIndices #-}++-- | /O(n)/ The 'count' function returns the number of times the query+-- element appears in the given stream.+count :: Char -> Stream Char -> Int+count a (Stream next s0 _len) = loop 0 s0+ where+ loop !i !s = case next s of+ Done -> i+ Skip s' -> loop i s'+ Yield x s' | a == x -> loop (i+1) s'+ | otherwise -> loop i s'+{-# INLINE [0] count #-}++-------------------------------------------------------------------------------+-- * Zipping++-- | zipWith generalises 'zip' by zipping with the function given as+-- the first argument, instead of a tupling function.+zipWith :: (Char -> Char -> Char) -> Stream Char -> Stream Char -> Stream Char+zipWith f (Stream next0 sa0 len1) (Stream next1 sb0 len2) = Stream next (sa0 :!: sb0 :!: Nothing) (min len1 len2)+ where+ {-# INLINE next #-}+ next (sa :!: sb :!: Nothing) = case next0 sa of+ Done -> Done+ Skip sa' -> Skip (sa' :!: sb :!: Nothing)+ Yield a sa' -> Skip (sa' :!: sb :!: Just a)++ next (sa' :!: sb :!: Just a) = case next1 sb of+ Done -> Done+ Skip sb' -> Skip (sa' :!: sb' :!: Just a)+ Yield b sb' -> Yield (f a b) (sa' :!: sb' :!: Nothing)+{-# INLINE [0] zipWith #-}
+ Data/Text/Internal.hs view
@@ -0,0 +1,63 @@+{-# LANGUAGE DeriveDataTypeable #-}++-- |+-- Module : Data.Text+-- Copyright : (c) Tom Harper 2008-2009,+-- (c) Bryan O'Sullivan 2009,+-- (c) Duncan Coutts 2009+--+-- License : BSD-style+-- Maintainer : rtharper@aftereternity.co.uk, bos@serpentine.com,+-- duncan@haskell.org+-- Stability : experimental+-- Portability : GHC+--+-- Semi-public internals. Most users should not need to use this+-- module.++module Data.Text.Internal+ (+ -- * Types+ Text(..)+ -- * Construction+ , text+ -- * Code that must be here for accessibility+ , empty+ -- * Debugging+ , showText+ ) where++import Control.Exception (assert)+import qualified Data.Text.Array as A+import Data.Typeable (Typeable)+import Data.Word (Word16)++-- | A space efficient, packed, unboxed Unicode text type.+data Text = Text+ {-# UNPACK #-} !(A.Array Word16) -- payload+ {-# UNPACK #-} !Int -- offset+ {-# UNPACK #-} !Int -- length+ deriving (Typeable)++-- | Smart constructor.+text :: A.Array Word16 -> Int -> Int -> Text+text arr off len =+ assert (len >= 0) .+ assert (off >= 0) .+ assert (alen == 0 || off < alen) .+ assert (len == 0 || c < 0xDC00 || c > 0xDFFF) $+ Text arr off len+ where c = A.unsafeIndex arr off+ alen = A.length arr+{-# INLINE text #-}++-- | /O(1)/ The empty 'Text'.+empty :: Text+empty = Text A.empty 0 0+{-# INLINE [1] empty #-}++-- | A useful 'show'-like function for debugging purposes.+showText :: Text -> String+showText (Text arr off len) =+ "Text " ++ (show . take (off+len) . A.toList) arr ++ ' ' :+ show off ++ ' ' : show len
+ Data/Text/Unsafe.hs view
@@ -0,0 +1,78 @@+-- |+-- Module : Data.Text.Unsafe+-- Copyright : (c) Bryan O'Sullivan 2009+-- License : BSD-style+-- Maintainer : bos@serpentine.com+-- Stability : experimental+-- Portability : portable+--+-- A module containing unsafe 'Text' operations, for very very careful+-- use in heavily tested code.+module Data.Text.Unsafe+ (+ iter+ , iter_+ , reverseIter+ , unsafeHead+ , unsafeTail+ ) where+ +import Control.Exception (assert)+import Data.Text.Internal (Text(..))+import Data.Text.UnsafeChar (unsafeChr)+import Data.Text.Encoding.Utf16 (chr2)+import qualified Data.Text.Array as A++-- | /O(1)/ A variant of 'head' for non-empty 'Text'. 'unsafeHead'+-- omits the check for the empty case, so there is an obligation on+-- the programmer to provide a proof that the 'Text' is non-empty.+unsafeHead :: Text -> Char+unsafeHead (Text arr off len)+ | m < 0xD800 || m > 0xDBFF = unsafeChr m+ | otherwise = chr2 m n+ where m = assert (len > 0) $ A.unsafeIndex arr off+ n = assert (len > 1) $ A.unsafeIndex arr (off+1)+{-# INLINE unsafeHead #-}++-- | /O(1)/ A variant of 'tail' for non-empty 'Text'. 'unsafeHead'+-- omits the check for the empty case, so there is an obligation on+-- the programmer to provide a proof that the 'Text' is non-empty.+unsafeTail :: Text -> Text+unsafeTail t@(Text arr off len) =+ assert (d <= len) $ Text arr (off+d) (len-d)+ where d = iter_ t 0+{-# INLINE unsafeTail #-}++-- | /O(1)/ Iterate one step forwards through a UTF-16 array,+-- returning the current character and the delta to add to give the+-- next offset to iterate at.+iter :: Text -> Int -> (Char,Int)+iter (Text arr off len) i+ | m < 0xD800 || m > 0xDBFF = (unsafeChr m, 1)+ | otherwise = (chr2 m n, 2)+ where m = assert (i < len) $ A.unsafeIndex arr j+ n = assert (i + 1 < len) $ A.unsafeIndex arr k+ j = assert (i >= 0) $ off + i+ k = j + 1+{-# INLINE iter #-}++-- | /O(1)/ Iterate one step through a UTF-16 array, returning the+-- delta to add to give the next offset to iterate at.+iter_ :: Text -> Int -> Int+iter_ (Text arr off len) i | m < 0xD800 || m > 0xDBFF = 1+ | otherwise = 2+ where m = assert (i >= 0 && i < len) $ A.unsafeIndex arr (off+i)+{-# INLINE iter_ #-}++-- | /O(1)/ Iterate one step backwards through a UTF-16 array,+-- returning the current character and the delta to add (i.e. a+-- negative number) to give the next offset to iterate at.+reverseIter :: Text -> Int -> (Char,Int)+reverseIter (Text arr off len) i+ | m < 0xDC00 || m > 0xDFFF = (unsafeChr m, -1)+ | otherwise = (chr2 n m, -2)+ where m = assert (i < len) $ A.unsafeIndex arr j+ n = assert (i - 1 >= 0) $ A.unsafeIndex arr k+ j = assert (i >= 0) $ off + i+ k = j - 1+{-# INLINE reverseIter #-}
+ Data/Text/UnsafeChar.hs view
@@ -0,0 +1,77 @@+{-# LANGUAGE MagicHash #-}++-- |+-- Module : Data.Text.UnsafeChar+-- Copyright : (c) Tom Harper 2008-2009,+-- (c) Bryan O'Sullivan 2009,+-- (c) Duncan Coutts 2009+--+-- License : BSD-style+-- Maintainer : rtharper@aftereternity.co.uk, bos@serpentine.com,+-- duncan@haskell.org+-- Stability : experimental+-- Portability : GHC+--+-- Fast character manipulation functions.+module Data.Text.UnsafeChar+ (+ unsafeChr+ , unsafeChr8+ , unsafeChr32+ , unsafeWrite+ , unsafeWriteRev+ ) where++import Control.Exception (assert)+import Control.Monad.ST (ST)+import Data.Bits ((.&.), shiftR)+import Data.Char (ord)+import GHC.Exts (Char(..), chr#, word2Int#)+import GHC.Word (Word8(..), Word16(..), Word32(..))+import qualified Data.Text.Array as A++unsafeChr :: Word16 -> Char+unsafeChr (W16# w#) = C# (chr# (word2Int# w#))+{-# INLINE unsafeChr #-}++unsafeChr8 :: Word8 -> Char+unsafeChr8 (W8# w#) = C# (chr# (word2Int# w#))+{-# INLINE unsafeChr8 #-}++unsafeChr32 :: Word32 -> Char+unsafeChr32 (W32# w#) = C# (chr# (word2Int# w#))+{-# INLINE unsafeChr32 #-}++unsafeWrite :: A.MArray s Word16 -> Int -> Char -> ST s Int+unsafeWrite marr i c+ | n < 0x10000 = do+ assert (i >= 0) . assert (i < A.length marr) $+ A.unsafeWrite marr i (fromIntegral n)+ return (i+1)+ | otherwise = do+ assert (i >= 0) . assert (i < A.length marr - 1) $+ A.unsafeWrite marr i lo+ A.unsafeWrite marr (i+1) hi+ return (i+2)+ where n = ord c+ m = n - 0x10000+ lo = fromIntegral $ (m `shiftR` 10) + 0xD800+ hi = fromIntegral $ (m .&. 0x3FF) + 0xDC00+{-# INLINE unsafeWrite #-}++unsafeWriteRev :: A.MArray s Word16 -> Int -> Char -> ST s Int+unsafeWriteRev marr i c+ | n < 0x10000 = do+ assert (i >= 0) . assert (i < A.length marr) $+ A.unsafeWrite marr i (fromIntegral n)+ return (i-1)+ | otherwise = do+ assert (i >= 1) . assert (i < A.length marr) $+ A.unsafeWrite marr (i-1) lo+ A.unsafeWrite marr i hi+ return (i-2)+ where n = ord c+ m = n - 0x10000+ lo = fromIntegral $ (m `shiftR` 10) + 0xD800+ hi = fromIntegral $ (m .&. 0x3FF) + 0xDC00+{-# INLINE unsafeWriteRev #-}
+ LICENSE view
@@ -0,0 +1,26 @@+Copyright (c) 2008-2009, Tom Harper+All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions+are met:++ * Redistributions of source code must retain the above copyright+ notice, this list of conditions and the following disclaimer.++ * Redistributions in binary form must reproduce the above+ copyright notice, this list of conditions and the following+ disclaimer in the documentation and/or other materials provided+ with the distribution.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ README view
@@ -0,0 +1,35 @@+Text: Fast, packed Unicode strings, using stream fusion+-------------------------------------------------------++This package provides the Data.Text library, a library for the space-+and time-efficient manipulation of Unicode text in Haskell.+++Normalization, conversion, and collation, oh my!+------------------------------------------------++This library intentionally provides a simple API based on the Haskell+prelude's list manipulation functions. For more complicated+real-world tasks, such as Unicode normalization, conversion to and+from a larger variety of encodings, and collation, use the text-icu+package:++ http://hackage.haskell.org/cgi-bin/hackage-scripts/package/text-icu++That library uses the well-respected and liberally licensed ICU+library to provide these facilities.+++Source code+-----------++darcs get http://code.haskell.org/text+++Authors+-------++The base code for this library was originally written by Tom Harper,+based on the stream fusion framework developed by Roman Leshchinskiy,+Duncan Coutts, and Don Stewart. The core library was fleshed out,+debugged, and tested by Bryan O'Sullivan.
+ Setup.lhs view
@@ -0,0 +1,3 @@+#!/usr/bin/env runhaskell+> import Distribution.Simple+> main = defaultMain
+ text.cabal view
@@ -0,0 +1,45 @@+name: text+version: 0.1+synopsis: An efficient packed Unicode text type+description: An efficient packed Unicode text type.+license: BSD3+license-file: LICENSE+author: Tom Harper <rtharper@aftereternity.co.uk>+maintainer: Bryan O'Sullivan <bos@serpentine.com>+ Tom Harper <rtharper@aftereternity.co.uk>+ Duncan Coutts <duncan@haskell.org>+copyright: 2008-2009 Tom Harper+category: Data, Text+build-type: Simple+cabal-version: >= 1.2+extra-source-files: README++library+ exposed-modules:+ Data.Text+ Data.Text.Encoding+ Data.Text.Encoding.Fusion+ Data.Text.Foreign+ Data.Text.Fusion+ other-modules:+ Data.Text.Array+ Data.Text.Internal+ Data.Text.Unsafe+ Data.Text.UnsafeChar+ Data.Text.Encoding.Utf8+ Data.Text.Encoding.Utf16+ Data.Text.Encoding.Utf32++ build-depends:+ base < 5,+ bytestring >= 0.9 && < 1.0+ if impl(ghc >= 6.10)+ build-depends:+ ghc-prim, base >= 4++ -- gather extensive profiling data for now+ ghc-prof-options: -auto-all++ ghc-options: -Wall -funbox-strict-fields -O2+ if impl(ghc >= 6.8)+ ghc-options: -fwarn-tabs