module Data.Text.Fusion
(
Stream(..)
, Step(..)
, stream
, unstream
, reverseStream
, length
, reverse
, reverseScanr
, unfoldrN
, index
, findIndex
, findIndices
, findIndexOrEnd
, elemIndex
, elemIndices
, count
) where
import Prelude (Bool(..), Char, Eq(..), Maybe(..), Monad(..), Int,
Num(..), Ord(..), ($), (&&),
fromIntegral, otherwise)
import Data.Bits ((.&.), shiftR)
import Data.Char (ord)
import Data.Text.Internal (Text(..))
import Data.Text.UnsafeChar (unsafeChr, unsafeWrite)
import qualified Data.Text.Array as A
import qualified Data.Text.Fusion.Common as S
import Data.Text.Fusion.Internal
import qualified Data.Text.Internal as I
import qualified Data.Text.Encoding.Utf16 as U16
import qualified Prelude as P
default(Int)
stream :: Text -> Stream Char
stream (Text arr off len) = Stream next off len
where
end = off+len
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)
reverseStream :: Text -> Stream Char
reverseStream (Text arr off len) = Stream next (off+len1) len
where
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)
unstream :: Stream Char -> Text
unstream (Stream next0 s0 len)
| len == 0 = I.empty
| otherwise = I.textP (P.fst a) 0 (P.snd a)
where
a = A.run2 (A.unsafeNew len >>= (\arr -> loop arr len s0 0))
loop arr !top !s !i
| i + 1 >= top = case next0 s of
Done -> return (arr, i)
_ -> do
arr' <- A.unsafeNew (top*2)
A.copy arr arr' >> loop arr' (top*2) s i
| otherwise = case next0 s of
Done -> return (arr, i)
Skip s' -> loop arr top s' i
Yield x s' -> unsafeWrite arr i x >>= loop arr top s'
length :: Stream Char -> Int
length = S.lengthI
reverse :: Stream Char -> Text
reverse (Stream next s len0)
| len0 == 0 = I.empty
| otherwise = I.textP 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, lenj))
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' (newLenlen) 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 t j l mar
| n < 0x10000 = do
A.unsafeWrite mar j (fromIntegral n)
loop t (j1) l mar
| otherwise = do
A.unsafeWrite mar (j1) lo
A.unsafeWrite mar j hi
loop t (j2) l mar
reverseScanr :: (Char -> Char -> Char) -> Char -> Stream Char -> Stream Char
reverseScanr f z0 (Stream next0 s0 len) = Stream next (S1 :!: z0 :!: s0) (len+1)
where
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
unfoldrN :: Int -> (a -> Maybe (Char,a)) -> a -> Stream Char
unfoldrN n = S.unfoldrNI n
index :: Stream Char -> Int -> Char
index = S.indexI
findIndex :: (Char -> Bool) -> Stream Char -> Maybe Int
findIndex = S.findIndexI
findIndices :: (Char -> Bool) -> Stream Char -> [Int]
findIndices = S.findIndicesI
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'
Yield x s' | p x -> i
| otherwise -> loop_findIndex (i+1) s'
elemIndex :: Char -> Stream Char -> Maybe Int
elemIndex = S.elemIndexI
elemIndices :: Char -> Stream Char -> [Int]
elemIndices = S.elemIndicesI
count :: Char -> Stream Char -> Int
count = S.countI