-- 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 #-}

module Duckling.Duration.EN.Corpus
  ( corpus
  , negativeCorpus
  ) where

import Prelude
import Data.String

import Duckling.Duration.Types
import Duckling.Testing.Types
import Duckling.TimeGrain.Types (Grain(..))

corpus :: Corpus
corpus :: Corpus
corpus = (Context
testContext, Options
testOptions, [Example]
allExamples)

negativeCorpus :: NegativeCorpus
negativeCorpus :: NegativeCorpus
negativeCorpus = (Context
testContext, Options
testOptions, [Text]
examples)
  where
    examples :: [Text]
examples =
      [ Text
"for months"
      , Text
"in days"
      , Text
"secretary"
      , Text
"minutes"
      , Text
"I second that"
      ]

allExamples :: [Example]
allExamples :: [Example]
allExamples = [[Example]] -> [Example]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
  [ DurationData -> [Text] -> [Example]
forall a. ToJSON a => a -> [Text] -> [Example]
examples (Int -> Grain -> DurationData
DurationData Int
1 Grain
Second)
             [ Text
"one sec"
             , Text
"1 second"
             , Text
"1\""
             ]
  , DurationData -> [Text] -> [Example]
forall a. ToJSON a => a -> [Text] -> [Example]
examples (Int -> Grain -> DurationData
DurationData Int
2 Grain
Minute)
             [ Text
"2 mins"
             , Text
"two minutes"
             , Text
"2'"
             , Text
"2 more minutes"
             , Text
"two additional minutes"
             , Text
"2 extra minutes"
             , Text
"2 less minutes"
             , Text
"2 fewer minutes"
             , Text
"2m"
             , Text
"2 m"
             ]
  , DurationData -> [Text] -> [Example]
forall a. ToJSON a => a -> [Text] -> [Example]
examples (Int -> Grain -> DurationData
DurationData Int
30 Grain
Day)
             [ Text
"30 days"
             ]
  , DurationData -> [Text] -> [Example]
forall a. ToJSON a => a -> [Text] -> [Example]
examples (Int -> Grain -> DurationData
DurationData Int
7 Grain
Week)
             [ Text
"seven weeks"
             ]
  , DurationData -> [Text] -> [Example]
forall a. ToJSON a => a -> [Text] -> [Example]
examples (Int -> Grain -> DurationData
DurationData Int
1 Grain
Month)
             [ Text
"1 month"
             , Text
"a month"
             ]
  , DurationData -> [Text] -> [Example]
forall a. ToJSON a => a -> [Text] -> [Example]
examples (Int -> Grain -> DurationData
DurationData Int
3 Grain
Quarter)
             [ Text
"3 quarters"
             ]
  , DurationData -> [Text] -> [Example]
forall a. ToJSON a => a -> [Text] -> [Example]
examples (Int -> Grain -> DurationData
DurationData Int
2 Grain
Year)
             [ Text
"2 years"
             ]
  , DurationData -> [Text] -> [Example]
forall a. ToJSON a => a -> [Text] -> [Example]
examples (Int -> Grain -> DurationData
DurationData Int
30 Grain
Minute)
             [ Text
"half an hour"
             , Text
"half hour"
             , Text
"1/2 hour"
             , Text
"1/2h"
             , Text
"1/2 h"
             ]
  , DurationData -> [Text] -> [Example]
forall a. ToJSON a => a -> [Text] -> [Example]
examples (Int -> Grain -> DurationData
DurationData Int
12 Grain
Hour)
             [ Text
"half a day"
             , Text
"half day"
             , Text
"1/2 day"
             ]
  , DurationData -> [Text] -> [Example]
forall a. ToJSON a => a -> [Text] -> [Example]
examples (Int -> Grain -> DurationData
DurationData Int
90 Grain
Minute)
             [ Text
"an hour and a half"
             , Text
"one hour and half"
             , Text
"1 hour thirty"
             , Text
"1 hour and thirty"
             , Text
"1.5 hours"
             , Text
"1.5 hrs"
             , Text
"one and two quarter hour"
             , Text
"one and two quarters hour"
             , Text
"one and two quarter of hour"
             , Text
"one and two quarters of hour"
             ]
  , DurationData -> [Text] -> [Example]
forall a. ToJSON a => a -> [Text] -> [Example]
examples (Int -> Grain -> DurationData
DurationData Int
75 Grain
Minute)
             [ Text
"1 hour fifteen"
             , Text
"1 hour and fifteen"
             , Text
"one and quarter hour"
             , Text
"one and a quarter hour"
             , Text
"one and one quarter hour"
             , Text
"one and quarter of hour"
             , Text
"one and a quarter of hour"
             , Text
"one and one quarter of hour"
             ]
  , DurationData -> [Text] -> [Example]
forall a. ToJSON a => a -> [Text] -> [Example]
examples (Int -> Grain -> DurationData
DurationData Int
130 Grain
Minute)
             [ Text
"2 hours ten"
             , Text
"2 hour and 10"
             ]
  , DurationData -> [Text] -> [Example]
forall a. ToJSON a => a -> [Text] -> [Example]
examples (Int -> Grain -> DurationData
DurationData Int
3615 Grain
Second)
             [ Text
"1 hour fifteen seconds"
             , Text
"1 hour and fifteen seconds"
             ]
  , DurationData -> [Text] -> [Example]
forall a. ToJSON a => a -> [Text] -> [Example]
examples (Int -> Grain -> DurationData
DurationData Int
45 Grain
Day)
             [ Text
"a month and a half"
             , Text
"one month and half"
             ]
  , DurationData -> [Text] -> [Example]
forall a. ToJSON a => a -> [Text] -> [Example]
examples (Int -> Grain -> DurationData
DurationData Int
27 Grain
Month)
             [ Text
"2 years and 3 months"
             , Text
"2 years, 3 months"
             , Text
"2 years 3 months"
             ]
  , DurationData -> [Text] -> [Example]
forall a. ToJSON a => a -> [Text] -> [Example]
examples (Int -> Grain -> DurationData
DurationData Int
31719604 Grain
Second)
             [ Text
"1 year, 2 days, 3 hours and 4 seconds"
             , Text
"1 year 2 days 3 hours and 4 seconds"
               -- Oxford comma not supported:
--           , "1 year, 2 days, 3 hours, and 4 seconds"
             ]
  , DurationData -> [Text] -> [Example]
forall a. ToJSON a => a -> [Text] -> [Example]
examples (Int -> Grain -> DurationData
DurationData Int
330 Grain
Second)
             [ Text
"5 and a half minutes"
             , Text
"five and half min"
             , Text
"5 and an half minute"
             ]
  , DurationData -> [Text] -> [Example]
forall a. ToJSON a => a -> [Text] -> [Example]
examples (Int -> Grain -> DurationData
DurationData Int
105 Grain
Minute)
              [ Text
"one and three quarter hour"
              , Text
"one and three quarters hour"
              , Text
"one and three quarter of hour"
              , Text
"one and three quarters of hour"
              , Text
"one and three quarter of hours"
              , Text
"one and three quarters of hours"
              ]
  , DurationData -> [Text] -> [Example]
forall a. ToJSON a => a -> [Text] -> [Example]
examples (Int -> Grain -> DurationData
DurationData Int
135 Grain
Minute)
             [ Text
"two and quarter hour"
             , Text
"two and a quarter of hour"
             , Text
"two and quarter of hours"
             , Text
"two and a quarter of hours"
             ]
  , DurationData -> [Text] -> [Example]
forall a. ToJSON a => a -> [Text] -> [Example]
examples (Int -> Grain -> DurationData
DurationData Int
105 Grain
Minute)
              [ Text
"an hour and 45 minutes"
              , Text
"one hour and 45 minutes"
              ]
  , DurationData -> [Text] -> [Example]
forall a. ToJSON a => a -> [Text] -> [Example]
examples (Int -> Grain -> DurationData
DurationData Int
90 Grain
Second)
              [ Text
"a minute and 30 seconds"
              , Text
"one minute and 30 seconds"
              ]
  , DurationData -> [Text] -> [Example]
forall a. ToJSON a => a -> [Text] -> [Example]
examples (Int -> Grain -> DurationData
DurationData Int
3630 Grain
Second)
              [ Text
"an hour and 30 seconds"]
  , DurationData -> [Text] -> [Example]
forall a. ToJSON a => a -> [Text] -> [Example]
examples (Int -> Grain -> DurationData
DurationData Int
930 Grain
Second)
              [ Text
"15.5 minutes"
              , Text
"15.5 minute"
              , Text
"15.5 mins"
              , Text
"15.5 min"
              ]
  ]