4a94bd4 · text · git.iko.soy

git.iko.soy/text

on master help sign in

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

4a94bd4Bryan O'Sullivan18 years ago

Data/Text.hs+97−81

compare with master

unifiedsplit

@@ -98,8 +98,8 @@ module Data.Text

98 , splitAt

99 , span

100 , break

101− -- , group

101+ , group

102− -- , groupBy

102+ , groupBy

103 , inits

104 , tails

105

@@ -145,10 +145,10 @@ module Data.Text

145

146import Prelude (Char, Bool, Functor(..), Int, Maybe(..), String,

147 Eq, (==), (++), error,

148− Show, showsPrec,

148+ Read(..), Show(..),

149− Read, readsPrec,

150− (&&), (||), (+), (-), (<), (>), (<=), (>=), (.),

149+ (&&), (||), (+), (-), (<), (>), (<=), (>=), (.), ($),

151 not, return, otherwise)

150 not, return, otherwise)

151+import Control.Exception (assert)

152import Data.Char (isSpace)

153import Control.Monad.ST (ST)

154import qualified Data.Text.Array as A

@@ -159,8 +159,9 @@ import Data.String (IsString(..))

159

160import qualified Data.Text.Fusion as S

161import Data.Text.Fusion (Stream(..), Step(..), stream, unstream)

162−import Data.Text.Internal (Text(..), empty)

162+import Data.Text.Internal (Text(..), empty, text)

163import qualified Prelude as P

164+import Data.Text.Unsafe (iter, iter_)

164import Data.Text.UnsafeChar (unsafeChr)

165import Data.Text.UnsafeChar (unsafeChr)

165import qualified Data.Text.Utf16 as U16

166import qualified Data.Text.Utf16 as U16

166

167

@@ -273,32 +274,13 @@ head :: Text -> Char

273head t = S.head (stream t)

274head t = S.head (stream t)

