content: -- Copyright (c) 2016-present, Facebook, Inc.
  -- All rights reserved.
  --
  -- This source code is licensed under the BSD-style license found in the
  -- LICENSE file in the root directory of this source tree.
  
  
  {-# LANGUAGE OverloadedStrings #-}
  {-# LANGUAGE TupleSections #-}
  
  module Duckling.Time.EN.Tests
    ( tests
    ) where
  
  import Data.Aeson
  import Data.Aeson.Types ((.:), parseMaybe, withObject)
  import Data.String
  import Prelude
  import Test.Tasty
  import Test.Tasty.HUnit
  
  import Duckling.Dimensions.Types
  import Duckling.Locale
  import Duckling.Resolve
  import Duckling.Testing.Asserts
  import Duckling.Testing.Types hiding (examples)
  import Duckling.Time.Corpus
  import Duckling.Time.EN.Corpus
  import Duckling.TimeGrain.Types (Grain(..))
  import Duckling.Types (Range(..))
  import qualified Duckling.Region as R
  import qualified Duckling.Time.EN.AU.Corpus as AU
  import qualified Duckling.Time.EN.BZ.Corpus as BZ
  import qualified Duckling.Time.EN.CA.Corpus as CA
  import qualified Duckling.Time.EN.GB.Corpus as GB
  import qualified Duckling.Time.EN.IE.Corpus as IE
  import qualified Duckling.Time.EN.IN.Corpus as IN
  import qualified Duckling.Time.EN.JM.Corpus as JM
  import qualified Duckling.Time.EN.NZ.Corpus as NZ
  import qualified Duckling.Time.EN.PH.Corpus as PH
  import qualified Duckling.Time.EN.TT.Corpus as TT
  import qualified Duckling.Time.EN.US.Corpus as US
  import qualified Duckling.Time.EN.ZA.Corpus as ZA
  
  tests :: TestTree
  tests = testGroup "EN Tests"
    [ makeCorpusTest [Seal Time] defaultCorpus
    , makeNegativeCorpusTest [Seal Time] negativeCorpus
    , makeCorpusTest [Seal Time] diffCorpus
    , exactSecondTests
    , valuesTest
    , intersectTests
    , rangeTests
    , localeTests
    , makeCorpusTest [Seal Time] latentCorpus
    ]
  
  localeTests :: TestTree
  localeTests = testGroup "Locale Tests"
    [ testGroup "EN_AU Tests"
      [ makeCorpusTest [Seal Time] $ withLocale corpus localeAU AU.allExamples
      , makeNegativeCorpusTest [Seal Time] $ withLocale negativeCorpus localeAU []
      ]
    , testGroup "EN_BZ Tests"
      [ makeCorpusTest [Seal Time] $ withLocale corpus localeBZ BZ.allExamples
      , makeNegativeCorpusTest [Seal Time] $ withLocale negativeCorpus localeBZ []
      ]
    , testGroup "EN_CA Tests"
      [ makeCorpusTest [Seal Time] $ withLocale corpus localeCA CA.allExamples
      , makeNegativeCorpusTest [Seal Time] $ withLocale negativeCorpus localeCA []
      ]
    , testGroup "EN_GB Tests"
      [ makeCorpusTest [Seal Time] $ withLocale corpus localeGB GB.allExamples
      , makeNegativeCorpusTest [Seal Time] $ withLocale negativeCorpus localeGB []
      ]
    , testGroup "EN_IE Tests"
      [ makeCorpusTest [Seal Time] $ withLocale corpus localeIE IE.allExamples
      , makeNegativeCorpusTest [Seal Time] $ withLocale negativeCorpus localeIE []
      ]
    , testGroup "EN_IN Tests"
      [ makeCorpusTest [Seal Time] $ withLocale corpus localeIN IN.allExamples
      , makeNegativeCorpusTest [Seal Time] $ withLocale negativeCorpus localeIN []
      ]
    , testGroup "EN_JM Tests"
      [ makeCorpusTest [Seal Time] $ withLocale corpus localeJM JM.allExamples
      , makeNegativeCorpusTest [Seal Time] $ withLocale negativeCorpus localeJM []
      ]
    , testGroup "EN_NZ Tests"
      [ makeCorpusTest [Seal Time] $ withLocale corpus localeNZ NZ.allExamples
      , makeNegativeCorpusTest [Seal Time] $ withLocale negativeCorpus localeNZ []
      ]
    , testGroup "EN_PH Tests"
      [ makeCorpusTest [Seal Time] $ withLocale corpus localePH PH.allExamples
      , makeNegativeCorpusTest [Seal Time] $ withLocale negativeCorpus localePH []
      ]
    , testGroup "EN_TT Tests"
      [ makeCorpusTest [Seal Time] $ withLocale corpus localeTT TT.allExamples
      , makeNegativeCorpusTest [Seal Time] $ withLocale negativeCorpus localeTT []
      ]
    , testGroup "EN_US Tests"
      [ makeCorpusTest [Seal Time] $ withLocale corpus localeUS US.allExamples
      , makeNegativeCorpusTest [Seal Time] $ withLocale negativeCorpus localeUS []
      ]
    , testGroup "EN_ZA Tests"
      [ makeCorpusTest [Seal Time] $ withLocale corpus localeZA ZA.allExamples
      , makeNegativeCorpusTest [Seal Time] $ withLocale negativeCorpus localeZA []
      ]
    ]
    where
      localeAU = makeLocale EN $ Just AU
      localeBZ = makeLocale EN $ Just BZ
      localeCA = makeLocale EN $ Just R.CA
      localeGB = makeLocale EN $ Just GB
      localeIE = makeLocale EN $ Just IE
      localeIN = makeLocale EN $ Just IN
      localeJM = makeLocale EN $ Just JM
      localeNZ = makeLocale EN $ Just NZ
      localePH = makeLocale EN $ Just PH
      localeTT = makeLocale EN $ Just TT
      localeUS = makeLocale EN $ Just US
      localeZA = makeLocale EN $ Just ZA
  
  exactSecondTests :: TestTree
  exactSecondTests = testCase "Exact Second Tests" $
    mapM_ (analyzedFirstTest context testOptions . withTargets [Seal Time]) xs
    where
      context = testContext {referenceTime = refTime (2016, 12, 6, 13, 21, 42) 1}
      xs = concat
        [ examples (datetime (2016, 12, 6, 13, 21, 45) Second)
                   [ "in 3 seconds"
                   ]
        , examples (datetime (2016, 12, 6, 13, 31, 42) Second)
                   [ "in ten minutes"
                   ]
        , examples (datetimeInterval
            ((2016, 12, 6, 13, 21, 42), (2016, 12, 12, 0, 0, 0)) Second)
                   [ "by next week"
                   , "by Monday"
                   ]
        ]
  
  valuesTest :: TestTree
  valuesTest = testCase "Values Test" $
    mapM_ (analyzedFirstTest testContext testOptions . withTargets [Seal Time]) xs
    where
      xs = examplesCustom (parserCheck 1 parseValuesSize)
                          [ "now"
                          , "8 o'clock tonight"
                          , "yesterday"
                          ]
      parseValuesSize :: Value -> Maybe Int
      parseValuesSize x = length <$> parseValues x
      parseValues :: Value -> Maybe [Object]
      parseValues = parseMaybe $ withObject "value object" (.: "values")
  
  intersectTests :: TestTree
  intersectTests = testCase "Intersect Test" $
    mapM_ (analyzedNTest testContext testOptions . withTargets [Seal Time]) xs
    where
      xs = [ ("tomorrow July", 2)
           , ("Mar tonight", 2)
           , ("Feb tomorrow", 1) -- we are in February
           ]
  
  rangeTests :: TestTree
  rangeTests = testCase "Range Test" $
    mapM_ (analyzedRangeTest testContext testOptions . withTargets [Seal Time]) xs
    where
      xs = [ ("at 615.", Range 0 6) -- make sure ruleHHMMLatent allows this
           , ("last in 2'", Range 5 10) -- ruleLastTime too eager
           , ("this in 2'", Range 5 10) -- ruleThisTime too eager
           , ("next in 2'", Range 5 10) -- ruleNextTime too eager
           , ("this this week", Range 5 14) -- ruleThisTime too eager
           , ("one ninety nine a m", Range 11 19) -- ruleMilitarySpelledOutAMPM2
           , ("thirteen fifty nine a m", Range 15 23) -- ruleMilitarySpelledOutAMPM
           , ("table Wednesday for 30 people", Range 6 15)
             -- do not parse "for 30" as year intersect
           , ("house 1 on december 2013", Range 11 24) -- ruleAbsorbOnDay
           , ("at 6pm GMT PDT", Range 0 10) -- ruleTimezone
           , ("at 6pm (PDT) GMT", Range 0 12) -- ruleTimezoneBracket
           , ("6pm GMT - 8pm GMT PDT", Range 0 17)
             -- ruleTimezone will not match because TimeData hasTimezone.
           , ("Monday - 1", Range 0 6) -- ruleYearLatent to not accept negative years.
           ]
  