Tests.hs

-- 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.
         ]