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,
77import Data.Text.Internal(Text(..),empty)
78import qualified Prelude as P
79import Data.Text.UnsafeChar(unsafeChr)
80import qualified Data.Text.Utf16 as U16
83 t1 == t2 = (stream t1) `S.eq` (stream t2)
85instance Show Text where
86 showsPrec p ps r = showsPrec p (unpack ps) r
88instance Read Text where
89 readsPrec p str = [(pack x,y) | (x,y) <- readsPrec p str]
91instance Monoid Text where
96instance IsString Text where
99-- -----------------------------------------------------------------------------
100-- * Conversion to/from 'Text'
102-- | /O(n)/ Convert a String into a Text.
104-- This function is subject to array fusion, so calling other fusible
105-- function(s) on a packed string will only cause one 'Text' to be written
106-- out at the end of the pipeline, instead of one before and one after.
107pack :: String -> Text
108pack str = (unstream (stream_list str))
110 stream_list s0 = S.Stream next s0 (P.length s0) -- total guess
113 next (x:xs) = S.Yield x xs
114{-# INLINE [1] pack #-}
115-- TODO: Has to do validation! -- No, it doesn't, the
117-- | /O(n)/ Convert a Text into a String.
118-- Subject to array fusion.
119unpack :: Text -> String
120unpack txt = (unstream_list (stream txt))
122 unstream_list (S.Stream next s0 _len) = unfold s0
124 unfold !s = case next s of
126 S.Skip s' -> seq s' $ unfold s'
127 S.Yield x s' -> seq s' $ x : unfold s'
128{-# INLINE [1] unpack #-}
130-- | Convert a character into a Text.
131-- Subject to array fusion.
132singleton :: Char -> Text
133singleton c = unstream (Stream next (c:[]) 1)
136 next (c:cs) = Yield c cs
138{-# INLINE [1] singleton #-}
140decode :: Encoding -> ByteString -> Text
141decode enc bs = unstream (stream_bs enc bs)
144encode :: Encoding -> Text -> ByteString
145encode enc txt = unstream_bs (restream enc (stream txt))
148-- -----------------------------------------------------------------------------
151-- | /O(n)/ Adds a character to the front of a 'Text'. This function is more
152-- costly than its 'List' counterpart because it requires copying a new array.
153-- Subject to array fusion.
154cons :: Char -> Text -> Text
155cons c t = unstream (S.cons c (stream t))
158-- | /O(n)/ Adds a character to the end of a 'Text'. This copies the entire
159-- array in the process.
160-- Subject to array fusion.
161snoc :: Text -> Char -> Text
162snoc t c = unstream (S.snoc (stream t) c)
165-- | /O(n)/ Appends one Text to the other by copying both of them into a new
167-- Subject to array fusion
168append :: Text -> Text -> Text
169append (Text arr1 off1 len1) (Text arr2 off2 len2) = Text (runSTUArray x) 0 len
173 arr <- unsafeNewArray_ (0,len-1) :: ST s (STUArray s Int Word16)
174 copy arr1 off1 (len1+off1) arr 0
175 copy arr2 off2 (len2+off2) arr len1
178 copy arr i max arr' j
179 | i >= max = return ()
180 | otherwise = do unsafeWrite arr' j (arr `unsafeAt` i)
181 copy arr (i+1) max arr' (j+1)
185"TEXT append -> fused" [~1] forall t1 t2.
186 append t1 t2 = unstream (S.append (stream t1) (stream t2))
187"TEXT append -> unfused" [1] forall t1 t2.
188 unstream (S.append (stream t1) (stream t2)) = append t1 t2
191-- | /O(1)/ Returns the first character of a Text, which must be non-empty.
192-- Subject to array fusion.
194head t = S.head (stream t)
197-- | /O(n)/ Returns the last character of a Text, which must be non-empty.
198-- Subject to array fusion.
200last (Text arr off len)
201 | len <= 0 = errorEmptyList "last"
202 | n < 0xDC00 || n > 0xDFFF = unsafeChr n
203 | otherwise = U16.chr2 n0 n
205 n = unsafeAt arr (off+len-1)
206 n0 = unsafeAt arr (off+len-2)
207{-# INLINE [1] last #-}
210"TEXT last -> fused" [~1] forall t.
211 last t = S.last (stream t)
212"TEXT last -> unfused" [1] forall t.
213 S.last (stream t) = last t
217-- | /O(1)/ Returns all characters after the head of a Text, which must
219-- Subject to array fusion.
221tail (Text arr off len)
222 | len <= 0 = errorEmptyList "tail"
223 | n >= 0xD800 && n <= 0xDBFF = Text arr (off+2) (len-2)
224 | otherwise = Text arr (off+1) (len-1)
227{-# INLINE [1] tail #-}
231-- | /O(1)/ Returns all but the last character of a Text, which
233-- Subject to array fusion.
235init (Text arr off len) | len <= 0 = errorEmptyList "init"
236 | n >= 0xDC00 && n <= 0xDFFF = Text arr off (len-2)
237 | otherwise = Text arr off (len-1)
239 n = unsafeAt arr (off+len-1)
240{-# INLINE [1] init #-}
243"TEXT init -> fused" [~1] forall t.
244 init t = unstream (S.init (stream t))
245"TEXT init -> unfused" [1] forall t.
246 unstream (S.init (stream t)) = init t
249-- | /O(1)/ Tests whether a Text is empty or not.
250-- Subject to array fusion.
252null t = S.null (stream t)
255-- | /O(n)/ Returns the number of characters in a text.
256-- Subject to array fusion.
258length t = S.length (stream t)
261-- -----------------------------------------------------------------------------
263-- | /O(n)/ 'map' @f @xs is the Text obtained by applying @f@ to each
265-- Subject to array fusion.
266map :: (Char -> Char) -> Text -> Text
267map f t = unstream (S.map f (stream t))
268{-# INLINE [1] map #-}
270-- | /O(n)/ The 'intersperse' function takes a character and places it between
271-- the characters of a Text.
272-- Subject to array fusion.
273intersperse :: Char -> Text -> Text
274intersperse c t = unstream (S.intersperse c (stream t))
275{-# INLINE intersperse #-}
277-- | /O(n)/ The 'transpose' function transposes the rows and columns of its
278-- Text argument. Note that this function uses pack, unpack, and the 'List'
279-- version of transpose and is thus not very efficient.
280transpose :: [Text] -> [Text]
281transpose ts = P.map pack (L.transpose (P.map unpack ts))
283-- -----------------------------------------------------------------------------
284-- * Reducing 'Text's (folds)
286-- | 'foldl', applied to a binary operator, a starting value (typically the
287-- left-identity of the operator), and a Text, reduces the Text using the
288-- binary operator, from left to right.
289-- Subject to array fusion.
290foldl :: (b -> Char -> b) -> b -> Text -> b
291foldl f z t = S.foldl f z (stream t)
294-- | A strict version of 'foldl'.
295-- Subject to array fusion.
296foldl' :: (b -> Char -> b) -> b -> Text -> b
297foldl' f z t = S.foldl' f z (stream t)
300-- | 'foldl1' is a variant of 'foldl' that has no starting value argument,
301-- and thus must be applied to non-empty 'Text's.
302-- Subject to array fusion.
303foldl1 :: (Char -> Char -> Char) -> Text -> Char
304foldl1 f t = S.foldl1 f (stream t)
307-- | A strict version of 'foldl1'.
308-- Subject to array fusion.
309foldl1' :: (Char -> Char -> Char) -> Text -> Char
310foldl1' f t = S.foldl1' f (stream t)
311{-# INLINE foldl1' #-}
313-- | 'foldr', applied to a binary operator, a starting value (typically the
314-- right-identity of the operator), and a Text, reduces the Text using the
315-- binary operator, from right to left.
316-- Subject to array fusion.
317foldr :: (Char -> b -> b) -> b -> Text -> b
318foldr f z t = S.foldr f z (stream t)
321-- | 'foldr1' is a variant of 'foldr' that has no starting value argument,
322-- and thust must be applied to non-empty 'Text's.
323-- Subject to array fusion.
324foldr1 :: (Char -> Char -> Char) -> Text -> Char
325foldr1 f t = S.foldr1 f (stream t)
328-- -----------------------------------------------------------------------------
331-- | /O(n)/ Concatenate a list of 'Text's. Subject to array fusion.
332concat :: [Text] -> Text
333concat ts = unstream (S.concat (L.map stream ts))
336-- | Map a function over a Text that results in a Text and concatenate the
337-- results. This function is subject to array fusion, and note that if in
338-- 'concatMap' @f @xs, @f@ is defined in terms of fusible functions it will
340concatMap :: (Char -> Text) -> Text -> Text
341concatMap f t = unstream (S.concatMap (stream . f) (stream t))
342{-# INLINE concatMap #-}
344-- | 'any' @p @xs determines if any character in the 'Text' @xs@ satisifes the
345-- predicate @p@. Subject to array fusion.
346any :: (Char -> Bool) -> Text -> Bool
347any p t = S.any p (stream t)
350-- | 'all' @p @xs determines if all characters in the 'Text' @xs@ satisify the
351-- predicate @p@. Subject to array fusion.
352all :: (Char -> Bool) -> Text -> Bool
353all p t = S.all p (stream t)
356-- | /O(n)/ 'maximum' returns the maximum value from a 'Text', which must be
357-- non-empty. Subject to array fusion.
358maximum :: Text -> Char
359maximum t = S.maximum (stream t)
360{-# INLINE maximum #-}
362-- | /O(n)/ 'minimum' returns the minimum value from a 'Text', which must be
363-- non-empty. Subject to array fusion.
364minimum :: Text -> Char
365minimum t = S.minimum (stream t)
366{-# INLINE minimum #-}
368-- -----------------------------------------------------------------------------
371-- -----------------------------------------------------------------------------
372-- ** Generating and unfolding 'Text's
374-- /O(n)/, where @n@ is the length of the result. The unfoldr function
375-- is analogous to the List 'unfoldr'. unfoldr builds a Text
376-- from a seed value. The function takes the element and returns
377-- Nothing if it is done producing the Text or returns Just
378-- (a,b), in which case, a is the next Char in the string, and b is
379-- the seed value for further production.
380unfoldr :: (a -> Maybe (Char,a)) -> a -> Text
381unfoldr f s = unstream (S.unfoldr f s)
382{-# INLINE unfoldr #-}
384-- O(n) Like unfoldr, unfoldrN builds a Text from a seed
385-- value. However, the length of the result should be limited by the
386-- first argument to unfoldrN. This function is more efficient than
387-- unfoldr when the maximum length of the result and correct,
388-- otherwise its complexity performance is similar to 'unfoldr'
389unfoldrN :: Int -> (a -> Maybe (Char,a)) -> a -> Text
390unfoldrN n f s = unstream (S.unfoldrN n f s)
391{-# INLINE unfoldrN #-}
393-- -----------------------------------------------------------------------------
396-- O(n) 'take' @n, applied to a Text, returns the prefix of the
397-- Text of length n, or the Text itself if n is greater than the
398-- length of the Text.
399take :: Int -> Text -> Text
400take n (Text arr off len) = Text arr off (loop off 0)
404 | i >= end || count >= n = i - off
405 | c < 0xD800 || c > 0xDBFF = loop (i+1) (count+1)
406 | otherwise = loop (i+2) (count+1)
409{-# INLINE [1] take #-}
412"TEXT take -> fused" [~1] forall n t.
413 take n t = unstream (S.take n (stream t))
414"TEXT take -> unfused" [1] forall n t.
415 unstream (S.take n (stream t)) = take n t
418-- /O(n)/ 'drop' @n, applied to a Text, returns the suffix of the
419-- Text of length @n, or the empty Text if @n is greater than the
420-- length of the Text.
421drop :: Int -> Text -> Text
422drop n (Text arr off len) = (Text arr newOff newLen)
424 (newOff, newLen) = loop off 0 len
427 | i >= end || count >= n = (i,l)
428 | c < 0xD800 || c > 0xDBFF = loop (i+1) (count+1) (l-1)
429 | otherwise = loop (i+2) (count+1) (l-2)
432{-# INLINE [1] drop #-}
435"TEXT drop -> fused" [~1] forall n t.
436 drop n t = unstream (S.drop n (stream t))
437"TEXT drop -> unfused" [1] forall n t.
438 unstream (S.drop n (stream t)) = drop n t
441-- | 'takeWhile', applied to a predicate @p@ and a stream, returns the
442-- longest prefix (possibly empty) of elements that satisfy p.
443takeWhile :: (Char -> Bool) -> Text -> Text
444takeWhile p t = unstream (S.takeWhile p (stream t))
446-- | 'dropWhile' @p @xs returns the suffix remaining after 'takeWhile' @p @xs.
447dropWhile :: (Char -> Bool) -> Text -> Text
448dropWhile p t = unstream (S.dropWhile p (stream t))
450-- ----------------------------------------------------------------------------
453-------------------------------------------------------------------------------
454-- ** Searching by equality
456-- | /O(n)/ 'elem' is the 'Text' membership predicate.
457elem :: Char -> Text -> Bool
458elem c t = S.elem c (stream t)
461-------------------------------------------------------------------------------
462-- ** Searching with a predicate
464-- | /O(n)/ The 'find' function takes a predicate and a 'Text',
465-- and returns the first element in matching the predicate, or 'Nothing'
466-- if there is no such element.
467find :: (Char -> Bool) -> Text -> Maybe Char
468find p t = S.find p (stream t)
471-- | /O(n)/ 'filter', applied to a predicate and a 'Text',
472-- returns a 'Text' containing those characters that satisfy the
474filter :: (Char -> Bool) -> Text -> Text
475filter p t = unstream (S.filter p (stream t))
479-------------------------------------------------------------------------------
480-- ** Indexing 'Text's
482-- | /O(1)/ 'Text' index (subscript) operator, starting from 0.
483index :: Text -> Int -> Char
484index t n = S.index (stream t) n
487-- | The 'findIndex' function takes a predicate and a 'Text' and
488-- returns the index of the first element in the 'Text'
489-- satisfying the predicate.
490findIndex :: (Char -> Bool) -> Text -> Maybe Int
491findIndex p t = S.findIndex p (stream t)
492{-# INLINE findIndex #-}
494-- | /O(n)/ The 'elemIndex' function returns the index of the first
495-- element in the given 'Text' which is equal to the query element, or
496-- 'Nothing' if there is no such element.
497elemIndex :: Char -> Text -> Maybe Int
498elemIndex c t = S.elemIndex c (stream t)
500-------------------------------------------------------------------------------
503-- | /O(n)/ 'zipWith' generalises 'zip' by zipping with the function
504-- given as the first argument, instead of a tupling function.
505zipWith :: (Char -> Char -> Char) -> Text -> Text -> Text
506zipWith f t1 t2 = unstream (S.zipWith f (stream t1) (stream t2))
510readFile :: Encoding -> FilePath -> IO Text
511readFile enc f = B.readFile f >>= return . unstream . stream_bs enc
512{-# INLINE [1] readFile #-}
514words :: Text -> [Text]
515words (Text arr off len) = loop0 off off
518 | isSpace (unsafeChr c) = if start == n
519 then loop0 (start+1) (start+1)
520 else (Text arr start (n-start)):loop0 (n+1) (n+1)
521 | n < (off+len) = loop0 start (n+1)
522 | otherwise = if start == n
524 else [(Text arr start (n-start))]
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