Skip to content
This repository
Browse code

A giant orgy of hacking that's impossible to split apart

* Implemented group and groupBy
* Added Data.Text.Unsafe module
* Refactored code to be safer and less redundant
* Fixed numerous fencepost errors
* Improved test coverage
* Added lots of assertions to document/enforce basic invariants
* A pwnie for everyone

--HG--
extra : convert_revision : 39a67f0
  • Loading branch information...
commit 4a94bd462a5bf13d73c9278bbcede86217dd8ffc 1 parent b10927c
Bryan O'Sullivan authored February 07, 2009
178  Data/Text.hs
@@ -98,8 +98,8 @@ module Data.Text
98 98
     , splitAt
99 99
     , span
100 100
     , break
101  
-    -- , group
102  
-    -- , groupBy
  101
+    , group
  102
+    , groupBy
103 103
     , inits
104 104
     , tails
105 105
 
@@ -145,10 +145,10 @@ module Data.Text
145 145
 
146 146
 import Prelude (Char, Bool, Functor(..), Int, Maybe(..), String,
147 147
                 Eq, (==), (++), error,
148  
-                Show, showsPrec,
149  
-                Read, readsPrec,
150  
-                (&&), (||), (+), (-), (<), (>), (<=), (>=), (.),
  148
+                Read(..), Show(..),
  149
+                (&&), (||), (+), (-), (<), (>), (<=), (>=), (.), ($),
151 150
                 not, return, otherwise)
  151
+import Control.Exception (assert)
152 152
 import Data.Char (isSpace)
153 153
 import Control.Monad.ST (ST)
154 154
 import qualified Data.Text.Array as A
@@ -159,8 +159,9 @@ import Data.String (IsString(..))
159 159
 
160 160
 import qualified Data.Text.Fusion as S
161 161
 import Data.Text.Fusion (Stream(..), Step(..), stream, unstream)
162  
-import Data.Text.Internal (Text(..), empty)
  162
+import Data.Text.Internal (Text(..), empty, text)
163 163
 import qualified Prelude as P
  164
+import Data.Text.Unsafe (iter, iter_)
164 165
 import Data.Text.UnsafeChar (unsafeChr)
165 166
 import qualified Data.Text.Utf16 as U16
166 167
 
@@ -273,32 +274,13 @@ head :: Text -> Char
273 274
 head t = S.head (stream t)
