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