274{-# INLINE head #-}

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-- | /O(1)/ Returns the first character and rest of a 'Text', or

277-- | /O(1)/ Returns the first character and rest of a 'Text', or

296-- 'Nothing' if empty. Subject to array fusion.

278-- 'Nothing' if empty. Subject to array fusion.

297uncons :: Text -> Maybe (Char, Text)

279uncons :: Text -> Maybe (Char, Text)

298−uncons (Text arr off len)

280+uncons t@(Text arr off len)

299 | len <= 0 = Nothing

281 | len <= 0 = Nothing

300 | otherwise = Just (c, Text arr (off+d) (len-d))

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{-# INLINE uncons #-}

284{-# INLINE uncons #-}

303

285

304second :: (b -> c) -> (a,b) -> (a,c)

286second :: (b -> c) -> (a,b) -> (a,c)

@@ -329,24 +311,35 @@ last (Text arr off len)

329 S.last (stream t) = last t

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-- | /O(1)/ Returns all characters after the head of a 'Text', which

321-- | /O(1)/ Returns all characters after the head of a 'Text', which

334-- must be non-empty. Subject to array fusion.

322-- must be non-empty. Subject to array fusion.

335tail :: Text -> Text

323tail :: Text -> Text

336−tail (Text arr off len)

324+tail t@(Text arr off len)

337 | len <= 0 = errorEmptyList "tail"

325 | len <= 0 = errorEmptyList "tail"

338− | otherwise = Text arr (off+d) (len-d)

326+ | otherwise = textP arr (off+d) (len-d)

339− where d = iter_ arr off

327+ where d = iter_ t 0

340{-# INLINE [1] tail #-}

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-- | /O(1)/ Returns all but the last character of a 'Text', which must

337-- | /O(1)/ Returns all but the last character of a 'Text', which must

345-- be non-empty. Subject to array fusion.

338-- be non-empty. Subject to array fusion.

346init :: Text -> Text

339init :: Text -> Text

347init (Text arr off len) | len <= 0 = errorEmptyList "init"

340init (Text arr off len) | len <= 0 = errorEmptyList "init"

348− | n >= 0xDC00 && n <= 0xDFFF = Text arr off (len-2)

341+ | n >= 0xDC00 && n <= 0xDFFF = textP arr off (len-2)

349− | otherwise = Text arr off (len-1)

342+ | otherwise = textP arr off (len-1)

350 where

343 where

351 n = A.unsafeIndex arr (off+len-1)

344 n = A.unsafeIndex arr (off+len-1)

352{-# INLINE [1] init #-}

345{-# INLINE [1] init #-}

@@ -361,8 +354,15 @@ init (Text arr off len) | len <= 0 = errorEmptyList "init"

361-- | /O(1)/ Tests whether a 'Text' is empty or not. Subject to array

354-- | /O(1)/ Tests whether a 'Text' is empty or not. Subject to array

362-- fusion.

355-- fusion.

363null :: Text -> Bool

356null :: Text -> Bool

364−null t = S.null (stream t)

357+null (Text _arr _off len) = assert (len >= 0) $ len <= 0

365−{-# INLINE null #-}

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

367-- | /O(n)/ Returns the number of characters in a 'Text'.

368-- Subject to array fusion.

@@ -560,13 +560,12 @@ take :: Int -> Text -> Text

560take n t@(Text arr off len)

561 | n <= 0 = empty

562 | n >= len = t

563− | otherwise = Text arr off (loop off 0)

563+ | otherwise = Text arr off (loop 0 0)

564 where

565− end = off + len

566 loop !i !count

565 loop !i !count

567− | i >= end || count >= n = i - off

566+ | i >= len || count >= n = i

568− | otherwise = loop (i+d) (count+1)

567+ | otherwise = loop (i+d) (count+1)

569− where d = iter_ arr i

568+ where d = iter_ t i

570{-# INLINE [1] take #-}

569{-# INLINE [1] take #-}

571

570

572{-# RULES

571{-# RULES

@@ -583,12 +582,12 @@ drop :: Int -> Text -> Text

583drop n t@(Text arr off len)

582drop n t@(Text arr off len)

584 | n <= 0 = t

583 | n <= 0 = t

585 | n >= len = empty

584 | n >= len = empty

586− | otherwise = loop off 0 len

585+ | otherwise = loop 0 0

587 where end = off + len

586 where end = off + len

588− loop !i !count !l

587+ loop !i !count

589− | i >= end || count >= n = Text arr i l

588+ | i >= end || count >= n = Text arr (off+i) (len-i)

590− | otherwise = loop (i+d) (count+1) (l-d)

589+ | otherwise = loop (i+d) (count+1)

591− where d = iter_ arr i

590+ where d = iter_ t i

592{-# INLINE [1] drop #-}

591{-# INLINE [1] drop #-}

593

592

594{-# RULES

593{-# RULES

@@ -602,11 +601,11 @@ drop n t@(Text arr off len)

602-- the longest prefix (possibly empty) of elements that satisfy @p@.

601-- the longest prefix (possibly empty) of elements that satisfy @p@.

603-- This function is subject to array fusion.

602-- This function is subject to array fusion.

604takeWhile :: (Char -> Bool) -> Text -> Text

603takeWhile :: (Char -> Bool) -> Text -> Text

605−takeWhile p t@(Text arr off len) = loop off 0

604+takeWhile p t@(Text arr off len) = loop 0

606− where loop !i !l | l >= len = t

605+ where loop !i | i >= len = t

607− | p c = loop (i+d) (l+d)

606+ | p c = loop (i+d)

608− | otherwise = Text arr off l

607+ | otherwise = textP arr off i

609− where (c,d) = iter arr i

608+ where (c,d) = iter t i

610{-# INLINE [1] takeWhile #-}

609{-# INLINE [1] takeWhile #-}

611

610

612{-# RULES

611{-# RULES

@@ -619,11 +618,11 @@ takeWhile p t@(Text arr off len) = loop off 0

619-- | /O(n)/ 'dropWhile' @p@ @xs@ returns the suffix remaining after

618-- | /O(n)/ 'dropWhile' @p@ @xs@ returns the suffix remaining after

620-- 'takeWhile' @p@ @xs@. This function is subject to array fusion.

619-- 'takeWhile' @p@ @xs@. This function is subject to array fusion.

621dropWhile :: (Char -> Bool) -> Text -> Text

620dropWhile :: (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 where loop !i !l | l >= len = empty

622 where loop !i !l | l >= len = empty

624 | p c = loop (i+d) (l+d)

623 | p c = loop (i+d) (l+d)

625− | otherwise = Text arr i (len-l)

624+ | otherwise = Text arr (off+i) (len-l)

626− where (c,d) = iter arr i

625+ where (c,d) = iter t i

627{-# INLINE [1] dropWhile #-}

626{-# INLINE [1] dropWhile #-}

628

627

629{-# RULES

628{-# RULES

@@ -641,12 +640,11 @@ splitAt n t@(Text arr off len)

641 | n <= 0 = (empty, t)

640 | n <= 0 = (empty, t)

642 | n >= len = (t, empty)

641 | n >= len = (t, empty)

643 | otherwise = (Text arr off k, Text arr (off+k) (len-k))

642 | otherwise = (Text arr off k, Text arr (off+k) (len-k))

644− where k = loop off 0

643+ where k = loop 0 0

645− end = off + len

646 loop !i !count

644 loop !i !count

647− | i >= end || count >= n = i - off

645+ | i >= len || count >= n = i

648 | otherwise = loop (i+d) (count+1)

646 | otherwise = loop (i+d) (count+1)

649− where d = iter_ arr i

647+ where d = iter_ t i

650{-# INLINE splitAt #-}

648{-# INLINE splitAt #-}

651

649

652-- | /O(n)/ 'span', applied to a predicate @p@ and text @t@, returns a

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-- @t@ of elements that satisfy @p@, and whose second is the remainder

652-- @t@ of elements that satisfy @p@, and whose second is the remainder

655-- of the list.

653-- of the list.

656span :: (Char -> Bool) -> Text -> (Text, Text)

654span :: (Char -> Bool) -> Text -> (Text, Text)

657−span p t@(Text arr off len)

655+span p t@(Text arr off len) = (textP arr off k, textP arr (off+k) (len-k))

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

656+ where k = loop 0

662− loop !i !l | l >= len || not (p c) = l

657+ loop !i | i >= len || not (p c) = i

663− | otherwise = loop (i+d) (l+d)

658+ | otherwise = loop (i+d)

664− where (c,d) = iter arr i

659+ where (c,d) = iter t i

665{-# INLINE span #-}

660{-# INLINE span #-}

666

661

667-- | /O(n)/ 'break' is like 'span', but the prefix returned is over

662-- | /O(n)/ 'break' is like 'span', but the prefix returned is over

@@ -670,12 +665,35 @@ break :: (Char -> Bool) -> Text -> (Text, Text)

670break p = span (not . p)

665break p = span (not . p)

671{-# INLINE break #-}

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-- | /O(n)/ Return all initial segments of the given 'Text', shortest

691-- | /O(n)/ Return all initial segments of the given 'Text', shortest

674-- first.

692-- first.

675inits :: Text -> [Text]

693inits :: Text -> [Text]

676−inits t@(Text arr off len) = loop off

694+inits t@(Text arr off len) = loop 0

677 where loop i | i >= len = [t]

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-- | /O(n)/ Return all final segments of the given 'Text', longest

698-- | /O(n)/ Return all final segments of the given 'Text', longest

681-- first.

699-- first.

@@ -744,20 +762,18 @@ zipWith f t1 t2 = unstream (S.zipWith f (stream t1) (stream t2))

744-- | /O(n)/ Breaks a 'Text' up into a list of words, delimited by 'Char's

762-- | /O(n)/ Breaks a 'Text' up into a list of words, delimited by 'Char's

745-- representing white space.

763-- representing white space.

746words :: Text -> [Text]

764words :: Text -> [Text]

747−words (Text arr off len) = loop0 off off

765+words t@(Text arr off len) = loop 0 0

748− where

766+ where

749− loop0 start n

767+ loop !start !n

750− | n >= len = if start == n

768+ | n >= len = if start == n

751− then []

769+ then []

752− else [Text arr (start+off) (n-start)]

770+ else [Text arr (start+off) (n-start)]

753− | isSpace (unsafeChr c) =

771+ | isSpace c =

754− if start == n

772+ if start == n

755− then loop0 (start+1) (start+1)

773+ then loop (start+1) (start+1)

756− else Text arr (start+off) (n-start) : loop0 (n+1) (n+1)

774+ else Text arr (start+off) (n-start) : loop (n+d) (n+d)

757− | otherwise = if c < 0xD800 || c > 0xDBFF

775+ | otherwise = loop start (n+d)

758− then loop0 start (n+1)

776+ where (c,d) = iter t n

759− else loop0 start (n+2)

760− where c = arr `A.unsafeIndex` n

761{-# INLINE words #-}

777{-# INLINE words #-}

762

778

763-- | /O(n)/ Breaks a 'Text' up into a list of 'Text's at

779-- | /O(n)/ Breaks a 'Text' up into a list of 'Text's at

Data/Text/Array.hs+11

@@ -35,6 +35,7 @@ module Data.Text.Array

35 , unsafeNew

36 , unsafeFreeze

37 , run

38+ , toList

38 ) where

39 ) where

40#if 0

41#if 0

@@ -107,6 +108,9 @@ instance IArray (Array e) where

107 length (Array len _ba) = len

108 length (Array len _ba) = len

108 {-# INLINE length #-}

109 {-# INLINE length #-}

109

110

111+instance (Elt e, Show e) => Show (Array e) where

112+ show = show . toList

113+

110instance IArray (MArray s e) where

114instance IArray (MArray s e) where

111 length (MArray len _ba) = len

115 length (MArray len _ba) = len

112 {-# INLINE length #-}

116 {-# INLINE length #-}

@@ -247,6 +251,13 @@ instance Elt Word16 where

247

251

248#endif

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-- | An empty immutable array.

261-- | An empty immutable array.

251empty :: Elt e => Array e

262empty :: Elt e => Array e

252empty = runST (unsafeNew 0 >>= unsafeFreeze)

263empty = runST (unsafeNew 0 >>= unsafeFreeze)

Data/Text/Fusion.hs+14

@@ -87,6 +87,7 @@ module Data.Text.Fusion

87 , find

88 , index

89 , findIndex

90+ , findIndexOrEnd

90 , elemIndex

91 , elemIndex

92 -- * Zipping and unzipping

93 -- * Zipping and unzipping

@@ -764,6 +765,19 @@ findIndex p (Stream next s0 _len) = loop_findIndex 0 s0

764 | otherwise -> loop_findIndex (i+1) s'

765 | otherwise -> loop_findIndex (i+1) s'

765{-# INLINE [0] findIndex #-}

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-- | /O(n)/ The 'elemIndex' function returns the index of the first

781-- | /O(n)/ The 'elemIndex' function returns the index of the first

768-- element in the given stream which is equal to the query

782-- element in the given stream which is equal to the query

769-- element, or 'Nothing' if there is no such element.

783-- element, or 'Nothing' if there is no such element.

Data/Text/Internal.hs+26−4

@@ -19,21 +19,43 @@ module Data.Text.Internal

19 (

20 -- * Types

21 Text(..)

22+ -- * Construction

23+ , text

22 -- * Code that must be here for accessibility

24 -- * Code that must be here for accessibility

23 , empty

25 , empty

26+ -- * Debugging

27+ , showText

24 ) where

28 ) where

30+import Control.Exception (assert)

26import qualified Data.Text.Array as A

31import qualified Data.Text.Array as A

27import Data.Typeable (Typeable)

32import Data.Typeable (Typeable)

28import Data.Word (Word16)

33import Data.Word (Word16)

30-- | A space efficient, packed, unboxed Unicode text type.

35-- | A space efficient, packed, unboxed Unicode text type.

36+data Text = Text {

31−data Text = Text {-# UNPACK #-} !(A.Array Word16) -- payload

37+ textArray :: {-# UNPACK #-} !(A.Array Word16) -- payload

32− {-# UNPACK #-} !Int -- offset

38+ , textOffset :: {-# UNPACK #-} !Int -- offset

33− {-# UNPACK #-} !Int -- length

39+ , textLength :: {-# UNPACK #-} !Int -- length

34− deriving (Typeable)

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 #-}

36-- | /O(1)/ The empty 'Text'.

53-- | /O(1)/ The empty 'Text'.

37empty :: Text

54empty :: Text

38empty = Text A.empty 0 0

55empty = Text A.empty 0 0

39{-# INLINE [1] empty #-}

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

Data/Text/Unsafe.hsnew file+64

@@ -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_ #-}

tests/Properties.hs+30−3

@@ -10,6 +10,7 @@ import System.Environment

10import Control.Applicative

11import Control.Arrow

12import Control.Monad

13+import Data.Word

13import qualified Data.Text as T

14import qualified Data.Text as T

14import Data.Text (pack,unpack)

15import Data.Text (pack,unpack)

15import qualified Data.Text.Fusion as S

16import qualified Data.Text.Fusion as S

@@ -24,12 +25,34 @@ prop_stream_unstream t = (unstream . stream) t == t

24prop_singleton c = [c] == (unpack . T.singleton) c

25prop_singleton c = [c] == (unpack . T.singleton) c

26-- Do two functions give the same answer?

27-- Do two functions give the same answer?

28+eq :: (Eq a) => (t -> a) -> (t -> a) -> t -> Bool

27eq a b s = a s == b s

29eq a b s = a s == b s

28-- What about with the RHS packed?

30-- What about with the RHS packed?

31+eqP :: (Eq a) => (String -> a) -> (T.Text -> a) -> String -> Word8 -> Bool

29−eqP a b s = a s == b (pack s)

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-- Or with the string non-empty, and the RHS packed?

42-- Or with the string non-empty, and the RHS packed?

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

31−eqEP a b s = let e = notEmpty s

55+ s = notEmpty e

32− in a e == b (pack e)

34prop_cons x = (x:) `eqP` (unpack . T.cons x)

57prop_cons x = (x:) `eqP` (unpack . T.cons x)

35prop_snoc x = (++ [x]) `eqP` (unpack . (flip T.snoc) x)

58prop_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 .

95prop_splitAt n = L.splitAt n `eqP` ((unpack *** unpack) . T.splitAt n)

118prop_splitAt n = L.splitAt n `eqP` ((unpack *** unpack) . T.splitAt n)

96prop_span p = L.span p `eqP` ((unpack *** unpack) . T.span p)

119prop_span p = L.span p `eqP` ((unpack *** unpack) . T.span p)

97prop_break p = L.break p `eqP` ((unpack *** unpack) . T.break p)

120prop_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)

98prop_inits = L.inits `eqP` (map unpack . T.inits)

123prop_inits = L.inits `eqP` (map unpack . T.inits)

99prop_tails = L.tails `eqP` (map unpack . T.tails)

124prop_tails = L.tails `eqP` (map unpack . T.tails)

100

125

@@ -185,6 +210,8 @@ tests = [

185 ("prop_splitAt", mytest prop_splitAt),

210 ("prop_splitAt", mytest prop_splitAt),

186 ("prop_span", mytest prop_span),

211 ("prop_span", mytest prop_span),

187 ("prop_break", mytest prop_break),

212 ("prop_break", mytest prop_break),

213+ ("prop_group", mytest prop_group),

214+ ("prop_groupBy", mytest prop_groupBy),

188 ("prop_inits", mytest prop_inits),

215 ("prop_inits", mytest prop_inits),

189 ("prop_tails", mytest prop_tails),

216 ("prop_tails", mytest prop_tails),

190

217

tests/QuickCheckUtils.hs+8

@@ -14,6 +14,14 @@ integralRandomR (a,b) g = case randomR (fromIntegral a :: Integer,

14 fromIntegral b :: Integer) g of

15 (x,g) -> (fromIntegral x, g)

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+

17instance Random Word16 where

25instance Random Word16 where

18 randomR = integralRandomR

26 randomR = integralRandomR

19 random = randomR (minBound,maxBound)

27 random = randomR (minBound,maxBound)

text.cabal+1

@@ -20,6 +20,7 @@ library

20 Data.Text.Array

21 Data.Text.Encoding

22 Data.Text.Encoding.Fusion

23+ Data.Text.Unsafe

23 Data.Text.UnsafeChar

24 Data.Text.UnsafeChar

24 Data.Text.Internal

25 Data.Text.Internal

25 Data.Text.Fusion

26 Data.Text.Fusion