@@ -6,7 +6,9 @@
66#if __GLASGOW_HASKELL__ >= 708
77{-# LANGUAGE TypeFamilies #-}
88#endif
9−
9+#ifdef __GHCJS__
10+{-# LANGUAGE ForeignFunctionInterface #-}
11+#endif
1012-- |
1113-- Module : Data.Text.Lazy
1214-- Copyright : (c) 2009, 2010, 2012 Bryan O'Sullivan
@@ -244,6 +246,9 @@ import GHC.Prim (Addr#)
244246#if MIN_VERSION_base(4,7,0)
245247import Text.Printf (PrintfArg, formatArg, formatString)
246248#endif
249+#ifdef __GHCJS__
250+import Data.JSString (JSString)
251+#endif
247252
248253-- $fusion
249254--
@@ -301,16 +306,15 @@ equal :: Text -> Text -> Bool
301306equal Empty Empty = True
302307equal Empty _ = False
303308equal _ Empty = False
304−equal _ _ = error "Data.Text.Lazy.equal: not implemented."
305−-- equal (Chunk a as) (Chunk b bs) =
306−-- case compare lenA lenB of
307−-- LT -> a == (T.takeWord16 lenA b) &&
308−-- as `equal` Chunk (T.dropWord16 lenA b) bs
309−-- EQ -> a == b && as `equal` bs
310−-- GT -> T.takeWord16 lenB a == b &&
311−-- Chunk (T.dropWord16 lenB a) as `equal` bs
312−-- where lenA = T.lengthWord16 a
313−-- lenB = T.lengthWord16 b
309+equal (Chunk a as) (Chunk b bs) =
310+ case compare lenA lenB of
311+ LT -> a == (T.takeWord16 lenA b) &&
312+ as `equal` Chunk (T.dropWord16 lenA b) bs
313+ EQ -> a == b && as `equal` bs
314+ GT -> T.takeWord16 lenB a == b &&
315+ Chunk (T.dropWord16 lenB a) as `equal` bs
316+ where lenA = T.lengthWord16 a
317+ lenB = T.lengthWord16 b
314318
315319instance Eq Text where
316320 (==) = equal
@@ -323,19 +327,33 @@ compareText :: Text -> Text -> Ordering
323327compareText Empty Empty = EQ
324328compareText Empty _ = LT
325329compareText _ Empty = GT
326−compareText (Chunk a0 as) (Chunk b0 bs) = error "Data.Text.Lazy.compareText: not implemented."
327−-- compareText (Chunk a0 as) (Chunk b0 bs) = outer a0 b0
328−-- where
329−-- outer ta@(T.Text arrA offA lenA) tb@(T.Text arrB offB lenB) = go 0 0
330−-- where
331−-- go !i !j
332−-- | i >= lenA = compareText as (chunk (T.Text arrB (offB+j) (lenB-j)) bs)
333−-- | j >= lenB = compareText (chunk (T.Text arrA (offA+i) (lenA-i)) as) bs
334−-- | a < b = LT
335−-- | a > b = GT
336−-- | otherwise = go (i+di) (j+dj)
337−-- where T.Iter a di = T.iter ta i
338−-- T.Iter b dj = T.iter tb j
330+compareText (Chunk a0 as) (Chunk b0 bs) = outer a0 b0
331+ where
332+#ifndef __GHCJS__
333+ outer ta@(T.Text arrA offA lenA) tb@(T.Text arrB offB lenB) = go 0 0
334+ where
335+ go !i !j
336+ | i >= lenA = compareText as (chunk (T.Text arrB (offB+j) (lenB-j)) bs)
337+ | j >= lenB = compareText (chunk (T.Text arrA (offA+i) (lenA-i)) as) bs
338+ | a < b = LT
339+ | a > b = GT
340+ | otherwise = go (i+di) (j+dj)
341+ where T.Iter a di = T.iter ta i
342+ T.Iter b dj = T.iter tb j
343+#else
344+ outer ta@(T.Text jsa) tb@(T.Text jsb) = go 0 0
345+ where
346+ go !i !j
347+ | i >= lenA = compareText as (chunk (T.Text (js_substr1 j jsb)) bs)
348+ | j >= lenB = compareText (chunk (T.Text (js_substr1 i jsa)) as) bs
349+ | a < b = LT
350+ | a > b = GT
351+ | otherwise = go (i+di) (j+dj)
352+ where T.Iter a di = T.iter ta i
353+ T.Iter b dj = T.iter tb j
354+ lenA = T.length ta
355+ lenB = T.length tb
356+#endif
339357
340358instance Show Text where
341359 showsPrec p ps r = showsPrec p (unpack ps) r
@@ -547,7 +565,7 @@ tail Empty = emptyError "tail"
547565 unstream (S.tail (stream t)) = tail t
548566 #-}
549567
550−-- | /O(1)/ Returns all but the last character of a 'Text', which must
568+-- | /O(n\/c)/ Returns all but the last character of a 'Text', which must
551569-- be non-empty. Subject to fusion.
552570init :: Text -> Text
553571init (Chunk t0 ts0) = go t0 ts0
@@ -583,7 +601,7 @@ isSingleton :: Text -> Bool
583601isSingleton = S.isSingleton . stream
584602{-# INLINE isSingleton #-}
585603
586−-- | /O(1)/ Returns the last character of a 'Text', which must be
604+-- | /O(n\/c)/ Returns the last character of a 'Text', which must be
587605-- non-empty. Subject to fusion.
588606last :: Text -> Char
589607last Empty = emptyError "last"
@@ -1116,17 +1134,25 @@ dropEnd n t0
11161134-- values dropped, or the empty 'Text' if @n@ is greater than the
11171135-- number of 'Word16' values present.
11181136dropWords :: Int64 -> Text -> Text
1119−dropWords = P.undefined
1120−-- dropWords i t0
1121−-- | i <= 0 = t0
1122−-- | otherwise = drop' i t0
1123−-- where drop' 0 ts = ts
1124−-- drop' _ Empty = Empty
1125−-- drop' n (Chunk (T.Text arr off len) ts)
1126−-- | n < len' = chunk (text arr (off+n') (len-n')) ts
1127−-- | otherwise = drop' (n - len') ts
1128−-- where len' = fromIntegral len
1129−-- n' = fromIntegral n
1137+dropWords i t0
1138+ | i <= 0 = t0
1139+ | otherwise = drop' i t0
1140+ where drop' 0 ts = ts
1141+ drop' _ Empty = Empty
1142+#ifndef __GHCJS__
1143+ drop' n (Chunk (T.Text arr off len) ts)
1144+ | n < len' = chunk (text arr (off+n') (len-n')) ts
1145+ | otherwise = drop' (n - len') ts
1146+ where len' = fromIntegral len
1147+ n' = fromIntegral n
1148+#else
1149+ drop' n (Chunk t@(T.Text jst) ts)
1150+ | n < len' = chunk (T.Text $ js_substr1 n' jst) ts
1151+ | otherwise = drop' (n - len') ts
1152+ where len' = fromIntegral len
1153+ len = T.length t
1154+ n' = fromIntegral n
1155+#endif
11301156
11311157-- | /O(n)/ 'takeWhile', applied to a predicate @p@ and a 'Text',
11321158-- returns the longest prefix (possibly empty) of elements that
@@ -1247,13 +1273,22 @@ splitAt = loop
12471273-- values, and whose second is the remainder of the string.
12481274splitAtWord :: Int64 -> Text -> PairS Text Text
12491275splitAtWord _ Empty = empty :*: empty
1250−splitAtWord _ _ = P.undefined
1251−-- splitAtWord x (Chunk c@(T.Text arr off len) cs)
1252−-- | y >= len = let h :*: t = splitAtWord (x-fromIntegral len) cs
1253−-- in Chunk c h :*: t
1254−-- | otherwise = chunk (text arr off y) empty :*:
1255−-- chunk (text arr (off+y) (len-y)) cs
1256−-- where y = fromIntegral x
1276+#ifndef __GHCJS__
1277+splitAtWord x (Chunk c@(T.Text arr off len) cs)
1278+ | y >= len = let h :*: t = splitAtWord (x-fromIntegral len) cs
1279+ in Chunk c h :*: t
1280+ | otherwise = chunk (text arr off y) empty :*:
1281+ chunk (text arr (off+y) (len-y)) cs
1282+ where y = fromIntegral x
1283+#else
1284+splitAtWord x (Chunk c@(T.Text jst) cs)
1285+ | y >= len = let h :*: t = splitAtWord (x-fromIntegral len) cs
1286+ in Chunk c h :*: t
1287+ | otherwise = chunk (T.Text (js_substr 0 (y-1) jst)) empty :*:
1288+ chunk (T.Text (js_substr1 y jst)) cs
1289+ where y = fromIntegral x
1290+ len = T.length c
1291+#endif
12571292
12581293-- | /O(n+m)/ Find the first instance of @needle@ (which must be
12591294-- non-'null') in @haystack@. The first element of the returned tuple
@@ -1425,16 +1460,19 @@ splitOn :: Text
14251460 -> Text
14261461 -- ^ Input text.
14271462 -> [Text]
1428−splitOn = P.undefined
1429−-- splitOn pat src
1430−-- | null pat = emptyError "splitOn"
1431−-- | isSingleton pat = split (== head pat) src
1432−-- | otherwise = go 0 (indices pat src) src
1433−-- where
1434−-- go _ [] cs = [cs]
1435−-- go !i (x:xs) cs = let h :*: t = splitAtWord (x-i) cs
1436−-- in h : go (x+l) xs (dropWords l t)
1437−-- l = foldlChunks (\a (T.Text _ _ b) -> a + fromIntegral b) 0 pat
1463+splitOn pat src
1464+ | null pat = emptyError "splitOn"
1465+ | isSingleton pat = split (== head pat) src
1466+ | otherwise = go 0 (indices pat src) src
1467+ where
1468+ go _ [] cs = [cs]
1469+ go !i (x:xs) cs = let h :*: t = splitAtWord (x-i) cs
1470+ in h : go (x+l) xs (dropWords l t)
1471+#ifndef __GHCJS__
1472+ l = foldlChunks (\a (T.Text _ _ b) -> a + fromIntegral b) 0 pat
1473+#else
1474+ l = foldlChunks (\a t -> a + fromIntegral (T.length t)) 0 pat
1475+#endif
14381476{-# INLINE [1] splitOn #-}
14391477
14401478{-# RULES
@@ -1699,3 +1737,8 @@ emptyError fun = P.error ("Data.Text.Lazy." ++ fun ++ ": empty input")
16991737
17001738impossibleError :: String -> a
17011739impossibleError fun = P.error ("Data.Text.Lazy." ++ fun ++ ": impossible case")
1740+
1741+#ifdef __GHCJS__
1742+foreign import javascript unsafe "$2.substr($1)" js_substr1 :: Exts.Int -> JSString -> JSString
1743+foreign import javascript unsafe "$3.substr($1,$2)" js_substr :: Exts.Int -> Exts.Int -> JSString -> JSString
1744+#endif