1{-# LANGUAGE BangPatterns #-}
2{-# OPTIONS_GHC -fno-warn-orphans #-}
54import Prelude (Char,Bool,Int,Maybe,String,
58 (&&),(||),(+),(-),(<),(>),(<=),(>=),(.),(>>=),
62import Data.Char (isSpace)
63import Control.Monad.ST(ST)
64import Data.Array.Base(unsafeNewArray_,unsafeWrite,unsafeAt)
65import Data.Array.ST(STUArray, runSTUArray)
66import qualified Data.ByteString as B
67import Data.ByteString(ByteString)
68import qualified Data.List as L
69import Data.Monoid(Monoid(..))
70import Data.Word(Word16)
71import Data.String (IsString(..))
73import qualified Data.Text.Fusion as S
74import Data.Text.Fusion (Stream(..),Step(..),Encoding(..),
75 stream,unstream,stream_bs,unstream_bs,restream)
76import Data.Text.Internal(Text(..),empty)
77import qualified Prelude as P
78import Data.Text.UnsafeChar(unsafeChr)
79import qualified Data.Text.Utf16 as U16
82 t1 == t2 = (stream t1) `S.eq` (stream t2)
84instance Show Text where
85 showsPrec p ps r = showsPrec p (unpack ps) r
87instance Read Text where
88 readsPrec p str = [(pack x,y) | (x,y) <- readsPrec p str]
90instance Monoid Text where
95instance IsString Text where
98-- -----------------------------------------------------------------------------
99-- * Conversion to/from 'Text'
101-- | /O(n)/ Convert a String into a Text.
103-- This function is subject to array fusion, so calling other fusible
104-- function(s) on a packed string will only cause one 'Text' to be written
105-- out at the end of the pipeline, instead of one before and one after.
106pack :: String -> Text
107pack str = (unstream (stream_list str))
109 stream_list s0 = S.Stream next s0 (P.length s0) -- total guess
112 next (x:xs) = S.Yield x xs
113{-# INLINE [1] pack #-}
114-- TODO: Has to do validation! -- No, it doesn't, the
116-- | /O(n)/ Convert a Text into a String.
117-- Subject to array fusion.
118unpack :: Text -> String
119unpack txt = (unstream_list (stream txt))
121 unstream_list (S.Stream next s0 _len) = unfold s0
123 unfold !s = case next s of
125 S.Skip s' -> unfold s'
126 S.Yield x s' -> x : unfold s'
127{-# INLINE [1] unpack #-}
129-- | Convert a character into a Text.
130-- Subject to array fusion.
131singleton :: Char -> Text
132singleton c = unstream (Stream next (c:[]) 1)
135 next (k:ks) = Yield k ks
137{-# INLINE [1] singleton #-}
139decode :: Encoding -> ByteString -> Text
140decode enc bs = unstream (stream_bs enc bs)
143encode :: Encoding -> Text -> ByteString
144encode enc txt = unstream_bs (restream enc (stream txt))
147-- -----------------------------------------------------------------------------
150-- | /O(n)/ Adds a character to the front of a 'Text'. This function is more
151-- costly than its 'List' counterpart because it requires copying a new array.
152-- Subject to array fusion.
153cons :: Char -> Text -> Text
154cons c t = unstream (S.cons c (stream t))
157-- | /O(n)/ Adds a character to the end of a 'Text'. This copies the entire
158-- array in the process.
159-- Subject to array fusion.
160snoc :: Text -> Char -> Text
161snoc t c = unstream (S.snoc (stream t) c)
164-- | /O(n)/ Appends one Text to the other by copying both of them into a new
166-- Subject to array fusion
167append :: Text -> Text -> Text
168append (Text arr1 off1 len1) (Text arr2 off2 len2) = Text (runSTUArray x) 0 len
172 arr <- unsafeNewArray_ (0,len-1) :: ST s (STUArray s Int Word16)
173 copy arr1 off1 (len1+off1) arr 0
174 copy arr2 off2 (len2+off2) arr len1
177 copy arr i max arr' j
178 | i >= max = return ()
179 | otherwise = do unsafeWrite arr' j (arr `unsafeAt` i)
180 copy arr (i+1) max arr' (j+1)
184"TEXT append -> fused" [~1] forall t1 t2.
185 append t1 t2 = unstream (S.append (stream t1) (stream t2))
186"TEXT append -> unfused" [1] forall t1 t2.
187 unstream (S.append (stream t1) (stream t2)) = append t1 t2
190-- | /O(1)/ Returns the first character of a Text, which must be non-empty.
191-- Subject to array fusion.
193head t = S.head (stream t)
196-- | /O(n)/ Returns the last character of a Text, which must be non-empty.
197-- Subject to array fusion.
199last (Text arr off len)
200 | len <= 0 = errorEmptyList "last"
201 | n < 0xDC00 || n > 0xDFFF = unsafeChr n
202 | otherwise = U16.chr2 n0 n
204 n = unsafeAt arr (off+len-1)
205 n0 = unsafeAt arr (off+len-2)
206{-# INLINE [1] last #-}
209"TEXT last -> fused" [~1] forall t.
210 last t = S.last (stream t)
211"TEXT last -> unfused" [1] forall t.
212 S.last (stream t) = last t
216-- | /O(1)/ Returns all characters after the head of a Text, which must
218-- Subject to array fusion.
220tail (Text arr off len)
221 | len <= 0 = errorEmptyList "tail"
222 | n >= 0xD800 && n <= 0xDBFF = Text arr (off+2) (len-2)
223 | otherwise = Text arr (off+1) (len-1)
226{-# INLINE [1] tail #-}
230-- | /O(1)/ Returns all but the last character of a Text, which
232-- Subject to array fusion.
234init (Text arr off len) | len <= 0 = errorEmptyList "init"
235 | n >= 0xDC00 && n <= 0xDFFF = Text arr off (len-2)
236 | otherwise = Text arr off (len-1)
238 n = unsafeAt arr (off+len-1)
239{-# INLINE [1] init #-}
242"TEXT init -> fused" [~1] forall t.
243 init t = unstream (S.init (stream t))
244"TEXT init -> unfused" [1] forall t.
245 unstream (S.init (stream t)) = init t
248-- | /O(1)/ Tests whether a Text is empty or not.
249-- Subject to array fusion.
251null t = S.null (stream t)
254-- | /O(n)/ Returns the number of characters in a text.
255-- Subject to array fusion.
257length t = S.length (stream t)
260-- -----------------------------------------------------------------------------
262-- | /O(n)/ 'map' @f @xs is the Text obtained by applying @f@ to each
264-- Subject to array fusion.
265map :: (Char -> Char) -> Text -> Text
266map f t = unstream (S.map f (stream t))
267{-# INLINE [1] map #-}
269-- | /O(n)/ The 'intersperse' function takes a character and places it between
270-- the characters of a Text.
271-- Subject to array fusion.
272intersperse :: Char -> Text -> Text
273intersperse c t = unstream (S.intersperse c (stream t))
274{-# INLINE intersperse #-}
276-- | /O(n)/ The 'transpose' function transposes the rows and columns of its
277-- Text argument. Note that this function uses pack, unpack, and the 'List'
278-- version of transpose and is thus not very efficient.
279transpose :: [Text] -> [Text]
280transpose ts = P.map pack (L.transpose (P.map unpack ts))
282-- -----------------------------------------------------------------------------
283-- * Reducing 'Text's (folds)
285-- | 'foldl', applied to a binary operator, a starting value (typically the
286-- left-identity of the operator), and a Text, reduces the Text using the
287-- binary operator, from left to right.
288-- Subject to array fusion.
289foldl :: (b -> Char -> b) -> b -> Text -> b
290foldl f z t = S.foldl f z (stream t)
293-- | A strict version of 'foldl'.
294-- Subject to array fusion.
295foldl' :: (b -> Char -> b) -> b -> Text -> b
296foldl' f z t = S.foldl' f z (stream t)
299-- | 'foldl1' is a variant of 'foldl' that has no starting value argument,
300-- and thus must be applied to non-empty 'Text's.
301-- Subject to array fusion.
302foldl1 :: (Char -> Char -> Char) -> Text -> Char
303foldl1 f t = S.foldl1 f (stream t)
306-- | A strict version of 'foldl1'.
307-- Subject to array fusion.
308foldl1' :: (Char -> Char -> Char) -> Text -> Char
309foldl1' f t = S.foldl1' f (stream t)
310{-# INLINE foldl1' #-}
312-- | 'foldr', applied to a binary operator, a starting value (typically the
313-- right-identity of the operator), and a Text, reduces the Text using the
314-- binary operator, from right to left.
315-- Subject to array fusion.
316foldr :: (Char -> b -> b) -> b -> Text -> b
317foldr f z t = S.foldr f z (stream t)
320-- | 'foldr1' is a variant of 'foldr' that has no starting value argument,
321-- and thust must be applied to non-empty 'Text's.
322-- Subject to array fusion.
323foldr1 :: (Char -> Char -> Char) -> Text -> Char
324foldr1 f t = S.foldr1 f (stream t)
327-- -----------------------------------------------------------------------------
330-- | /O(n)/ Concatenate a list of 'Text's. Subject to array fusion.
331concat :: [Text] -> Text
332concat ts = unstream (S.concat (L.map stream ts))
335-- | Map a function over a Text that results in a Text and concatenate the
336-- results. This function is subject to array fusion, and note that if in
337-- 'concatMap' @f @xs, @f@ is defined in terms of fusible functions it will
339concatMap :: (Char -> Text) -> Text -> Text
340concatMap f t = unstream (S.concatMap (stream . f) (stream t))
341{-# INLINE concatMap #-}
343-- | 'any' @p @xs determines if any character in the 'Text' @xs@ satisifes the
344-- predicate @p@. Subject to array fusion.
345any :: (Char -> Bool) -> Text -> Bool
346any p t = S.any p (stream t)
349-- | 'all' @p @xs determines if all characters in the 'Text' @xs@ satisify the
350-- predicate @p@. Subject to array fusion.
351all :: (Char -> Bool) -> Text -> Bool
352all p t = S.all p (stream t)
355-- | /O(n)/ 'maximum' returns the maximum value from a 'Text', which must be
356-- non-empty. Subject to array fusion.
357maximum :: Text -> Char
358maximum t = S.maximum (stream t)
359{-# INLINE maximum #-}
361-- | /O(n)/ 'minimum' returns the minimum value from a 'Text', which must be
362-- non-empty. Subject to array fusion.
363minimum :: Text -> Char
364minimum t = S.minimum (stream t)
365{-# INLINE minimum #-}
367-- -----------------------------------------------------------------------------
370-- -----------------------------------------------------------------------------
371-- ** Generating and unfolding 'Text's
373-- /O(n)/, where @n@ is the length of the result. The unfoldr function
374-- is analogous to the List 'unfoldr'. unfoldr builds a Text
375-- from a seed value. The function takes the element and returns
376-- Nothing if it is done producing the Text or returns Just
377-- (a,b), in which case, a is the next Char in the string, and b is
378-- the seed value for further production.
379unfoldr :: (a -> Maybe (Char,a)) -> a -> Text
380unfoldr f s = unstream (S.unfoldr f s)
381{-# INLINE unfoldr #-}
383-- O(n) Like unfoldr, unfoldrN builds a Text from a seed
384-- value. However, the length of the result should be limited by the
385-- first argument to unfoldrN. This function is more efficient than
386-- unfoldr when the maximum length of the result and correct,
387-- otherwise its complexity performance is similar to 'unfoldr'
388unfoldrN :: Int -> (a -> Maybe (Char,a)) -> a -> Text
389unfoldrN n f s = unstream (S.unfoldrN n f s)
390{-# INLINE unfoldrN #-}
392-- -----------------------------------------------------------------------------
395-- O(n) 'take' @n, applied to a Text, returns the prefix of the
396-- Text of length n, or the Text itself if n is greater than the
397-- length of the Text.
398take :: Int -> Text -> Text
399take n (Text arr off len) = Text arr off (loop off 0)
403 | i >= end || count >= n = i - off
404 | c < 0xD800 || c > 0xDBFF = loop (i+1) (count+1)
405 | otherwise = loop (i+2) (count+1)
408{-# INLINE [1] take #-}
411"TEXT take -> fused" [~1] forall n t.
412 take n t = unstream (S.take n (stream t))
413"TEXT take -> unfused" [1] forall n t.
414 unstream (S.take n (stream t)) = take n t
417-- /O(n)/ 'drop' @n, applied to a Text, returns the suffix of the
418-- Text of length @n, or the empty Text if @n is greater than the
419-- length of the Text.
420drop :: Int -> Text -> Text
421drop n (Text arr off len) = (Text arr newOff newLen)
423 (newOff, newLen) = loop off 0 len
426 | i >= end || count >= n = (i,l)
427 | c < 0xD800 || c > 0xDBFF = loop (i+1) (count+1) (l-1)
428 | otherwise = loop (i+2) (count+1) (l-2)
431{-# INLINE [1] drop #-}
434"TEXT drop -> fused" [~1] forall n t.
435 drop n t = unstream (S.drop n (stream t))
436"TEXT drop -> unfused" [1] forall n t.
437 unstream (S.drop n (stream t)) = drop n t
440-- | 'takeWhile', applied to a predicate @p@ and a stream, returns the
441-- longest prefix (possibly empty) of elements that satisfy p.
442takeWhile :: (Char -> Bool) -> Text -> Text
443takeWhile p t = unstream (S.takeWhile p (stream t))
445-- | 'dropWhile' @p @xs returns the suffix remaining after 'takeWhile' @p @xs.
446dropWhile :: (Char -> Bool) -> Text -> Text
447dropWhile p t = unstream (S.dropWhile p (stream t))
449-- ----------------------------------------------------------------------------
452-------------------------------------------------------------------------------
453-- ** Searching by equality
455-- | /O(n)/ 'elem' is the 'Text' membership predicate.
456elem :: Char -> Text -> Bool
457elem c t = S.elem c (stream t)
460-------------------------------------------------------------------------------
461-- ** Searching with a predicate
463-- | /O(n)/ The 'find' function takes a predicate and a 'Text',
464-- and returns the first element in matching the predicate, or 'Nothing'
465-- if there is no such element.
466find :: (Char -> Bool) -> Text -> Maybe Char
467find p t = S.find p (stream t)
470-- | /O(n)/ 'filter', applied to a predicate and a 'Text',
471-- returns a 'Text' containing those characters that satisfy the
473filter :: (Char -> Bool) -> Text -> Text
474filter p t = unstream (S.filter p (stream t))
478-------------------------------------------------------------------------------
479-- ** Indexing 'Text's
481-- | /O(1)/ 'Text' index (subscript) operator, starting from 0.
482index :: Text -> Int -> Char
483index t n = S.index (stream t) n
486-- | The 'findIndex' function takes a predicate and a 'Text' and
487-- returns the index of the first element in the 'Text'
488-- satisfying the predicate.
489findIndex :: (Char -> Bool) -> Text -> Maybe Int
490findIndex p t = S.findIndex p (stream t)
491{-# INLINE findIndex #-}
493-- | /O(n)/ The 'elemIndex' function returns the index of the first
494-- element in the given 'Text' which is equal to the query element, or
495-- 'Nothing' if there is no such element.
496elemIndex :: Char -> Text -> Maybe Int
497elemIndex c t = S.elemIndex c (stream t)
499-------------------------------------------------------------------------------
502-- | /O(n)/ 'zipWith' generalises 'zip' by zipping with the function
503-- given as the first argument, instead of a tupling function.
504zipWith :: (Char -> Char -> Char) -> Text -> Text -> Text
505zipWith f t1 t2 = unstream (S.zipWith f (stream t1) (stream t2))
509readFile :: Encoding -> FilePath -> IO Text
510readFile enc f = B.readFile f >>= return . unstream . stream_bs enc
511{-# INLINE [1] readFile #-}
513words :: Text -> [Text]
514words (Text arr off len) = loop0 off off
517 | isSpace (unsafeChr c) = if start == n
518 then loop0 (start+1) (start+1)
519 else (Text arr start (n-start)):loop0 (n+1) (n+1)
520 | n < (off+len) = loop0 start (n+1)
521 | otherwise = if start == n
523 else [(Text arr start (n-start))]
528errorEmptyList :: String -> a
529errorEmptyList fun = error ("Data.Text." ++ fun ++ ": empty list")
keysesc to close
- j k
- move down, up
- enter
- open
- esc
- back, or up a level
- 1 2 3 4
- readme, files, commits, refs
- /
- filter
- y
- copy the clone command
- c
- compare the chosen commit with another (or shift-click both)
- ?
- show or hide this list