1{-# LANGUAGE OverloadedLists   #-}
2{-# LANGUAGE OverloadedStrings #-}
3
4module Main(main) where
5
6import           Data.Binary
7import           Data.Char
8import           Data.Maybe
9import           Data.Monoid
10import qualified Data.String               as D.S
11import qualified Data.Text                 as T
12import qualified Data.Text.Encoding        as T
13import qualified Data.Text.Short           as IUT
14import qualified Data.Text.Short.Partial   as IUT
15import           Test.QuickCheck.Instances ()
16import           Test.Tasty
17import           Test.Tasty.HUnit
18import           Test.Tasty.QuickCheck     as QC
19import           Text.Show.Functions       ()
20
21fromByteStringRef = either (const Nothing) (Just . IUT.fromText) . T.decodeUtf8'
22
23main :: IO ()
24main = defaultMain (adjustOption (QuickCheckTests 50000 `max`) $ tests)
25
26tests :: TestTree
27tests = testGroup "Tests" [unitTests,qcProps]
28
29-- ShortText w/ in-bounds index
30data STI = STI IUT.ShortText Int
31         deriving (Eq,Show)
32
33newtype ST = ST IUT.ShortText
34           deriving (Eq,Show)
35
36instance Arbitrary STI where
37  arbitrary = do
38    t <- arbitrary
39    i <- choose (0, T.length t - 1)
40    return $! STI (IUT.fromText t) i
41
42instance Arbitrary ST where
43  arbitrary = fmap (ST . IUT.fromText) arbitrary
44  shrink (ST st) = map (ST . IUT.fromText) (shrink (IUT.toText st))
45
46qcProps :: TestTree
47qcProps = testGroup "Properties"
48  [ QC.testProperty "length/fromText"   $ \t -> IUT.length (IUT.fromText t) == T.length t
49  , QC.testProperty "length/fromString" $ \s -> IUT.length (IUT.fromString s) == length s
50  , QC.testProperty "length/append"     $ \(ST t1) (ST t2) -> IUT.length t1 + IUT.length t2 == IUT.length (IUT.append t1 t2)
51  , QC.testProperty "compare" $ \t1 t2 -> IUT.fromText t1 `compare` IUT.fromText t2  == t1 `compare` t2
52  , QC.testProperty "(==)" $ \t1 t2 -> (IUT.fromText t1 == IUT.fromText t2)  == (t1 == t2)
53  , QC.testProperty "(!?)" $ \t ->
54      let t' = IUT.fromText t
55      in and ([ mapMaybe (t' IUT.!?) ([0 .. T.length t -1 ] :: [Int]) == T.unpack t
56              , mapMaybe (t' IUT.!?) [-5 .. -1] == []
57              , mapMaybe (t' IUT.!?) [T.length t .. T.length t + 5] == []
58              ] :: [Bool])
59  , QC.testProperty "indexEndMaybe" $ \t ->
60      let t' = IUT.fromText t
61      in and ([ mapMaybe (IUT.indexEndMaybe t') [0 .. T.length t -1 ] == T.unpack (T.reverse t)
62              , mapMaybe (IUT.indexEndMaybe t') [-5 .. -1] == []
63              , mapMaybe (IUT.indexEndMaybe t') [T.length t .. T.length t + 5] == []
64              ] :: [Bool])
65  , QC.testProperty "toText.fromText"   $ \t -> (IUT.toText . IUT.fromText) t == t
66  , QC.testProperty "fromByteString"    $ \b -> IUT.fromByteString b == fromByteStringRef b
67  , QC.testProperty "fromByteString.toByteString" $ \t -> let ts = IUT.fromText t in (IUT.fromByteString . IUT.toByteString) ts == Just ts
68  , QC.testProperty "toString.fromString" $ \s -> (IUT.toString . IUT.fromString) s == s
69  , QC.testProperty "isAscii"  $ \s -> IUT.isAscii (IUT.fromString s) == all isAscii s
70  , QC.testProperty "isAscii2" $ \t -> IUT.isAscii (IUT.fromText t)   == T.all isAscii t
71  , QC.testProperty "splitAt" $ \t ->
72      let t' = IUT.fromText t
73          mapBoth f (x,y) = (f x, f y)
74      in and [ mapBoth IUT.toText (IUT.splitAt i t') == T.splitAt i t | i <- [-5 .. 5+T.length t ] ]
75  , QC.testProperty "intercalate/split" $ \t c ->
76      let t' = IUT.fromText t
77      in IUT.intercalate (IUT.singleton c) (IUT.split (== c) t') == t'
78
79  , QC.testProperty "intersperse" $ \t c -> IUT.intersperse c (IUT.fromText t) == IUT.fromText (T.intersperse c t)
80  , QC.testProperty "intercalate" $ \t1 t2 -> IUT.intercalate (IUT.fromText t1) (map IUT.fromText t2) == IUT.fromText (T.intercalate t1 t2)
81  , QC.testProperty "reverse.singleton" $ \c -> IUT.reverse (IUT.singleton c) == IUT.singleton c
82  , QC.testProperty "reverse"     $ \t -> IUT.reverse (IUT.fromText t) == IUT.fromText (T.reverse t)
83  , QC.testProperty "filter"      $ \p t -> IUT.filter p (IUT.fromText t) == IUT.fromText (T.filter p t)
84  , QC.testProperty "replicate"   $ \n t -> IUT.replicate n (IUT.fromText t) == IUT.fromText (T.replicate n t)
85  , QC.testProperty "dropAround"  $ \p t -> IUT.dropAround p (IUT.fromText t) == IUT.fromText (T.dropAround p t)
86
87  , QC.testProperty "foldl"       $ \f z t -> IUT.foldl f (z :: Char) (IUT.fromText t) == T.foldl f (z :: Char) t
88  , QC.testProperty "foldl #2"    $ \t -> IUT.foldl (\n _ -> (n+1)) 0 (IUT.fromText t) == T.length t
89  , QC.testProperty "foldl #3"    $ \t -> IUT.foldl (\s c -> c : s) [] (IUT.fromText t) == T.unpack (T.reverse t)
90
91  , QC.testProperty "foldl'"      $ \f z t -> IUT.foldl' f (z :: Char) (IUT.fromText t) == T.foldl' f (z :: Char) t
92  , QC.testProperty "foldl' #2"   $ \t -> IUT.foldl' (\n _ -> (n+1)) 0 (IUT.fromText t) == T.length t
93  , QC.testProperty "foldl' #3"   $ \t -> IUT.foldl' (\s c -> c : s) [] (IUT.fromText t) == T.unpack (T.reverse t)
94
95  , QC.testProperty "foldr"       $ \f z t -> IUT.foldr f (z :: Char) (IUT.fromText t) == T.foldr f (z :: Char) t
96  , QC.testProperty "foldr #2"    $ \t -> IUT.foldr (\_ n -> (n+1)) 0 (IUT.fromText t) == T.length t
97  , QC.testProperty "foldr #3"    $ \t -> IUT.foldr (:) [] (IUT.fromText t) == T.unpack t
98
99  , QC.testProperty "foldr1"      $ \f t -> (not (T.null t)) ==> IUT.foldr1 f (IUT.fromText t) == T.foldr1 f t
100  , QC.testProperty "foldl1"      $ \f t -> (not (T.null t)) ==> IUT.foldl1 f (IUT.fromText t) == T.foldl1 f t
101  , QC.testProperty "foldl1'"     $ \f t -> (not (T.null t)) ==> IUT.foldl1' f (IUT.fromText t) == T.foldl1' f t
102
103  , QC.testProperty "splitAtEnd" $ \t ->
104      let t' = IUT.fromText t
105          n' = IUT.length t'
106      in and [ (IUT.splitAt (n'-i) t') == IUT.splitAtEnd i t' | i <- [-5 .. 5+n' ] ]
107
108  , QC.testProperty "find" $ \t -> IUT.find Data.Char.isAscii (IUT.fromText t) == T.find Data.Char.isAscii t
109  , QC.testProperty "findIndex" $ \t -> IUT.findIndex Data.Char.isAscii (IUT.fromText t) == T.findIndex Data.Char.isAscii t
110
111  , QC.testProperty "isSuffixOf" $ \t1 t2 -> IUT.fromText t1 `IUT.isSuffixOf` IUT.fromText t2  == t1 `T.isSuffixOf` t2
112  , QC.testProperty "isPrefixOf" $ \t1 t2 -> IUT.fromText t1 `IUT.isPrefixOf` IUT.fromText t2  == t1 `T.isPrefixOf` t2
113
114  , QC.testProperty "stripPrefix" $ \t1 t2 -> IUT.stripPrefix (IUT.fromText t1) (IUT.fromText t2) ==
115                                                fmap IUT.fromText (T.stripPrefix t1 t2)
116
117  , QC.testProperty "stripSuffix" $ \t1 t2 -> IUT.stripSuffix (IUT.fromText t1) (IUT.fromText t2) ==
118                                                fmap IUT.fromText (T.stripSuffix t1 t2)
119
120  , QC.testProperty "stripPrefix 2" $ \(STI t i) ->
121      let (pfx,sfx) = IUT.splitAt i t
122      in IUT.stripPrefix pfx t == Just sfx
123
124  , QC.testProperty "stripSuffix 2" $ \(STI t i) ->
125      let (pfx,sfx) = IUT.splitAt i t
126      in IUT.stripSuffix sfx t == Just pfx
127
128  , QC.testProperty "cons" $ \c t -> IUT.singleton c <> IUT.fromText t == IUT.cons c (IUT.fromText t)
129  , QC.testProperty "snoc" $ \c t -> IUT.fromText t <> IUT.singleton c == IUT.snoc (IUT.fromText t) c
130
131  , QC.testProperty "uncons" $ \c t -> IUT.uncons (IUT.singleton c <> IUT.fromText t) == Just (c, IUT.fromText t)
132
133  , QC.testProperty "unsnoc" $ \c t -> IUT.unsnoc (IUT.fromText t <> IUT.singleton c) == Just (IUT.fromText t, c)
134
135  , QC.testProperty "break" $ \t -> let (l,r)   = IUT.break Data.Char.isAscii (IUT.fromText t)
136                                    in  T.break Data.Char.isAscii t == (IUT.toText l,IUT.toText r)
137
138  , QC.testProperty "span"  $ \t -> let (l,r)   = IUT.span Data.Char.isAscii (IUT.fromText t)
139                                    in  T.span Data.Char.isAscii t == (IUT.toText l,IUT.toText r)
140
141  , QC.testProperty "breakEnd" $ \t -> let (l,r)   = IUT.breakEnd Data.Char.isAscii (IUT.fromText t)
142                                       in  t_breakEnd Data.Char.isAscii t == (IUT.toText l,IUT.toText r)
143
144  , QC.testProperty "spanEnd"  $ \t -> let (l,r)   = IUT.spanEnd Data.Char.isAscii (IUT.fromText t)
145                                       in  t_spanEnd Data.Char.isAscii t == (IUT.toText l,IUT.toText r)
146
147  , QC.testProperty "splitAt/isPrefixOf" $ \t ->
148      let t' = IUT.fromText t
149      in and [ IUT.isPrefixOf (fst (IUT.splitAt i t')) t' | i <- [-5 .. 5+T.length t ] ]
150  , QC.testProperty "splitAt/isSuffixOf" $ \t ->
151      let t' = IUT.fromText t
152      in and [ IUT.isSuffixOf (snd (IUT.splitAt i t')) t' | i <- [-5 .. 5+T.length t ] ]
153  ]
154
155t_breakEnd p t = t_spanEnd (not . p) t
156t_spanEnd  p t = (T.dropWhileEnd p t, T.takeWhileEnd p t)
157
158unitTests = testGroup "Unit-tests"
159  [ testCase "fromText mempty" $ IUT.fromText mempty @?= mempty
160  , testCase "fromShortByteString [0xc0,0x80]" $ IUT.fromShortByteString "\xc0\x80" @?= Nothing
161  , testCase "fromByteString [0xc0,0x80]" $ IUT.fromByteString "\xc0\x80" @?= Nothing
162  , testCase "fromByteString [0xf0,0x90,0x80,0x80]" $ IUT.fromByteString "\xf0\x90\x80\x80" @?= Just "\x10000"
163  , testCase "fromByteString [0xf4,0x90,0x80,0x80]" $ IUT.fromByteString "\244\144\128\128" @?= Nothing
164  , testCase "IsString U+D800" $ "\xFFFD" @?= (IUT.fromString "\xD800")
165--  , testCase "IsString U+D800" $ (IUT.fromString "\xD800") @?= IUT.fromText ("\xD800" :: T.Text)
166
167  , testCase "Binary.encode" $ encode ("Hello \8364 & \171581!\NUL" :: IUT.ShortText) @?= "\NUL\NUL\NUL\NUL\NUL\NUL\NUL\DC2Hello \226\130\172 & \240\169\184\189!\NUL"
168  , testCase "Binary.decode" $ decode ("\NUL\NUL\NUL\NUL\NUL\NUL\NUL\DC2Hello \226\130\172 & \240\169\184\189!\NUL") @?= ("Hello \8364 & \171581!\NUL" :: IUT.ShortText)
169  , testCase "singleton" $ [ c | c <- [minBound..maxBound], IUT.singleton c /= IUT.fromText (T.singleton c) ] @?= []
170
171  , testCase "splitAtEnd" $ IUT.splitAtEnd 1 "€€" @?= ("€","€")
172  , testCase "split#1" $ IUT.split (== 'a') "aabbaca" @?= ["", "", "bb", "c", ""]
173  , testCase "split#2" $ IUT.split (const False) "aabbaca" @?= ["aabbaca"]
174  , testCase "split#3" $ IUT.split (const True) "abc" @?= ["","","",""]
175  , testCase "split#4" $ IUT.split (const True) "" @?= [""]
176
177  , testCase "literal0" $ IUT.unpack testLit0 @?= []
178  , testCase "literal1" $ IUT.unpack testLit1 @?= ['€','\0','€','\0']
179  , testCase "literal2" $ IUT.unpack testLit2 @?= ['\xFFFD','\xD7FF','\xFFFD','\xE000']
180  , testCase "literal3" $ IUT.unpack testLit3 @?= ['\1'..'\x7f']
181  , testCase "literal4" $ IUT.unpack testLit4 @?= map toEnum [0,1,126,127,128,129,130,256,2046,2047,2048,2049,2050,65530,65531,65532,65533,65534,65533,65535,65536,65537,65538,1114110,1114111]
182  , testCase "literal5" $ IUT.unpack testLit5 @?= map toEnum [28961]
183  , testCase "literal6" $ IUT.unpack testLit6 @?= map toEnum [0]
184  , testCase "literal7" $ IUT.unpack testLit7 @?= map toEnum [66328]
185  , testCase "literal8" $ IUT.unpack testLit8 @?= map toEnum [127]
186
187    -- list literals
188  , testCase "literal9"  $ [] @?= ("" :: IUT.ShortText)
189  , testCase "literal10" $ ['¤','€','$'] @?= ("¤€$" :: IUT.ShortText)
190  , testCase "literal12" $ IUT.unpack ['\xD800','\xD7FF','\xDFFF','\xE000'] @?= ['\xFFFD','\xD7FF','\xFFFD','\xE000']
191 ]
192
193-- isScalar :: Char -> Bool
194-- isScalar c = c < '\xD800' || c >= '\xE000'
195
196
197{-# NOINLINE testLit0 #-}
198testLit0 :: IUT.ShortText
199testLit0 = ""
200
201{-# NOINLINE testLit1 #-}
202testLit1 :: IUT.ShortText
203testLit1 = "€\NUL€\NUL"
204
205{-# NOINLINE testLit2 #-}
206testLit2 :: IUT.ShortText
207testLit2 = "\xD800\xD7FF\xDFFF\xE000"
208
209{-# NOINLINE testLit3 #-}
210testLit3 :: IUT.ShortText
211testLit3 = "\SOH\STX\ETX\EOT\ENQ\ACK\a\b\t\n\v\f\r\SO\SI\DLE\DC1\DC2\DC3\DC4\NAK\SYN\ETB\CAN\EM\SUB\ESC\FS\GS\RS\US !\"#$%&'()*+,-./0123456789:;<=>?@ABCDEFGHIJKLMNOPQRSTUVWXYZ[\\]^_`abcdefghijklmnopqrstuvwxyz{|}~\DEL"
212
213{-# NOINLINE testLit4 #-}
214testLit4 :: IUT.ShortText
215testLit4 = "\NUL\SOH~\DEL\128\129\130\256\2046\2047\2048\2049\2050\65530\65531\65532\65533\65534\65533\65535\65536\65537\65538\1114110\1114111"
216
217{-# NOINLINE testLit5 #-}
218testLit5 :: IUT.ShortText
219testLit5 = "無"
220
221{-# NOINLINE testLit6 #-}
222testLit6 :: IUT.ShortText
223testLit6 = "\NUL"
224
225{-# NOINLINE testLit7 #-}
226testLit7 :: IUT.ShortText
227testLit7 = "��"
228
229{-# NOINLINE testLit8 #-}
230testLit8 :: IUT.ShortText
231testLit8 = "\x7f"
232