mirror of
https://github.com/facebook/duckling.git
synced 2024-12-02 22:46:17 +03:00
a3b35880e5
Summary: Modified `Entity` to use the new `ResolvedVal` data type. Other changes follow naturally. Related issues: https://github.com/facebook/duckling/issues/121 and https://github.com/facebook/duckling/issues/172 Now one can pattern match on the output value, for instance: ``` {-# LANGUAGE GADTs #-} import Data.Text import Duckling.Core import Duckling.Testing.Types import qualified Duckling.PhoneNumber.Types as PN parsePhoneNumber :: Text -> Text parsePhoneNumber input = case value entity of (RVal PhoneNumber (PN.PhoneNumberValue v)) -> v where (entity:_) = parse input testContext testOptions [This PhoneNumber] ``` Reviewed By: patapizza Differential Revision: D7502020 fbshipit-source-id: 76ba7b315cfd0d2c61ff95c855b7c95efc0a401c
80 lines
2.7 KiB
Haskell
80 lines
2.7 KiB
Haskell
-- 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. An additional grant
|
|
-- of patent rights can be found in the PATENTS file in the same directory.
|
|
|
|
|
|
{-# 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 d g ctx = datetimeIntervalHolidayHelper (d, Nothing) g Nothing ctx
|
|
|
|
datetimeHoliday :: Datetime -> Grain -> Text -> Context -> TimeValue
|
|
datetimeHoliday d g h ctx =
|
|
datetimeIntervalHolidayHelper (d, Nothing) g (Just h) ctx
|
|
|
|
datetimeInterval :: (Datetime, Datetime) -> Grain -> Context -> TimeValue
|
|
datetimeInterval (d1, d2) g ctx =
|
|
datetimeIntervalHolidayHelper (d1, Just d2) g Nothing ctx
|
|
|
|
datetimeIntervalHoliday ::
|
|
(Datetime, Datetime) -> Grain -> Text -> Context -> TimeValue
|
|
datetimeIntervalHoliday (d1, d2) g h ctx =
|
|
datetimeIntervalHolidayHelper (d1, Just d2) g (Just h) ctx
|
|
|
|
datetimeIntervalHolidayHelper ::
|
|
(Datetime, Maybe Datetime) -> Grain -> Maybe Text -> Context -> TimeValue
|
|
datetimeIntervalHolidayHelper (d1, md2) g hol ctx = TimeValue tv [tv] hol
|
|
where
|
|
DucklingTime (Series.ZoneSeriesTime _ tzSeries) = referenceTime ctx
|
|
tv = timeValue tzSeries TimeObject {start = dt d1, end = d, grain = g}
|
|
d = case md2 of
|
|
Nothing -> Nothing
|
|
Just d2 -> Just $ dt d2
|
|
|
|
datetimeOpenInterval
|
|
:: IntervalDirection -> Datetime -> Grain -> Context -> TimeValue
|
|
datetimeOpenInterval dir d g ctx = TimeValue tv [tv] Nothing
|
|
where
|
|
DucklingTime (Series.ZoneSeriesTime _ tzSeries) = referenceTime ctx
|
|
tv = openInterval tzSeries dir TimeObject
|
|
{start = dt d, end = Nothing, grain = g}
|
|
|
|
|
|
check :: ToJSON a => (Context -> a) -> TestPredicate
|
|
check f context Resolved{rval = RVal _ v} = case toJSON v of
|
|
Object o -> deleteValues (toJSON (f context)) == deleteValues (Object o)
|
|
_ -> False
|
|
where
|
|
deleteValues :: Value -> Value
|
|
deleteValues (Object o) = Object $ H.delete "values" o
|
|
deleteValues _ = Object H.empty
|
|
|
|
examples :: ToJSON a => (Context -> a) -> [Text] -> [Example]
|
|
examples f = examplesCustom (check f)
|