-- 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 NoRebindableSyntax #-}
{-# LANGUAGE TupleSections #-}

module Duckling.Testing.Types
  ( Corpus
  , Datetime
  , Example
  , NegativeCorpus
  , TestPredicate
  , dt
  , examples
  , examplesCustom
  , parserCheck
  , refTime
  , simpleCheck
  , testContext
  , testOptions
  , withLocale
  , zTime
  ) where

import Data.Aeson (toJSON, ToJSON, Value)
import Data.Fixed (Pico)
import Data.Text (Text)
import Prelude
import qualified Data.Time as Time

import Duckling.Core
import Duckling.Resolve
import Duckling.Types

type TestPredicate = Context -> ResolvedToken -> Bool
type Example = (Text, TestPredicate)
type Corpus = (Context, Options, [Example])
type NegativeCorpus = (Context, Options, [Text])

examplesCustom :: TestPredicate -> [Text] -> [Example]
examplesCustom :: TestPredicate -> [Text] -> [Example]
examplesCustom TestPredicate
check = (Text -> Example) -> [Text] -> [Example]
forall a b. (a -> b) -> [a] -> [b]
map (, TestPredicate
check)

simpleCheck :: ToJSON a => a -> TestPredicate
simpleCheck :: a -> TestPredicate
simpleCheck a
json Context
_ Resolved{rval :: ResolvedToken -> ResolvedVal
rval = RVal Dimension a
_ ResolvedValue a
v} = a -> Value
forall a. ToJSON a => a -> Value
toJSON a
json Value -> Value -> Bool
forall a. Eq a => a -> a -> Bool
== ResolvedValue a -> Value
forall a. ToJSON a => a -> Value
toJSON ResolvedValue a
v

parserCheck :: Eq a => a -> (Value -> Maybe a) -> TestPredicate
parserCheck :: a -> (Value -> Maybe a) -> TestPredicate
parserCheck a
expected Value -> Maybe a
parse Context
_ Resolved{rval :: ResolvedToken -> ResolvedVal
rval = RVal Dimension a
_ ResolvedValue a
v} =
  Bool -> (a -> Bool) -> Maybe a -> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
False (a
expected a -> a -> Bool
forall a. Eq a => a -> a -> Bool
==) (Maybe a -> Bool) -> Maybe a -> Bool
forall a b. (a -> b) -> a -> b
$ Value -> Maybe a
parse (ResolvedValue a -> Value
forall a. ToJSON a => a -> Value
toJSON ResolvedValue a
v)

examples :: ToJSON a => a -> [Text] -> [Example]
examples :: a -> [Text] -> [Example]
examples a
output = TestPredicate -> [Text] -> [Example]
examplesCustom (a -> TestPredicate
forall a. ToJSON a => a -> TestPredicate
simpleCheck a
output)

type Datetime = (Integer, Int, Int, Int, Int, Pico)

dt :: Datetime -> Time.UTCTime
dt :: Datetime -> UTCTime
dt (Integer
year, Int
month, Int
days, Int
hours, Int
minutes, Pico
seconds) = Day -> DiffTime -> UTCTime
Time.UTCTime Day
day DiffTime
diffTime
  where
    day :: Day
day = Integer -> Int -> Int -> Day
Time.fromGregorian Integer
year Int
month Int
days
    diffTime :: DiffTime
diffTime = TimeOfDay -> DiffTime
Time.timeOfDayToTime (TimeOfDay -> DiffTime) -> TimeOfDay -> DiffTime
forall a b. (a -> b) -> a -> b
$ Int -> Int -> Pico -> TimeOfDay
Time.TimeOfDay Int
hours Int
minutes Pico
seconds

zTime :: Datetime -> Int -> Time.ZonedTime
zTime :: Datetime -> Int -> ZonedTime
zTime Datetime
datetime Int
offset = UTCTime -> TimeZone -> ZonedTime
fromUTC (Datetime -> UTCTime
dt Datetime
datetime) (TimeZone -> ZonedTime) -> TimeZone -> ZonedTime
forall a b. (a -> b) -> a -> b
$ Int -> TimeZone
Time.hoursToTimeZone Int
offset

refTime :: Datetime -> Int -> DucklingTime
refTime :: Datetime -> Int -> DucklingTime
refTime Datetime
datetime Int
offset = ZonedTime -> DucklingTime
fromZonedTime (ZonedTime -> DucklingTime) -> ZonedTime -> DucklingTime
forall a b. (a -> b) -> a -> b
$ Datetime -> Int -> ZonedTime
zTime Datetime
datetime Int
offset

-- Tuesday Feb 12, 2013 at 4:30am is the "now" for the tests
testContext :: Context
testContext :: Context
testContext = Context :: DucklingTime -> Locale -> Context
Context
  { locale :: Locale
locale = Lang -> Maybe Region -> Locale
makeLocale Lang
EN Maybe Region
forall a. Maybe a
Nothing
  , referenceTime :: DucklingTime
referenceTime = Datetime -> Int -> DucklingTime
refTime (Integer
2013, Int
2, Int
12, Int
4, Int
30, Pico
0) (-Int
2)
  }

testOptions :: Options
testOptions :: Options
testOptions = Options :: Bool -> Options
Options
  { withLatent :: Bool
withLatent = Bool
False
  }

withLocale :: (Context, Options, [a]) -> Locale -> [a]
  -> (Context, Options, [a])
withLocale :: (Context, Options, [a]) -> Locale -> [a] -> (Context, Options, [a])
withLocale (Context
langContext, Options
options, [a]
langXs) Locale
locale [a]
localeXs
  = (Context
langContext {locale :: Locale
locale = Locale
locale}, Options
options, [a]
langXs [a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
++ [a]
localeXs)