-- 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 NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}

module Duckling.Time.Corpus
  ( datetime
  , datetimeHoliday
  , datetimeInterval
  , datetimeIntervalHoliday
  , datetimeOpenInterval
  , examples
  ) where

import Data.Aeson
import qualified Data.HashMap.Strict as H
import Data.Text (Text)
import qualified Data.Time.LocalTime.TimeZone.Series as Series
import Prelude
import Data.String

import Duckling.Resolve
import Duckling.Testing.Types hiding (examples)
import Duckling.Time.Types hiding (Month)
import Duckling.TimeGrain.Types hiding (add)
import Duckling.Types hiding (Entity(..))

datetime :: Datetime -> Grain -> Context -> TimeValue
datetime :: Datetime -> Grain -> Context -> TimeValue
datetime Datetime
d Grain
g Context
ctx = (Datetime, Maybe Datetime)
-> Grain -> Maybe Text -> Context -> TimeValue
datetimeIntervalHolidayHelper (Datetime
d, Maybe Datetime
forall a. Maybe a
Nothing) Grain
g Maybe Text
forall a. Maybe a
Nothing Context
ctx

datetimeHoliday :: Datetime -> Grain -> Text -> Context -> TimeValue
datetimeHoliday :: Datetime -> Grain -> Text -> Context -> TimeValue
datetimeHoliday Datetime
d Grain
g Text
h Context
ctx =
  (Datetime, Maybe Datetime)
-> Grain -> Maybe Text -> Context -> TimeValue
datetimeIntervalHolidayHelper (Datetime
d, Maybe Datetime
forall a. Maybe a
Nothing) Grain
g (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
h) Context
ctx

datetimeInterval :: (Datetime, Datetime) -> Grain -> Context -> TimeValue
datetimeInterval :: (Datetime, Datetime) -> Grain -> Context -> TimeValue
datetimeInterval (Datetime
d1, Datetime
d2) Grain
g Context
ctx =
  (Datetime, Maybe Datetime)
-> Grain -> Maybe Text -> Context -> TimeValue
datetimeIntervalHolidayHelper (Datetime
d1, Datetime -> Maybe Datetime
forall a. a -> Maybe a
Just Datetime
d2) Grain
g Maybe Text
forall a. Maybe a
Nothing Context
ctx

datetimeIntervalHoliday ::
  (Datetime, Datetime) -> Grain -> Text -> Context -> TimeValue
datetimeIntervalHoliday :: (Datetime, Datetime) -> Grain -> Text -> Context -> TimeValue
datetimeIntervalHoliday (Datetime
d1, Datetime
d2) Grain
g Text
h Context
ctx =
  (Datetime, Maybe Datetime)
-> Grain -> Maybe Text -> Context -> TimeValue
datetimeIntervalHolidayHelper (Datetime
d1, Datetime -> Maybe Datetime
forall a. a -> Maybe a
Just Datetime
d2) Grain
g (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
h) Context
ctx

datetimeIntervalHolidayHelper ::
  (Datetime, Maybe Datetime) -> Grain -> Maybe Text -> Context -> TimeValue
datetimeIntervalHolidayHelper :: (Datetime, Maybe Datetime)
-> Grain -> Maybe Text -> Context -> TimeValue
datetimeIntervalHolidayHelper (Datetime
d1, Maybe Datetime
md2) Grain
g Maybe Text
hol Context
ctx = SingleTimeValue -> [SingleTimeValue] -> Maybe Text -> TimeValue
TimeValue SingleTimeValue
tv [SingleTimeValue
tv] Maybe Text
hol
  where
    DucklingTime (Series.ZoneSeriesTime UTCTime
_ TimeZoneSeries
tzSeries) = Context -> DucklingTime
referenceTime Context
ctx
    tv :: SingleTimeValue
tv = TimeZoneSeries -> TimeObject -> SingleTimeValue
timeValue TimeZoneSeries
tzSeries TimeObject :: UTCTime -> Grain -> Maybe UTCTime -> TimeObject
TimeObject {start :: UTCTime
start = Datetime -> UTCTime
dt Datetime
d1, end :: Maybe UTCTime
end = Maybe UTCTime
d, grain :: Grain
grain = Grain
g}
    d :: Maybe UTCTime
d = case Maybe Datetime
md2 of
      Maybe Datetime
Nothing -> Maybe UTCTime
forall a. Maybe a
Nothing
      Just Datetime
d2 -> UTCTime -> Maybe UTCTime
forall a. a -> Maybe a
Just (UTCTime -> Maybe UTCTime) -> UTCTime -> Maybe UTCTime
forall a b. (a -> b) -> a -> b
$ Datetime -> UTCTime
dt Datetime
d2

datetimeOpenInterval
  :: IntervalDirection -> Datetime -> Grain -> Context -> TimeValue
datetimeOpenInterval :: IntervalDirection -> Datetime -> Grain -> Context -> TimeValue
datetimeOpenInterval IntervalDirection
dir Datetime
d Grain
g Context
ctx = SingleTimeValue -> [SingleTimeValue] -> Maybe Text -> TimeValue
TimeValue SingleTimeValue
tv [SingleTimeValue
tv] Maybe Text
forall a. Maybe a
Nothing
  where
    DucklingTime (Series.ZoneSeriesTime UTCTime
_ TimeZoneSeries
tzSeries) = Context -> DucklingTime
referenceTime Context
ctx
    tv :: SingleTimeValue
tv = TimeZoneSeries
-> IntervalDirection -> TimeObject -> SingleTimeValue
openInterval TimeZoneSeries
tzSeries IntervalDirection
dir TimeObject :: UTCTime -> Grain -> Maybe UTCTime -> TimeObject
TimeObject
      {start :: UTCTime
start = Datetime -> UTCTime
dt Datetime
d, end :: Maybe UTCTime
end = Maybe UTCTime
forall a. Maybe a
Nothing, grain :: Grain
grain = Grain
g}


check :: ToJSON a => (Context -> a) -> TestPredicate
check :: (Context -> a) -> TestPredicate
check Context -> a
f Context
context Resolved{rval :: ResolvedToken -> ResolvedVal
rval = RVal Dimension a
_ ResolvedValue a
v} = case ResolvedValue a -> Value
forall a. ToJSON a => a -> Value
toJSON ResolvedValue a
v of
  Object Object
o -> Value -> Value
deleteValues (a -> Value
forall a. ToJSON a => a -> Value
toJSON (Context -> a
f Context
context)) Value -> Value -> Bool
forall a. Eq a => a -> a -> Bool
== Value -> Value
deleteValues (Object -> Value
Object Object
o)
  Value
_ -> Bool
False
  where
    deleteValues :: Value -> Value
    deleteValues :: Value -> Value
deleteValues (Object Object
o) = Object -> Value
Object (Object -> Value) -> Object -> Value
forall a b. (a -> b) -> a -> b
$ Text -> Object -> Object
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> HashMap k v
H.delete Text
"values" Object
o
    deleteValues Value
_ = Object -> Value
Object Object
forall k v. HashMap k v
H.empty

examples :: ToJSON a => (Context -> a) -> [Text] -> [Example]
examples :: (Context -> a) -> [Text] -> [Example]
examples Context -> a
f = TestPredicate -> [Text] -> [Example]
examplesCustom ((Context -> a) -> TestPredicate
forall a. ToJSON a => (Context -> a) -> TestPredicate
check Context -> a
f)