@@ -11,7 +11,7 @@ module Tests.Properties
1111import Control.Applicative ((<$>), (<*>))
1212import Control.Arrow ((***), second)
1313import Data.Bits ((.&.))
14−import Data.Char (chr, isDigit, isHexDigit, isLower, isSpace, isUpper, ord)
14+import Data.Char (chr, isDigit, isHexDigit, isLower, isSpace, isLetter, isUpper, ord)
1515import Data.Int (Int8, Int16, Int32, Int64)
1616import Data.Monoid (Monoid(..))
1717import Data.String (IsString(fromString))
@@ -23,6 +23,7 @@ import Data.Text.Internal.Search (indices)
2323import Data.Text.Lazy.Read as TL
2424import Data.Text.Read as T
2525import Data.Word (Word, Word8, Word16, Word32, Word64)
26+import Data.Maybe (mapMaybe)
2627import Numeric (showEFloat, showFFloat, showGFloat, showHex)
2728import Prelude hiding (replicate)
2829import Test.Framework (Test, testGroup)
@@ -37,6 +38,7 @@ import qualified Control.Exception as Exception
3738import qualified Data.Bits as Bits (shiftL, shiftR)
3839import qualified Data.ByteString as B
3940import qualified Data.ByteString.Lazy as BL
41+import qualified Data.Char as C
4042import qualified Data.List as L
4143import qualified Data.Text as T
4244import qualified Data.Text.Encoding as E
@@ -60,10 +62,10 @@ t_pack_unpack = (T.unpack . T.pack) `eq` id
6062tl_pack_unpack = (TL.unpack . TL.pack) `eq` id
6163t_stream_unstream = (S.unstream . S.stream) `eq` id
6264tl_stream_unstream = (SL.unstream . SL.stream) `eq` id
63−t_reverse_stream t = (S.reverse . S.reverseStream) t == t
64−t_singleton c = [c] == (T.unpack . T.singleton) c
65−tl_singleton c = [c] == (TL.unpack . TL.singleton) c
66−tl_unstreamChunks x = f 11 x == f 1000 x
65+t_reverse_stream t = (S.reverse . S.reverseStream) t === t
66+t_singleton c = [c] === (T.unpack . T.singleton) c
67+tl_singleton c = [c] === (TL.unpack . TL.singleton) c
68+tl_unstreamChunks x = f 11 x === f 1000 x
6769 where f n = SL.unstreamChunks n . S.streamList
6870tl_chunk_unchunk = (TL.fromChunks . TL.toChunks) `eq` id
6971tl_from_to_strict = (TL.fromStrict . TL.toStrict) `eq` id
@@ -74,13 +76,13 @@ encodeL1 = B.pack . map (fromIntegral . fromEnum) . T.unpack
7476encodeLazyL1 :: TL.Text -> BL.ByteString
7577encodeLazyL1 = BL.fromChunks . map encodeL1 . TL.toChunks
7678
77−t_ascii t = E.decodeASCII (E.encodeUtf8 a) == a
79+t_ascii t = E.decodeASCII (E.encodeUtf8 a) === a
7880 where a = T.map (\c -> chr (ord c `mod` 128)) t
79−tl_ascii t = EL.decodeASCII (EL.encodeUtf8 a) == a
81+tl_ascii t = EL.decodeASCII (EL.encodeUtf8 a) === a
8082 where a = TL.map (\c -> chr (ord c `mod` 128)) t
81−t_latin1 t = E.decodeLatin1 (encodeL1 a) == a
83+t_latin1 t = E.decodeLatin1 (encodeL1 a) === a
8284 where a = T.map (\c -> chr (ord c `mod` 256)) t
83−tl_latin1 t = EL.decodeLatin1 (encodeLazyL1 a) == a
85+tl_latin1 t = EL.decodeLatin1 (encodeLazyL1 a) === a
8486 where a = TL.map (\c -> chr (ord c `mod` 256)) t
8587t_utf8 = forAll genUnicode $ (E.decodeUtf8 . E.encodeUtf8) `eq` id
8688t_utf8' = forAll genUnicode $ (E.decodeUtf8' . E.encodeUtf8) `eq` (id . Right)
@@ -111,7 +113,7 @@ t_utf8_undecoded = forAll genUnicode $ \t ->
111113 let b = E.encodeUtf8 t
112114 ls = concatMap (leftover . E.encodeUtf8 . T.singleton) . T.unpack $ t
113115 leftover = (++ [B.empty]) . init . tail . B.inits
114− in (map snd . feedChunksOf 1 E.streamDecodeUtf8) b == ls
116+ in (map snd . feedChunksOf 1 E.streamDecodeUtf8) b === ls
115117
116118data Badness = Solo | Leading | Trailing
117119 deriving (Eq, Show)
@@ -201,8 +203,8 @@ t_mconcat = unsquare $
201203 mconcat `eq` (unpackS . mconcat . L.map T.pack)
202204tl_mconcat = unsquare $
203205 mconcat `eq` (unpackS . mconcat . L.map TL.pack)
204−t_mempty = mempty == (unpackS (mempty :: T.Text))
205−tl_mempty = mempty == (unpackS (mempty :: TL.Text))
206+t_mempty = mempty === (unpackS (mempty :: T.Text))
207+tl_mempty = mempty === (unpackS (mempty :: TL.Text))
206208t_IsString = fromString `eqP` (T.unpack . fromString)
207209tl_IsString = fromString `eqP` (TL.unpack . fromString)
208210
@@ -326,6 +328,19 @@ t_toUpper_upper t = p (T.toUpper t) >= p t
326328 where p = T.length . T.filter isUpper
327329tl_toUpper_upper t = p (TL.toUpper t) >= p t
328330 where p = TL.length . TL.filter isUpper
331+t_toTitle_title t = all (<= 1) (caps w)
332+ where caps = fmap (T.length . T.filter isUpper) . T.words . T.toTitle
333+ -- TIL: there exist uppercase-only letters
334+ w = T.filter (\c -> if C.isUpper c then C.toLower c /= c else True) t
335+t_toTitle_1stNotLower = and . notLow . T.toTitle . T.filter stable
336+ where notLow = mapMaybe (fmap (not . isLower) . (T.find isLetter)) . T.words
337+ -- Surprise! The Spanish/Portuguese ordinal indicators changed
338+ -- from category Ll (letter, lowercase) to Lo (letter, other)
339+ -- in Unicode 7.0
340+ -- Oh, and there exist lowercase-only letters (see previous test)
341+ stable c = if isLower c
342+ then C.toUpper c /= c
343+ else c /= '\170' && c /= '\186'
329344
330345justifyLeft k c xs = xs ++ L.replicate (k - length xs) c
331346justifyRight m n xs = L.replicate (m - length xs) n ++ xs
@@ -720,7 +735,7 @@ tl_indices (NotEmpty s) = lazyIndices s `eq` S.indices s
720735 conc = T.concat . TL.toChunks
721736t_indices_occurs = unsquare $ \(NotEmpty t) ts ->
722737 let s = T.intercalate t ts
723− in Slow.indices t s == indices t s
738+ in Slow.indices t s === indices t s
724739
725740-- Bit shifts.
726741shiftL w = forAll (choose (0,width-1)) $ \k -> Bits.shiftL w k == U.shiftL w k
@@ -812,18 +827,18 @@ tb_formatRealFloat_double (a::Double) = tb_formatRealFloat a
812827-- Reading.
813828
814829t_decimal (n::Int) s =
815− T.signed T.decimal (T.pack (show n) `T.append` t) == Right (n,t)
830+ T.signed T.decimal (T.pack (show n) `T.append` t) === Right (n,t)
816831 where t = T.dropWhile isDigit s
817832tl_decimal (n::Int) s =
818− TL.signed TL.decimal (TL.pack (show n) `TL.append` t) == Right (n,t)
833+ TL.signed TL.decimal (TL.pack (show n) `TL.append` t) === Right (n,t)
819834 where t = TL.dropWhile isDigit s
820835t_hexadecimal m s ox =
821− T.hexadecimal (T.concat [p, T.pack (showHex n ""), t]) == Right (n,t)
836+ T.hexadecimal (T.concat [p, T.pack (showHex n ""), t]) === Right (n,t)
822837 where t = T.dropWhile isHexDigit s
823838 p = if ox then "0x" else ""
824839 n = getPositive m :: Int
825840tl_hexadecimal m s ox =
826− TL.hexadecimal (TL.concat [p, TL.pack (showHex n ""), t]) == Right (n,t)
841+ TL.hexadecimal (TL.concat [p, TL.pack (showHex n ""), t]) === Right (n,t)
827842 where t = TL.dropWhile isHexDigit s
828843 p = if ox then "0x" else ""
829844 n = getPositive m :: Int
@@ -867,11 +882,11 @@ tl_write_read_line e m b t = write_read head TL.filter TL.hPutStrLn
867882
868883t_dropWord16 m t = dropWord16 m t `T.isSuffixOf` t
869884t_takeWord16 m t = takeWord16 m t `T.isPrefixOf` t
870−t_take_drop_16 m t = T.append (takeWord16 n t) (dropWord16 n t) == t
885+t_take_drop_16 m t = T.append (takeWord16 n t) (dropWord16 n t) === t
871886 where n = small m
872887t_use_from t = monadicIO $ assert . (==t) =<< run (useAsPtr t fromPtr)
873888
874−t_copy t = T.copy t == t
889+t_copy t = T.copy t === t
875890
876891-- Regression tests.
877892s_filter_eq s = S.filter p t == S.streamList (filter p s)
@@ -1030,7 +1045,9 @@ tests =
10301045 testProperty "tl_toLower_lower" tl_toLower_lower,
10311046 testProperty "t_toUpper_length" t_toUpper_length,
10321047 testProperty "t_toUpper_upper" t_toUpper_upper,
1033− testProperty "tl_toUpper_upper" tl_toUpper_upper
1048+ testProperty "tl_toUpper_upper" tl_toUpper_upper,
1049+ testProperty "t_toTitle_title" t_toTitle_title,
1050+ testProperty "t_toTitle_1stNotLower" t_toTitle_1stNotLower
10341051 ],
10351052
10361053 testGroup "justification" [