]> git.immae.eu Git - github/fretlink/text-pipes.git/blob - test/Utils.hs
simplify imports
[github/fretlink/text-pipes.git] / test / Utils.hs
1 {-#LANGUAGE ScopedTypeVariables#-}
2 module Utils where
3 import Control.Exception (SomeException, bracket, bracket_, evaluate, try)
4 import System.IO.Unsafe (unsafePerformIO)
5 import Debug.Trace (trace)
6 import Data.Bits ((.&.))
7 import Data.Char (chr)
8 import Data.String (IsString, fromString)
9 import System.Random (Random (..), RandomGen)
10 import Test.QuickCheck hiding ((.&.))
11 import Test.QuickCheck.Monadic (assert, monadicIO, run)
12 import qualified Data.ByteString as B
13 import Pipes.Text.Internal
14
15
16
17
18
19 -- Ensure that two potentially bottom values (in the sense of crashing
20 -- for some inputs, not looping infinitely) either both crash, or both
21 -- give comparable results for some input.
22 (=^=) :: (Eq a, Show a) => a -> a -> Bool
23 i =^= j = unsafePerformIO $ do
24 x <- try (evaluate i)
25 y <- try (evaluate j)
26 case (x,y) of
27 (Left (_ :: SomeException), Left (_ :: SomeException))
28 -> return True
29 (Right a, Right b) -> return (a == b)
30 e -> trace ("*** Divergence: " ++ show e) return False
31 infix 4 =^=
32 {-# NOINLINE (=^=) #-}
33
34 -- Do two functions give the same answer?
35 eq :: (Eq a, Show a) => (t -> a) -> (t -> a) -> t -> Bool
36 eq a b s = a s =^= b s
37
38 -- What about with the RHS packed?
39 -- eqP :: (Eq a, Show a, Stringy s) =>
40 -- (String -> a) -> (s -> a) -> String -> Word8 -> Bool
41 -- eqP f g s w = eql "orig" (f s) (g t) &&
42 -- eql "mini" (f s) (g mini) &&
43 -- eql "head" (f sa) (g ta) &&
44 -- eql "tail" (f sb) (g tb)
45 -- where t = packS s
46 -- mini = packSChunkSize 10 s
47 -- (sa,sb) = splitAt m s
48 -- (ta,tb) = splitAtS m t
49 -- l = length s
50 -- m | l == 0 = n
51 -- | otherwise = n `mod` l
52 -- n = fromIntegral w
53 -- eql d a b
54 -- | a =^= b = True
55 -- | otherwise = trace (d ++ ": " ++ show a ++ " /= " ++ show b) False
56
57
58 instance Arbitrary B.ByteString where
59 arbitrary = B.pack `fmap` arbitrary
60
61 genUnicode :: IsString a => Gen a
62 genUnicode = fmap fromString string where
63 string = sized $ \n ->
64 do k <- choose (0,n)
65 sequence [ char | _ <- [1..k] ]
66
67 excluding :: [a -> Bool] -> Gen a -> Gen a
68 excluding bad gen = loop
69 where
70 loop = do
71 x <- gen
72 if or (map ($ x) bad)
73 then loop
74 else return x
75
76 reserved = [lowSurrogate, highSurrogate, noncharacter]
77 lowSurrogate c = c >= 0xDC00 && c <= 0xDFFF
78 highSurrogate c = c >= 0xD800 && c <= 0xDBFF
79 noncharacter c = masked == 0xFFFE || masked == 0xFFFF
80 where
81 masked = c .&. 0xFFFF
82
83 ascii = choose (0,0x7F)
84 plane0 = choose (0xF0, 0xFFFF)
85 plane1 = oneof [ choose (0x10000, 0x10FFF)
86 , choose (0x11000, 0x11FFF)
87 , choose (0x12000, 0x12FFF)
88 , choose (0x13000, 0x13FFF)
89 , choose (0x1D000, 0x1DFFF)
90 , choose (0x1F000, 0x1FFFF)
91 ]
92 plane2 = oneof [ choose (0x20000, 0x20FFF)
93 , choose (0x21000, 0x21FFF)
94 , choose (0x22000, 0x22FFF)
95 , choose (0x23000, 0x23FFF)
96 , choose (0x24000, 0x24FFF)
97 , choose (0x25000, 0x25FFF)
98 , choose (0x26000, 0x26FFF)
99 , choose (0x27000, 0x27FFF)
100 , choose (0x28000, 0x28FFF)
101 , choose (0x29000, 0x29FFF)
102 , choose (0x2A000, 0x2AFFF)
103 , choose (0x2B000, 0x2BFFF)
104 , choose (0x2F000, 0x2FFFF)
105 ]
106 plane14 = choose (0xE0000, 0xE0FFF)
107 planes = [ascii, plane0, plane1, plane2, plane14]
108
109 char = chr `fmap` excluding reserved (oneof planes)