274 275
 {-# INLINE head #-}
275 276
 
276  
--- | Iterate one step through a UTF-16 array, returning the current
277  
--- character and the step to add to give the next offset to iterate
278  
--- at.
279  
-iter :: A.Array Word16 -> Int -> (Char,Int)
280  
-iter arr i | m < 0xD800 || m > 0xDBFF = (unsafeChr m,  1)
281  
-           | otherwise                = (U16.chr2 m n, 2)
282  
-  where m = A.unsafeIndex arr i
283  
-        n = A.unsafeIndex arr j
284  
-        j = i + 1
285  
-{-# INLINE iter #-}
286  
-
287  
--- | Iterate one step through a UTF-16 array, returning the next
288  
--- offset to iterate at.
289  
-iter_ :: A.Array Word16 -> Int -> Int
290  
-iter_ arr i | m < 0xD800 || m > 0xDBFF = 1
291  
-            | otherwise                = 2
292  
-  where m = A.unsafeIndex arr i
293  
-{-# INLINE iter_ #-}
294  
-
295 277
 -- | /O(1)/ Returns the first character and rest of a 'Text', or
296 278
 -- 'Nothing' if empty. Subject to array fusion.
297 279
 uncons :: Text -> Maybe (Char, Text)
298  
-uncons (Text arr off len)
  280
+uncons t@(Text arr off len)
299 281
     | len <= 0  = Nothing
300 282
     | otherwise = Just (c, Text arr (off+d) (len-d))
301  
-    where (c,d) = iter arr off
  283
+    where (c,d) = iter t 0
302 284
 {-# INLINE uncons #-}
303 285
 
304 286
 second :: (b -> c) -> (a,b) -> (a,c)
@@ -329,24 +311,35 @@ last (Text arr off len)
329 311
     S.last (stream t) = last t
330 312
   #-}
331 313
 
  314
+-- | Construct a 'Text' without invisibly pinning its byte array in
  315
+-- memory if its length has dwindled to zero.
  316
+textP :: A.Array Word16 -> Int -> Int -> Text
  317
+textP arr off len | len == 0  = empty
  318
+                  | otherwise = text arr off len
  319
+{-# INLINE textP #-}
332 320
 
333 321
 -- | /O(1)/ Returns all characters after the head of a 'Text', which
334 322
 -- must be non-empty.  Subject to array fusion.
335 323
 tail :: Text -> Text
336  
-tail (Text arr off len)
  324
+tail t@(Text arr off len)
337 325
     | len <= 0  = errorEmptyList "tail"
338  
-    | otherwise = Text arr (off+d) (len-d)
339  
-    where d = iter_ arr off
  326
+    | otherwise = textP arr (off+d) (len-d)
  327
+    where d = iter_ t 0
340 328
 {-# INLINE [1] tail #-}
341 329
 
342  
-
  330
+{-# RULES
  331
+"TEXT tail -> fused" [~1] forall t.
  332
+    tail t = unstream (S.tail (stream t))
  333
+"TEXT tail -> unfused" [1] forall t.
  334
+    unstream (S.tail (stream t)) = tail t
  335
+ #-}
343 336
 
344 337
 -- | /O(1)/ Returns all but the last character of a 'Text', which must
345 338
 -- be non-empty.  Subject to array fusion.
346 339
 init :: Text -> Text
347 340
 init (Text arr off len) | len <= 0                   = errorEmptyList "init"
348  
-                        | n >= 0xDC00 && n <= 0xDFFF = Text arr off (len-2)
349  
-                        | otherwise                  = Text arr off (len-1)
  341
+                        | n >= 0xDC00 && n <= 0xDFFF = textP arr off (len-2)
  342
+                        | otherwise                  = textP arr off (len-1)
350 343
     where
351 344
       n = A.unsafeIndex arr (off+len-1)
352 345
 {-# INLINE [1] init #-}
@@ -361,8 +354,15 @@ init (Text arr off len) | len <= 0                   = errorEmptyList "init"
361 354
 -- | /O(1)/ Tests whether a 'Text' is empty or not.  Subject to array
362 355
 -- fusion.
363 356
 null :: Text -> Bool
364  
-null t = S.null (stream t)
365  
-{-# INLINE null #-}
  357
+null (Text _arr _off len) = assert (len >= 0) $ len <= 0
  358
+{-# INLINE [1] null #-}
  359
+
  360
+{-# RULES
  361
+"TEXT null -> fused" [~1] forall t.
  362
+    null t = S.null (stream t)
  363
+"TEXT null -> unfused" [1] forall t.
  364
+    S.null (stream t) = null t
  365
+ #-}
366 366
 
367 367
 -- | /O(n)/ Returns the number of characters in a 'Text'.
368 368
 -- Subject to array fusion.
@@ -560,13 +560,12 @@ take :: Int -> Text -> Text
560 560
 take n t@(Text arr off len)
561 561
     | n <= 0    = empty
562 562
     | n >= len  = t
563  
-    | otherwise = Text arr off (loop off 0)
  563
+    | otherwise = Text arr off (loop 0 0)
564 564
   where
565  
-      end = off + len
566 565
       loop !i !count
567  
-           | i >= end || count >= n   = i - off
568  
-           | otherwise                = loop (i+d) (count+1)
569  
-           where d = iter_ arr i
  566
+           | i >= len || count >= n = i
  567
+           | otherwise              = loop (i+d) (count+1)
  568
+           where d = iter_ t i
570 569
 {-# INLINE [1] take #-}
571 570
 
572 571
 {-# RULES
@@ -583,12 +582,12 @@ drop :: Int -> Text -> Text
583 582
 drop n t@(Text arr off len)
584 583
     | n <= 0    = t
585 584
     | n >= len  = empty
586  
-    | otherwise = loop off 0 len
  585
+    | otherwise = loop 0 0
587 586
   where end = off + len
588  
-        loop !i !count !l
589  
-            | i >= end || count >= n   = Text arr i l
590  
-            | otherwise                = loop (i+d) (count+1) (l-d)
591  
-            where d = iter_ arr i
  587
+        loop !i !count
  588
+            | i >= end || count >= n   = Text arr (off+i) (len-i)
  589
+            | otherwise                = loop (i+d) (count+1)
  590
+            where d = iter_ t i
592 591
 {-# INLINE [1] drop #-}
593 592
 
594 593
 {-# RULES
@@ -602,11 +601,11 @@ drop n t@(Text arr off len)
602 601
 -- the longest prefix (possibly empty) of elements that satisfy @p@.
603 602
 -- This function is subject to array fusion.
604 603
 takeWhile :: (Char -> Bool) -> Text -> Text
605  
-takeWhile p t@(Text arr off len) = loop off 0
606  
-  where loop !i !l | l >= len    = t
607  
-                   | p c         = loop (i+d) (l+d)
608  
-                   | otherwise   = Text arr off l
609  
-            where (c,d)          = iter arr i
  604
+takeWhile p t@(Text arr off len) = loop 0
  605
+  where loop !i | i >= len    = t
  606
+                | p c         = loop (i+d)
  607
+                | otherwise   = textP arr off i
  608
+            where (c,d)       = iter t i
610 609
 {-# INLINE [1] takeWhile #-}
611 610
 
612 611
 {-# RULES
@@ -619,11 +618,11 @@ takeWhile p t@(Text arr off len) = loop off 0
619 618
 -- | /O(n)/ 'dropWhile' @p@ @xs@ returns the suffix remaining after
620 619
 -- 'takeWhile' @p@ @xs@. This function is subject to array fusion.
621 620
 dropWhile :: (Char -> Bool) -> Text -> Text
622  
-dropWhile p (Text arr off len) = loop off 0
  621
+dropWhile p t@(Text arr off len) = loop 0 0
623 622
   where loop !i !l | l >= len  = empty
624 623
                    | p c       = loop (i+d) (l+d)
625  
-                   | otherwise = Text arr i (len-l)
626  
-            where (c,d)        = iter arr i
  624
+                   | otherwise = Text arr (off+i) (len-l)
  625
+            where (c,d)        = iter t i
627 626
 {-# INLINE [1] dropWhile #-}
628 627
 
629 628
 {-# RULES
@@ -641,12 +640,11 @@ splitAt n t@(Text arr off len)
641 640
     | n <= 0    = (empty, t)
642 641
     | n >= len  = (t, empty)
643 642
     | otherwise = (Text arr off k, Text arr (off+k) (len-k))
644  
-  where k = loop off 0
645  
-        end = off + len
  643
+  where k = loop 0 0
646 644
         loop !i !count
647  
-            | i >= end || count >= n = i - off
  645
+            | i >= len || count >= n = i
648 646
             | otherwise              = loop (i+d) (count+1)
649  
-            where d                  = iter_ arr i
  647
+            where d                  = iter_ t i
650 648
 {-# INLINE splitAt #-}
651 649
 
652 650
 -- | /O(n)/ 'span', applied to a predicate @p@ and text @t@, returns a
@@ -654,14 +652,11 @@ splitAt n t@(Text arr off len)
654 652
 -- @t@ of elements that satisfy @p@, and whose second is the remainder
655 653
 -- of the list.
656 654
 span :: (Char -> Bool) -> Text -> (Text, Text)
657  
-span p t@(Text arr off len)
658  
-    | k == 0    = (empty, t)
659  
-    | k == len  = (t, empty)
660  
-    | otherwise = (Text arr off k, Text arr (off+k) (len-k))
661  
-  where k = loop off 0
662  
-        loop !i !l | l >= len || not (p c) = l
663  
-                   | otherwise             = loop (i+d) (l+d)
664  
-            where (c,d)                    = iter arr i
  655
+span p t@(Text arr off len) = (textP arr off k, textP arr (off+k) (len-k))
  656
+  where k = loop 0
  657
+        loop !i | i >= len || not (p c) = i
  658
+                | otherwise             = loop (i+d)
  659
+            where (c,d)                 = iter t i
665 660
 {-# INLINE span #-}
666 661
 
667 662
 -- | /O(n)/ 'break' is like 'span', but the prefix returned is over
@@ -670,12 +665,35 @@ break :: (Char -> Bool) -> Text -> (Text, Text)
670 665
 break p = span (not . p)
671 666
 {-# INLINE break #-}
672 667
 
  668
+-- | /O(n)/ Group characters in a string according to a predicate.
  669
+groupBy :: (Char -> Char -> Bool) -> Text -> [Text]
  670
+groupBy p = loop
  671
+  where
  672
+    loop t@(Text arr off len)
  673
+        | null t    = []
  674
+        | otherwise = text arr off n : loop (text arr (off+n) (len-n))
  675
+        where (c,d) = iter t 0
  676
+              n     = d + findAIndexOrEnd (not . p c) (Text arr (off+d) (len-d))
  677
+
  678
+-- | Returns the /array/ index (in units of 'Word16') at which a
  679
+-- character may be found.  This is /not/ the same as the logical
  680
+-- index returned by e.g. 'findIndex'.
  681
+findAIndexOrEnd :: (Char -> Bool) -> Text -> Int
  682
+findAIndexOrEnd q t@(Text _arr _off len) = go 0
  683
+    where go !i | i >= len || q c       = i
  684
+                | otherwise             = go (i+d)
  685
+                where (c,d)             = iter t i
  686
+    
  687
+-- | /O(n)/ Group characters in a string by equality.
  688
+group :: Text -> [Text]
  689
+group = groupBy (==)
  690
+
673 691
 -- | /O(n)/ Return all initial segments of the given 'Text', shortest
674 692
 -- first.
675 693
 inits :: Text -> [Text]
676  
-inits t@(Text arr off len) = loop off
  694
+inits t@(Text arr off len) = loop 0
677 695
     where loop i | i >= len = [t]
678  
-                 | otherwise = Text arr off i : loop (i + iter_ arr i)
  696
+                 | otherwise = Text arr off i : loop (i + iter_ t i)
679 697
 
680 698
 -- | /O(n)/ Return all final segments of the given 'Text', longest
681 699
 -- first.
@@ -744,20 +762,18 @@ zipWith f t1 t2 = unstream (S.zipWith f (stream t1) (stream t2))
744 762
 -- | /O(n)/ Breaks a 'Text' up into a list of words, delimited by 'Char's
745 763
 -- representing white space.
746 764
 words :: Text -> [Text]
747  
-words (Text arr off len) = loop0 off off
748  
-    where
749  
-      loop0 start n
750  
-          | n >= len = if start == n
751  
-                       then []
752  
-                       else [Text arr (start+off) (n-start)]
753  
-          | isSpace (unsafeChr c) =
754  
-              if start == n
755  
-              then loop0 (start+1) (start+1)
756  
-              else Text arr (start+off) (n-start) : loop0 (n+1) (n+1)
757  
-          | otherwise = if c < 0xD800 || c > 0xDBFF
758  
-                        then loop0 start (n+1)
759  
-                        else loop0 start (n+2)
760  
-          where c = arr `A.unsafeIndex` n
  765
+words t@(Text arr off len) = loop 0 0
  766
+  where
  767
+    loop !start !n
  768
+        | n >= len = if start == n
  769
+                     then []
  770
+                     else [Text arr (start+off) (n-start)]
  771
+        | isSpace c =
  772
+            if start == n
  773
+            then loop (start+1) (start+1)
  774
+            else Text arr (start+off) (n-start) : loop (n+d) (n+d)
  775
+        | otherwise = loop start (n+d)
  776
+        where (c,d) = iter t n
761 777
 {-# INLINE words #-}
762 778
 
763 779
 -- | /O(n)/ Breaks a 'Text' up into a list of 'Text's at
11  Data/Text/Array.hs
@@ -35,6 +35,7 @@ module Data.Text.Array
35 35
     , unsafeNew
36 36
     , unsafeFreeze
37 37
     , run
  38
+    , toList
38 39
     ) where
39 40
 
40 41
 #if 0
@@ -107,6 +108,9 @@ instance IArray (Array e) where
107 108
     length (Array len _ba) = len
108 109
     {-# INLINE length #-}
109 110
 
  111
+instance (Elt e, Show e) => Show (Array e) where
  112
+    show = show . toList
  113
+
110 114
 instance IArray (MArray s e) where
111 115
     length (MArray len _ba) = len
112 116
     {-# INLINE length #-}
@@ -247,6 +251,13 @@ instance Elt Word16 where
247 251
 
248 252
 #endif
249 253
 
  254
+-- | Convert an immutable array to a list.
  255
+toList :: Elt e => Array e -> [e]
  256
+toList a = loop 0
  257
+    where loop i | i < len   = unsafeIndex a i : loop (i+1)
  258
+                 | otherwise = []
  259
+          len = length a
  260
+
250 261
 -- | An empty immutable array.
251 262
 empty :: Elt e => Array e
252 263
 empty = runST (unsafeNew 0 >>= unsafeFreeze)
14  Data/Text/Fusion.hs
@@ -87,6 +87,7 @@ module Data.Text.Fusion
87 87
     , find
88 88
     , index
89 89
     , findIndex
  90
+    , findIndexOrEnd
90 91
     , elemIndex
91 92
 
92 93
     -- * Zipping and unzipping
@@ -764,6 +765,19 @@ findIndex p (Stream next s0 _len) = loop_findIndex 0 s0
764 765
                  | otherwise -> loop_findIndex (i+1) s'
765 766
 {-# INLINE [0] findIndex #-}
766 767
 
  768
+-- | The 'findIndexOrEnd' function takes a predicate and a stream and
  769
+-- returns the index of the first element in the stream
  770
+-- satisfying the predicate.
  771
+findIndexOrEnd :: (Char -> Bool) -> Stream Char -> Int
  772
+findIndexOrEnd p (Stream next s0 _len) = loop_findIndex 0 s0
  773
+  where
  774
+    loop_findIndex !i !s = case next s of
  775
+      Done                   -> i
  776
+      Skip    s'             -> loop_findIndex i     s' -- hmm. not caught by QC
  777
+      Yield x s' | p x       -> i
  778
+                 | otherwise -> loop_findIndex (i+1) s'
  779
+{-# INLINE [0] findIndexOrEnd #-}
  780
+
767 781
 -- | /O(n)/ The 'elemIndex' function returns the index of the first
768 782
 -- element in the given stream which is equal to the query
769 783
 -- element, or 'Nothing' if there is no such element.
30  Data/Text/Internal.hs
@@ -19,21 +19,43 @@ module Data.Text.Internal
19 19
     (
20 20
     -- * Types
21 21
       Text(..)
  22
+    -- * Construction
  23
+    , text
22 24
     -- * Code that must be here for accessibility
23 25
     , empty
  26
+    -- * Debugging
  27
+    , showText
24 28
     ) where
25 29
 
  30
+import Control.Exception (assert)
26 31
 import qualified Data.Text.Array as A
27 32
 import Data.Typeable (Typeable)
28 33
 import Data.Word (Word16)
29 34
 
30 35
 -- | A space efficient, packed, unboxed Unicode text type.
31  
-data Text = Text {-# UNPACK #-} !(A.Array Word16) -- payload
32  
-                 {-# UNPACK #-} !Int              -- offset
33  
-                 {-# UNPACK #-} !Int              -- length
34  
-            deriving (Typeable)
  36
+data Text = Text {
  37
+      textArray :: {-# UNPACK #-} !(A.Array Word16) -- payload
  38
+    , textOffset :: {-# UNPACK #-} !Int              -- offset
  39
+    , textLength :: {-# UNPACK #-} !Int              -- length
  40
+    } deriving (Typeable)
  41
+
  42
+text :: A.Array Word16 -> Int -> Int -> Text
  43
+text arr off len =
  44
+    assert (len >= 0) .
  45
+    assert (off >= 0) .
  46
+    assert (alen == 0 || off < alen) .
  47
+    assert (len == 0 || c < 0xDC00 || c > 0xDFFF) $
  48
+    Text arr off len
  49
+  where c    = A.unsafeIndex arr off
  50
+        alen = A.length arr
  51
+{-# INLINE text #-}
35 52
 
36 53
 -- | /O(1)/ The empty 'Text'.
37 54
 empty :: Text
38 55
 empty = Text A.empty 0 0
39 56
 {-# INLINE [1] empty #-}
  57
+
  58
+showText :: Text -> String
  59
+showText (Text arr off len) =
  60
+    "Text " ++ (show . take (off+len) . A.toList) arr ++ ' ' :
  61
+            show off ++ ' ' : show len
64  Data/Text/Unsafe.hs
... ...
@@ -0,0 +1,64 @@
  1
+-- |
  2
+-- Module      : Data.Text.Unsafe
  3
+-- License     : BSD-style
  4
+-- Copyright   : (c) Bryan O'Sullivan 2009
  5
+-- Maintainer  : bos@serpentine.com
  6
+-- Stability   : experimental
  7
+-- Portability : portable
  8
+-- 
  9
+-- A module containing unsafe 'Text' operations, for very very careful
  10
+-- use in heavily tested code.
  11
+module Data.Text.Unsafe
  12
+    (
  13
+      iter
  14
+    , iter_
  15
+    , unsafeHead
  16
+    , unsafeTail
  17
+    ) where
  18
+     
  19
+import Control.Exception (assert)
  20
+import Data.Text.Internal (Text(..))
  21
+import Data.Text.UnsafeChar (unsafeChr)
  22
+import Data.Text.Utf16 (chr2)
  23
+import qualified Data.Text.Array as A
  24
+
  25
+-- | /O(1)/ A variant of 'head' for non-empty 'Text'. 'unsafeHead'
  26
+-- omits the check for the empty case, so there is an obligation on
  27
+-- the programmer to provide a proof that the 'Text' is non-empty.
  28
+unsafeHead :: Text -> Char
  29
+unsafeHead (Text arr off len)
  30
+    | m < 0xD800 || m > 0xDBFF = unsafeChr m
  31
+    | otherwise                = chr2 m n
  32
+    where m = assert (len > 0) $ A.unsafeIndex arr off
  33
+          n = assert (len > 1) $ A.unsafeIndex arr (off+1)
  34
+{-# INLINE unsafeHead #-}
  35
+
  36
+-- | /O(1)/ A variant of 'tail' for non-empty 'Text'. 'unsafeHead'
  37
+-- omits the check for the empty case, so there is an obligation on
  38
+-- the programmer to provide a proof that the 'Text' is non-empty.
  39
+unsafeTail :: Text -> Text
  40
+unsafeTail t@(Text arr off len) =
  41
+    assert (d <= len) $ Text arr (off+d) (len-d)
  42
+  where d = iter_ t 0
  43
+{-# INLINE unsafeTail #-}
  44
+
  45
+-- | /O(1)/ Iterate one step through a UTF-16 array, returning the
  46
+-- current character and the delta to add to give the next offset to
  47
+-- iterate at.
  48
+iter :: Text -> Int -> (Char,Int)
  49
+iter (Text arr off len) i
  50
+    | m < 0xD800 || m > 0xDBFF = (unsafeChr m, 1)
  51
+    | otherwise                = (chr2 m n,    2)
  52
+  where m = assert (i < len) $ A.unsafeIndex arr j
  53
+        n = assert (j < len) $ A.unsafeIndex arr k
  54
+        j = off + i
  55
+        k = j + 1
  56
+{-# INLINE iter #-}
  57
+
  58
+-- | /O(1)/ Iterate one step through a UTF-16 array, returning the
  59
+-- delta to add to give the next offset to iterate at.
  60
+iter_ :: Text -> Int -> Int
  61
+iter_ (Text arr off len) i | m < 0xD800 || m > 0xDBFF = 1
  62
+                           | otherwise                = 2
  63
+  where m = assert (i >= 0 && i < len) $ A.unsafeIndex arr (off+i)
  64
+{-# INLINE iter_ #-}
33  tests/Properties.hs
@@ -10,6 +10,7 @@ import System.Environment
10 10
 import Control.Applicative
11 11
 import Control.Arrow
12 12
 import Control.Monad
  13
+import Data.Word
13 14
 import qualified Data.Text as T
14 15
 import Data.Text (pack,unpack)
15 16
 import qualified Data.Text.Fusion as S
@@ -24,12 +25,34 @@ prop_stream_unstream t = (unstream . stream) t == t
24 25
 prop_singleton c     = [c] == (unpack . T.singleton) c
25 26
 
26 27
 -- Do two functions give the same answer?
  28
+eq :: (Eq a) => (t -> a) -> (t -> a) -> t -> Bool
27 29
 eq a b s  = a s == b s
28 30
 -- What about with the RHS packed?
29  
-eqP a b s  = a s == b (pack s)
  31
+eqP :: (Eq a) => (String -> a) -> (T.Text -> a) -> String -> Word8 -> Bool
  32
+eqP a b s w  = a s == b t &&
  33
+               a sa == b ta &&
  34
+               a sb == b tb
  35
+    where t             = pack s
  36
+          (sa,sb)       = splitAt m s
  37
+          (ta,tb)       = T.splitAt m t
  38
+          l             = length s
  39
+          m | l == 0    = n
  40
+            | otherwise = n `mod` l
  41
+          n             = fromIntegral w
30 42
 -- Or with the string non-empty, and the RHS packed?
31  
-eqEP a b s = let e = notEmpty s
32  
-             in a e == b (pack e)
  43
+eqEP :: (Eq a) =>
  44
+        (String -> a) -> (T.Text -> a) -> NotEmpty String -> Word8 -> Bool
  45
+eqEP a b e w  = a s == b t &&
  46
+                (null sa || a sa == b ta) &&
  47
+                (null sb || a sb == b tb)
  48
+    where (sa,sb)       = splitAt m s
  49
+          (ta,tb)       = T.splitAt m t
  50
+          t             = pack s
  51
+          l             = length s
  52
+          m | l == 0    = n
  53
+            | otherwise = n `mod` l
  54
+          n             = fromIntegral w
  55
+          s             = notEmpty e
33 56
 
34 57
 prop_cons x          = (x:)     `eqP` (unpack . T.cons x)
35 58
 prop_snoc x          = (++ [x]) `eqP` (unpack . (flip T.snoc) x)
@@ -95,6 +118,8 @@ prop_dropWhileS p    = L.dropWhile p `eqP` (unpack . unstream . S.dropWhile p .
95 118
 prop_splitAt n       = L.splitAt n   `eqP` ((unpack *** unpack) . T.splitAt n)
96 119
 prop_span p          = L.span p      `eqP` ((unpack *** unpack) . T.span p)
97 120
 prop_break p         = L.break p     `eqP` ((unpack *** unpack) . T.break p)
  121
+prop_group           = L.group       `eqP` (map unpack . T.group)
  122
+prop_groupBy p       = L.groupBy p   `eqP` (map unpack . T.groupBy p)
98 123
 prop_inits           = L.inits       `eqP` (map unpack . T.inits)
99 124
 prop_tails           = L.tails       `eqP` (map unpack . T.tails)
100 125
 
@@ -185,6 +210,8 @@ tests = [
185 210
   ("prop_splitAt", mytest prop_splitAt),
186 211
   ("prop_span", mytest prop_span),
187 212
   ("prop_break", mytest prop_break),
  213
+  ("prop_group", mytest prop_group),
  214
+  ("prop_groupBy", mytest prop_groupBy),
188 215
   ("prop_inits", mytest prop_inits),
189 216
   ("prop_tails", mytest prop_tails),
190 217
 
8  tests/QuickCheckUtils.hs
@@ -14,6 +14,14 @@ integralRandomR  (a,b) g = case randomR (fromIntegral a :: Integer,
14 14
                                          fromIntegral b :: Integer) g of
15 15
                             (x,g) -> (fromIntegral x, g)
16 16
 
  17
+instance Random Word8 where
  18
+  randomR = integralRandomR
  19
+  random  = randomR (minBound,maxBound)
  20
+
  21
+instance Arbitrary Word8 where
  22
+    arbitrary     = choose (minBound,maxBound)
  23
+    coarbitrary c = variant (fromEnum c `rem` 4)
  24
+
17 25
 instance Random Word16 where
18 26
   randomR = integralRandomR
19 27
   random  = randomR (minBound,maxBound)
1  text.cabal
@@ -20,6 +20,7 @@ library
20 20
     Data.Text.Array
21 21
     Data.Text.Encoding
22 22
     Data.Text.Encoding.Fusion
  23
+    Data.Text.Unsafe
23 24
     Data.Text.UnsafeChar
24 25
     Data.Text.Internal
25 26
     Data.Text.Fusion

0 notes on commit 4a94bd4

Please sign in to comment.
Something went wrong with that request. Please try again.