-- Tester beware!
--
-- Many of the tests below are "weak", i.e. they ensure that functions
-- return results, without checking whether the results are correct.
-- Weak tests are described as such.

{-# LANGUAGE CPP #-}
{-# LANGUAGE OverloadedStrings, LambdaCase #-}
{-# OPTIONS_GHC -fno-warn-missing-signatures #-}
module Properties (propertyTests, testCases) where

import Control.Monad (unless)
import qualified Control.Exception as E
import Control.DeepSeq (NFData(..))
import Data.Function (on)
import Data.Maybe (fromMaybe)
import Data.Text (Text)
import Data.Text.ICU (LocaleName(..), ParseError(..))
import QuickCheckUtils (NonEmptyText(..), LatinSpoofableText(..),
                        NonSpoofableText(..), Utf8Text(..))
import Data.Text.ICU.Normalize2 (NormalizationMode(..))
import qualified Data.Text.ICU.Normalize2 as I
import Test.Framework (Test, testGroup)
import Test.Framework.Providers.QuickCheck2 (testProperty)
import Test.Framework.Providers.HUnit (hUnitTestToTests)
import Test.HUnit ((~?=), (@?=), (~:))
import qualified Test.HUnit (Test(..), assertFailure)
import Test.HUnit.Lang (HUnitFailure (..), FailureReason (..))
import Test.QuickCheck.Monadic (monadicIO, run, assert)
import qualified Data.Text as T
import qualified Data.Text.Encoding as T
import qualified Data.Text.ICU as I
import qualified Data.Text.ICU.BiDi as BiDi
import qualified Data.Text.ICU.Calendar as Cal
import qualified Data.Text.ICU.Convert as I
import qualified Data.Text.ICU.Char as I
import qualified Data.Text.ICU.CharsetDetection as CD
import qualified Data.Text.ICU.Error as Err
import qualified Data.Text.ICU.Number as N
import qualified Data.Text.ICU.Shape as S
import System.IO.Unsafe (unsafePerformIO)

#if !MIN_VERSION_base(4,11,0)
import Data.Semigroup ((<>))
#endif

{-# ANN module ("HLint: use camelCase"::String) #-}

t_rnf :: (NFData b) => (a -> b) -> a -> Bool
t_rnf f t = rnf (f t) == ()

t_nonEmpty :: (Text -> Text) -> Text -> Bool
t_nonEmpty f t
    | T.null t  = T.null ft
    | otherwise = T.length ft > 0
  where ft = f t

-- Case mapping

-- These tests are all fairly weak.

t_toCaseFold bool = t_nonEmpty $ I.toCaseFold bool
t_toLower locale = t_nonEmpty $ I.toLower locale
t_toUpper locale = t_nonEmpty $ I.toUpper locale

-- Iteration

t_charIterator_String a b = (compare `on` I.fromString) a b == compare a b
t_charIterator_Text a b = (compare `on` I.fromText) a b == compare a b
t_charIterator_Utf8 a b = (compare `on` I.fromUtf8) ba bb == compare ba bb
  where ba = T.encodeUtf8 a; bb = T.encodeUtf8 b

-- Normalization

t_quickCheck_isNormalized mode normMode txt
  | mode `elem` [NFD, NFKD] =          quickCheck == Just isNormalized
  | otherwise = fromMaybe isNormalized quickCheck ==      isNormalized
  where quickCheck   = I.quickCheck mode normTxt
        isNormalized = I.isNormalized mode normTxt
        normTxt      = I.normalize normMode txt

-- Collation

t_collate a b = c a b == flipOrdering (c b a)
    where c = I.collate I.uca

t_collate_emptyRule a b = I.collate cUca a b == I.collate cEmpty a b
  where
    cUca = I.uca
    cEmpty = either (error "Can’t create empty collator") id
      $ I.collatorFromRules ""

flipOrdering :: Ordering -> Ordering
flipOrdering = \ case
    GT -> LT
    LT -> GT
    EQ -> EQ

-- Convert

converter e = unsafePerformIO $ I.open e Nothing

t_convert a = I.toUnicode c (I.fromUnicode c a) == a
    where c = converter "UTF-32"


-- Unicode character database

-- These tests are weak.

t_blockCode = t_rnf I.blockCode
t_charFullName c = I.charFromFullName (I.charFullName c) == Just c
t_charName c = maybe True (==c) $ I.charFromName (I.charName c)
t_combiningClass = t_rnf I.combiningClass
t_direction = t_rnf I.direction
-- t_property p = t_rnf $ I.property p
t_isMirrored = t_rnf $ I.isMirrored
t_mirror = t_rnf $ I.mirror
t_digitToInt = t_rnf $ I.digitToInt
t_numericValue = t_rnf $ I.numericValue

-- Spoofing

t_nonspoofable (NonSpoofableText t) = I.spoofCheck I.spoof t == I.CheckOK
t_spoofable (LatinSpoofableText t) = I.spoofCheck I.spoof t ==
                                     I.CheckFailed [I.RestrictionLevel]
t_confusable (NonEmptyText t) = I.areConfusable I.spoof t t `elem`
  [I.CheckFailed [I.MixedScriptConfusable]
  ,I.CheckFailed [I.SingleScriptConfusable]]

-- Encoding Guessing

t_Utf8IsUtf8 a = monadicIO $ do
    val <- run $ CD.detect (utf8Text a) >>= CD.getName
    assert $ T.isPrefixOf "UTF-8" val

propertyTests :: Test
propertyTests =
  testGroup "Properties" [
    testProperty "t_toCaseFold" t_toCaseFold
  , testProperty "t_toLower" t_toLower
  , testProperty "t_toUpper" t_toUpper
  , testProperty "t_charIterator_String" t_charIterator_String
  , testProperty "t_charIterator_Text" t_charIterator_Text
  , testProperty "t_charIterator_Utf8" t_charIterator_Utf8
  , testProperty "t_quickCheck_isNormalized" t_quickCheck_isNormalized
  , testProperty "t_collate" t_collate
  , testProperty "t_collate_emptyRule" t_collate_emptyRule
  , testProperty "t_convert" t_convert
  , testProperty "t_blockCode" t_blockCode
  , testProperty "t_charFullName" t_charFullName
  , testProperty "t_charName" t_charName
  , testProperty "t_combiningClass" t_combiningClass
  , testProperty "t_direction" $ t_direction
--, testProperty "t_property" t_property
  , testProperty "t_isMirrored" t_isMirrored
  , testProperty "t_mirror" t_mirror
  , testProperty "t_digitToInt" t_digitToInt
  , testProperty "t_numericValue" t_numericValue
  , testProperty "t_spoofable" t_spoofable
  , testProperty "t_nonspoofable" t_nonspoofable
  , testProperty "t_confusable" t_confusable
  , testProperty "t_Utf8IsUtf8" t_Utf8IsUtf8
  ]

testCases :: Test
testCases =
  testGroup "Test cases" $ hUnitTestToTests $ Test.HUnit.TestList $
  [I.normalize NFC "Ame\x0301lie" ~?= "Amélie"
  ,I.normalize NFC "(⊃｡•́︵•̀｡)⊃" ~?= "(⊃｡•́︵•̀｡)⊃"
  ,map I.brkBreak (I.breaks (I.breakWord (Locale "en_US")) "Hi, Amélie!")
     ~?= ["Hi",","," ","Amélie","!"]
  ,map I.brkBreak (I.breaksRight (I.breakLine (Locale "ru")) "Привет, мир!")
     ~?= ["мир!","Привет, "]
  ,(I.unfold I.group <$> I.findAll "[abc]+" "xx b yy ac") ~?= [["b"],["ac"]]
  ,I.toUpper (Locale "de-DE") "ß" ~?= "SS"
  ,I.toCaseFold False "flag" ~?= "flag"
  ,map I.blockCode ['\x1FA50', '\203257', '\73494']
     `oneOf`
     [[I.ChessSymbols, I.CjkUnifiedIdeographsExtensionH, I.Kawi]
     ,[I.ChessSymbols, I.NoBlock, I.NoBlock]
      -- ICU < 72 does not have last two codes
     ]
  ,I.direction '\x2068' ~?= I.FirstStrongIsolate
  ,I.getSkeleton I.spoof Nothing "\1089\1072t" ~?= "cat"
  ,S.shapeArabic [S.LettersShape] (nosp "ا ب ت ث") ~?= (nosp "ﺍ ﺑ ﺘ ﺚ")
  ,BiDi.reorderParagraphs [] (nosp "abc ا ب ت ث def\n123")
     ~?= ["abc" <> T.reverse (nosp "ا ب ت ث") <> "def\n", "123"]
  ,N.formatNumber (N.numberFormatter N.NUM_CURRENCY_PLURAL "en_US")
     (12.5 :: Double) ~?= "12.50 US dollars"

  ,do
     dfDe <- I.standardDateFormatter I.MediumFormatStyle I.LongFormatStyle
       (Locale "de_DE") ""
     c <- cal "CET" 2000 00 01 02 03 00
     return $ I.formatCalendar dfDe (Cal.add c [(Cal.Hour, 25), (Cal.Second, 65)])
   `ioEq`
    "2. Januar 2000 um 03:04:05"

  ,do
     dfAt <- I.standardDateFormatter I.LongFormatStyle I.LongFormatStyle
       (Locale "de_AT") "CET"
     return $ I.dateSymbols dfAt I.Months
   `ioEq`
   ["Jänner","Februar","März","April","Mai","Juni"
   ,"Juli","August","September","Oktober","November","Dezember"]

  ,do
     dfP <- I.patternDateFormatter
       "MMMM dd, yyyy GGGG, hh 'o''clock' a, VVVV" (Locale "en_US") ""
     c <- cal "America/Los_Angeles" 2000 00 02 03 04 05
     return $ I.formatCalendar dfP c
   `ioEq`
    "January 02, 2000 Anno Domini, 03 o'clock AM, Los Angeles Time"

  ,(flip Cal.getField Cal.Year =<< cal "UTC" 1999 01 02 03 04 05) `ioEq` 1999

  ,(elem "en_US" <$> I.availableLocales) `ioEq` True

  ,(flip I.formatIntegral (12345 :: Int)
    <$> I.numberFormatter "precision-integer" (Locale "fr"))
   `ioEq` "12\8239\&345"

  ,(flip I.formatDouble 12345.6789
    <$> I.numberFormatter "precision-currency-cash currency/EUR" (Locale "it"))
   `ioEq` "12.345,68\160€"

  , Test.HUnit.TestLabel "collate" testCases_collate

  ]
  <>
  concat
  [conv "ISO-2022-CN" "程序設計"  "\ESC$)A\SO3LPr\ESC$)G]CSS\SI"
  ,conv "cp1251" "Привет, мир!"  "\207\240\232\226\229\242, \236\232\240!"
  ]
  where conv n f t = [I.fromUnicode c f ~?= t, I.toUnicode c t ~?= f]
            where c = converter n
        nosp = T.filter (/= ' ')
        cal tz y m d h mn s = do
            c <- Cal.calendar tz (Locale "en_US") Cal.TraditionalCalendarType
            Cal.setDateTime c y m d h mn s
            return c
        ioEq io a = Test.HUnit.TestCase $ do
            x <- io
            x @?= a
        oneOf actual expected = Test.HUnit.TestCase $
          unless (actual `elem` expected) $
            E.throwIO $ HUnitFailure Nothing $ ExpectedButGot Nothing
              (unlines $ "one of:" : map show expected) (show actual)

testCases_collate :: Test.HUnit.Test
testCases_collate = Test.HUnit.TestList $
  [ Test.HUnit.TestLabel "invalid format" $
    assertParseError (I.collatorFromRules "& a < <") Err.u_INVALID_FORMAT_ERROR (Just 0) (Just 4)
  , Test.HUnit.TestLabel "custom collator" $ Test.HUnit.TestCase $ do
      let c = either (error "Can’t create b<a collator") id
              $ I.collatorFromRules "& b < a"
      I.collate c "a" "b" @?= GT
  ]
  where
    assertParseError (Left e) err line offset = Test.HUnit.TestList
      [ "errError" ~: errError e ~?= err
      , "errLine" ~: errLine e ~?= line
      , "errOffset" ~: errOffset e ~?= offset
      ]
    assertParseError (Right _) _ _ _ = Test.HUnit.TestCase $ Test.HUnit.assertFailure "Expects a Left"