-- 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.Time.EN.Corpus
  ( corpus
  , defaultCorpus
  , negativeCorpus
  , latentCorpus
  , diffCorpus
  ) where

import Data.String
import Prelude

import Duckling.Core
import Duckling.Testing.Types hiding (examples)
import Duckling.Time.Corpus
import Duckling.Time.Types hiding (Month, refTime)
import Duckling.TimeGrain.Types hiding (add)

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

defaultCorpus :: Corpus
defaultCorpus :: Corpus
defaultCorpus = (Context
testContext, Options
testOptions, [Example]
allExamples [Example] -> [Example] -> [Example]
forall a. [a] -> [a] -> [a]
++ [Example]
custom)
  where
    custom :: [Example]
custom = [[Example]] -> [Example]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
      [ (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples (Datetime -> Grain -> Context -> TimeValue
datetime (Integer
2013, Int
2, Int
15, Int
0, Int
0, Pico
0) Grain
Day)
                 [ Text
"2/15"
                 , Text
"on 2/15"
                 , Text
"2 / 15"
                 , Text
"2-15"
                 , Text
"2 - 15"
                 ]
      , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples (Datetime -> Grain -> Context -> TimeValue
datetime (Integer
1974, Int
10, Int
31, Int
0, Int
0, Pico
0) Grain
Day)
                 [ Text
"10/31/1974"
                 , Text
"10/31/74"
                 , Text
"10-31-74"
                 , Text
"10.31.1974"
                 , Text
"31/Oct/1974"
                 , Text
"31-Oct-74"
                 , Text
"31st Oct 1974"
                 ]
      , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples (Datetime -> Grain -> Context -> TimeValue
datetime (Integer
2013, Int
4, Int
25, Int
16, Int
0, Pico
0) Grain
Minute)
                 [ Text
"4/25 at 4:00pm"
                 , Text
"4/25 at 16h00"
                 , Text
"4/25 at 16h"
                 ]
      , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples (Datetime -> Grain -> Text -> Context -> TimeValue
datetimeHoliday (Integer
2013, Int
11, Int
28, Int
0, Int
0, Pico
0) Grain
Day Text
"Thanksgiving Day")
                 [ Text
"thanksgiving day"
                 , Text
"thanksgiving"
                 , Text
"thanksgiving 2013"
                 , Text
"this thanksgiving"
                 , Text
"next thanksgiving day"
                 , Text
"thanksgiving in 9 months"
                 , Text
"thanksgiving 9 months from now"
                 ]
      , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples (Datetime -> Grain -> Text -> Context -> TimeValue
datetimeHoliday (Integer
2014, Int
11, Int
27, Int
0, Int
0, Pico
0) Grain
Day Text
"Thanksgiving Day")
                 [ Text
"thanksgiving of next year"
                 , Text
"thanksgiving in a year"
                 , Text
"thanksgiving 2014"
                 ]
      , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples (Datetime -> Grain -> Text -> Context -> TimeValue
datetimeHoliday (Integer
2012, Int
11, Int
22, Int
0, Int
0, Pico
0) Grain
Day Text
"Thanksgiving Day")
                 [ Text
"last thanksgiving"
                 , Text
"thanksgiving day 2012"
                 , Text
"thanksgiving 3 months ago"
                 , Text
"thanksgiving 1 year ago"
                 ]
      , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples (Datetime -> Grain -> Text -> Context -> TimeValue
datetimeHoliday (Integer
2016, Int
11, Int
24, Int
0, Int
0, Pico
0) Grain
Day Text
"Thanksgiving Day")
                 [ Text
"thanksgiving 2016"
                 , Text
"thanksgiving in 3 years"
                 ]
      , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples (Datetime -> Grain -> Text -> Context -> TimeValue
datetimeHoliday (Integer
2017, Int
11, Int
23, Int
0, Int
0, Pico
0) Grain
Day Text
"Thanksgiving Day")
                 [ Text
"thanksgiving 2017"
                 ]
      ]

negativeCorpus :: NegativeCorpus
negativeCorpus :: NegativeCorpus
negativeCorpus = (Context
testContext, Options
testOptions, [Text]
examples)
  where
    examples :: [Text]
examples =
      [ Text
"laughing out loud"
      , Text
"1 adult"
      , Text
"we are separated"
      , Text
"25"
      , Text
"this is the one"
      , Text
"this one"
      , Text
"this past one"
      , Text
"at single"
      , Text
"at a couple of"
      , Text
"at pairs"
      , Text
"at a few"
      , Text
"at dozens"
      , Text
"single o'clock"
      , Text
"dozens o'clock"
      , Text
"Rat 6"
      , Text
"rat 6"
      , Text
"3 30"
      , Text
"three twenty"
      , Text
"at 650.650.6500"
      , Text
"at 650-650-6500"
      , Text
"two sixty a m"
      , Text
"Pay ABC 2000"
      , Text
"4a"
      , Text
"4a."
      , Text
"A4 A5"
      , Text
"palm"
      , Text
"Martin Luther King' day"
      ]

latentCorpus :: Corpus
latentCorpus :: Corpus
latentCorpus = (Context
testContext, Options
testOptions {withLatent :: Bool
withLatent = Bool
True}, [Example]
xs)
  where
    xs :: [Example]
xs = [[Example]] -> [Example]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
      [ (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples (Datetime -> Grain -> Context -> TimeValue
datetime (Integer
2013, Int
2, Int
24, Int
0, Int
0, Pico
0) Grain
Day)
                 [ Text
"the 24"
                 , Text
"On 24th"
                 ]
      , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples (Datetime -> Grain -> Context -> TimeValue
datetime (Integer
2013, Int
2, Int
12, Int
7, Int
0, Pico
0) Grain
Hour)
                 [ Text
"7"
                 , Text
"7a"
                 ]
      , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples (Datetime -> Grain -> Context -> TimeValue
datetime (Integer
2013, Int
2, Int
12, Int
19, Int
0, Pico
0) Grain
Hour)
                 [ Text
"7p"
                 ]
      , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples (Datetime -> Grain -> Context -> TimeValue
datetime (Integer
2013, Int
2, Int
12, Int
10, Int
30, Pico
0) Grain
Minute)
                 [ Text
"ten thirty"
                 ]
      , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples (Datetime -> Grain -> Context -> TimeValue
datetime (Integer
1974, Int
1, Int
1, Int
0, Int
0, Pico
0) Grain
Year)
                 [ Text
"1974"
                 ]
      , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples (Datetime -> Grain -> Context -> TimeValue
datetime (Integer
2013, Int
5, Int
1, Int
0, Int
0, Pico
0) Grain
Month)
                 [ Text
"May"
                 ]
      , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples ((Datetime, Datetime) -> Grain -> Context -> TimeValue
datetimeInterval
          ((Integer
2013, Int
2, Int
12, Int
0, Int
0, Pico
0), (Integer
2013, Int
2, Int
12, Int
12, Int
0, Pico
0)) Grain
Hour)
                 [ Text
"morning"
                 ]
      , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples ((Datetime, Datetime) -> Grain -> Context -> TimeValue
datetimeInterval
          ((Integer
2013, Int
2, Int
12, Int
12, Int
0, Pico
0), (Integer
2013, Int
2, Int
12, Int
19, Int
0, Pico
0)) Grain
Hour)
                 [ Text
"afternoon"
                 ]
      , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples ((Datetime, Datetime) -> Grain -> Context -> TimeValue
datetimeInterval
          ((Integer
2013, Int
2, Int
12, Int
18, Int
0, Pico
0), (Integer
2013, Int
2, Int
13, Int
0, Int
0, Pico
0)) Grain
Hour)
                 [ Text
"evening"
                 ]
      , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples ((Datetime, Datetime) -> Grain -> Context -> TimeValue
datetimeInterval
          ((Integer
2013, Int
2, Int
12, Int
18, Int
0, Pico
0), (Integer
2013, Int
2, Int
13, Int
0, Int
0, Pico
0)) Grain
Hour)
                 [ Text
"night"
                 ]
      , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples ((Datetime, Datetime) -> Grain -> Context -> TimeValue
datetimeInterval ((Integer
2013, Int
2, Int
12, Int
0, Int
0, Pico
0), (Integer
2013, Int
2, Int
17, Int
0, Int
0, Pico
0)) Grain
Day)
                 [ Text
"the week"
                 ]
      , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples (Datetime -> Grain -> Context -> TimeValue
datetime (Integer
2013, Int
2, Int
12, Int
12, Int
3, Pico
0) Grain
Minute)
             [  Text
"twelve zero three"
             ,  Text
"twelve o three"
             ,  Text
"twelve ou three"
             ,  Text
"twelve oh three"
             ]
      , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples ((Datetime, Datetime) -> Grain -> Context -> TimeValue
datetimeInterval ((Integer
1960, Int
1, Int
1, Int
0, Int
0, Pico
0), (Integer
1962, Int
1, Int
1, Int
0, Int
0, Pico
0)) Grain
Year)
             [ Text
"1960 - 1961"
             ]
      ]

diffContext :: Context
diffContext :: Context
diffContext = 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
15, Int
4, Int
30, Pico
0) (-Int
2)
  }

diffCorpus :: Corpus
diffCorpus :: Corpus
diffCorpus = (Context
diffContext, Options
testOptions, [Example]
diffExamples)
  where
    diffExamples :: [Example]
diffExamples =
      (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples (Datetime -> Grain -> Context -> TimeValue
datetime (Integer
2013, Int
3, Int
8, Int
0, Int
0, Pico
0) Grain
Day)
               [ Text
"3 fridays from now"
               , Text
"three fridays from now"
               ]

allExamples :: [Example]
allExamples :: [Example]
allExamples = [[Example]] -> [Example]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
  [ (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples (Datetime -> Grain -> Context -> TimeValue
datetime (Integer
2013, Int
2, Int
12, Int
4, Int
30, Pico
0) Grain
Second)
             [ Text
"now"
             , Text
"right now"
             , Text
"just now"
             , Text
"at the moment"
             , Text
"ATM"
             ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples (Datetime -> Grain -> Context -> TimeValue
datetime (Integer
2013, Int
2, Int
12, Int
0, Int
0, Pico
0) Grain
Day)
             [ Text
"today"
             , Text
"at this time"
             ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples (Datetime -> Grain -> Context -> TimeValue
datetime (Integer
2013, Int
2, Int
1, Int
0, Int
0, Pico
0) Grain
Month)
             [ Text
"2/2013"
             ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples (Datetime -> Grain -> Context -> TimeValue
datetime (Integer
2014, Int
1, Int
1, Int
0, Int
0, Pico
0) Grain
Year)
             [ Text
"in 2014"
             ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples (Datetime -> Grain -> Context -> TimeValue
datetime (Integer
2013, Int
2, Int
11, Int
0, Int
0, Pico
0) Grain
Day)
             [ Text
"yesterday"
             ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples (Datetime -> Grain -> Context -> TimeValue
datetime (Integer
2013, Int
2, Int
13, Int
0, Int
0, Pico
0) Grain
Day)
             [ Text
"tomorrow"
             , Text
"tomorrows"
             ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples (Datetime -> Grain -> Context -> TimeValue
datetime (Integer
2013, Int
2, Int
18, Int
0, Int
0, Pico
0) Grain
Day)
             [ Text
"monday"
             , Text
"mon."
             , Text
"this monday"
             , Text
"Monday, Feb 18"
             , Text
"Mon, February 18"
             ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples (Datetime -> Grain -> Context -> TimeValue
datetime (Integer
2013, Int
2, Int
19, Int
0, Int
0, Pico
0) Grain
Day)
             [ Text
"tuesday"
             , Text
"Tuesday the 19th"
             , Text
"Tuesday 19th"
             ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples (Datetime -> Grain -> Context -> TimeValue
datetime (Integer
2013, Int
8, Int
15, Int
0, Int
0, Pico
0) Grain
Day)
             [ Text
"Thu 15th"
             ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples (Datetime -> Grain -> Context -> TimeValue
datetime (Integer
2013, Int
2, Int
14, Int
0, Int
0, Pico
0) Grain
Day)
             [ Text
"thursday"
             , Text
"thu"
             , Text
"thu."
             ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples (Datetime -> Grain -> Context -> TimeValue
datetime (Integer
2013, Int
2, Int
15, Int
0, Int
0, Pico
0) Grain
Day)
             [ Text
"friday"
             , Text
"fri"
             , Text
"fri."
             ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples (Datetime -> Grain -> Context -> TimeValue
datetime (Integer
2013, Int
2, Int
16, Int
0, Int
0, Pico
0) Grain
Day)
             [ Text
"saturday"
             , Text
"sat"
             , Text
"sat."
             ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples (Datetime -> Grain -> Context -> TimeValue
datetime (Integer
2013, Int
2, Int
17, Int
0, Int
0, Pico
0) Grain
Day)
             [ Text
"sunday"
             , Text
"sun"
             , Text
"sun."
             ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples (Datetime -> Grain -> Context -> TimeValue
datetime (Integer
2013, Int
3, Int
1, Int
0, Int
0, Pico
0) Grain
Day)
             [ Text
"the 1st of march"
             , Text
"first of march"
             , Text
"the first of march"
             , Text
"march first"
             ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples (Datetime -> Grain -> Context -> TimeValue
datetime (Integer
2013, Int
3, Int
2, Int
0, Int
0, Pico
0) Grain
Day)
             [ Text
"the 2nd of march"
             , Text
"second of march"
             , Text
"the second of march"
             ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples (Datetime -> Grain -> Context -> TimeValue
datetime (Integer
2013, Int
3, Int
3, Int
0, Int
0, Pico
0) Grain
Day)
             [ Text
"march 3"
             , Text
"the third of march"
             ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples (Datetime -> Grain -> Context -> TimeValue
datetime (Integer
2013, Int
3, Int
15, Int
0, Int
0, Pico
0) Grain
Day)
             [ Text
"the ides of march"
             ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples (Datetime -> Grain -> Context -> TimeValue
datetime (Integer
2015, Int
3, Int
3, Int
0, Int
0, Pico
0) Grain
Day)
             [ Text
"march 3 2015"
             , Text
"march 3rd 2015"
             , Text
"march third 2015"
             , Text
"3/3/2015"
             , Text
"3/3/15"
             , Text
"2015-3-3"
             , Text
"2015-03-03"
             ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples (Datetime -> Grain -> Context -> TimeValue
datetime (Integer
2013, Int
2, Int
15, Int
0, Int
0, Pico
0) Grain
Day)
             [ Text
"on the 15th"
             , Text
"the 15th of february"
             , Text
"15 of february"
             , Text
"february the 15th"
             , Text
"february 15"
             , Text
"15th february"
             , Text
"February 15"
             ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples (Datetime -> Grain -> Context -> TimeValue
datetime (Integer
2013, Int
8, Int
8, Int
0, Int
0, Pico
0) Grain
Day)
             [ Text
"Aug 8"
             ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples (Datetime -> Grain -> Context -> TimeValue
datetime (Integer
2014, Int
3, Int
1, Int
0, Int
0, Pico
0) Grain
Month)
             [ Text
"March in 1 year"
             , Text
"March in a year"
             ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples (Datetime -> Grain -> Context -> TimeValue
datetime (Integer
2014, Int
7, Int
18, Int
0, Int
0, Pico
0) Grain
Day)
             [ Text
"Fri, Jul 18"
             , Text
"Jul 18, Fri"
             ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples (Datetime -> Grain -> Context -> TimeValue
datetime (Integer
2014, Int
10, Int
1, Int
0, Int
0, Pico
0) Grain
Month)
             [ Text
"October 2014"
             , Text
"2014-10"
             , Text
"2014/10"
             ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples (Datetime -> Grain -> Context -> TimeValue
datetime (Integer
2015, Int
4, Int
14, Int
0, Int
0, Pico
0) Grain
Day)
             [ Text
"14april 2015"
             , Text
"April 14, 2015"
             , Text
"14th April 15"
             ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples (Datetime -> Grain -> Context -> TimeValue
datetime (Integer
2013, Int
2, Int
19, Int
0, Int
0, Pico
0) Grain
Day)
             [ Text
"next tuesday"
             , Text
"around next tuesday"
             ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples (Datetime -> Grain -> Context -> TimeValue
datetime (Integer
2013, Int
2, Int
22, Int
0, Int
0, Pico
0) Grain
Day)
             [ Text
"friday after next"
             ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples (Datetime -> Grain -> Context -> TimeValue
datetime (Integer
2013, Int
3, Int
1, Int
0, Int
0, Pico
0) Grain
Month)
             [ Text
"next March"
             ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples (Datetime -> Grain -> Context -> TimeValue
datetime (Integer
2014, Int
3, Int
1, Int
0, Int
0, Pico
0) Grain
Month)
             [ Text
"March after next"
             ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples (Datetime -> Grain -> Context -> TimeValue
datetime (Integer
2013, Int
2, Int
10, Int
0, Int
0, Pico
0) Grain
Day)
             [ Text
"Sunday, Feb 10"
             ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples (Datetime -> Grain -> Context -> TimeValue
datetime (Integer
2013, Int
2, Int
13, Int
0, Int
0, Pico
0) Grain
Day)
             [ Text
"Wed, Feb13"
             ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples (Datetime -> Grain -> Context -> TimeValue
datetime (Integer
2013, Int
2, Int
11, Int
0, Int
0, Pico
0) Grain
Week)
             [ Text
"this week"
             , Text
"current week"
             ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples (Datetime -> Grain -> Context -> TimeValue
datetime (Integer
2013, Int
2, Int
4, Int
0, Int
0, Pico
0) Grain
Week)
             [ Text
"last week"
             , Text
"past week"
             , Text
"previous week"
             ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples (Datetime -> Grain -> Context -> TimeValue
datetime (Integer
2013, Int
2, Int
18, Int
0, Int
0, Pico
0) Grain
Week)
             [ Text
"next week"
             , Text
"the following week"
             , Text
"around next week"
             , Text
"upcoming week"
             , Text
"coming week"
             ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples (Datetime -> Grain -> Context -> TimeValue
datetime (Integer
2013, Int
1, Int
1, Int
0, Int
0, Pico
0) Grain
Month)
             [ Text
"last month"
             ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples (Datetime -> Grain -> Context -> TimeValue
datetime (Integer
2013, Int
3, Int
1, Int
0, Int
0, Pico
0) Grain
Month)
             [ Text
"next month"
             ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples (Datetime -> Grain -> Context -> TimeValue
datetime (Integer
2013, Int
3, Int
20, Int
0, Int
0, Pico
0) Grain
Day)
             [ Text
"20 of next month"
             , Text
"20th of the next month"
             , Text
"20th day of next month"
             ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples (Datetime -> Grain -> Context -> TimeValue
datetime (Integer
2013, Int
2, Int
20, Int
0, Int
0, Pico
0) Grain
Day)
             [ Text
"20th of the current month"
             , Text
"20 of this month"
             ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples (Datetime -> Grain -> Context -> TimeValue
datetime (Integer
2013, Int
1, Int
20, Int
0, Int
0, Pico
0) Grain
Day)
             [ Text
"20th of the previous month"
             ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples (Datetime -> Grain -> Context -> TimeValue
datetime (Integer
2013, Int
1, Int
1, Int
0, Int
0, Pico
0) Grain
Quarter)
             [ Text
"this quarter"
             , Text
"this qtr"
             ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples (Datetime -> Grain -> Context -> TimeValue
datetime (Integer
2013, Int
4, Int
1, Int
0, Int
0, Pico
0) Grain
Quarter)
             [ Text
"next quarter"
             , Text
"next qtr"
             ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples (Datetime -> Grain -> Context -> TimeValue
datetime (Integer
2013, Int
7, Int
1, Int
0, Int
0, Pico
0) Grain
Quarter)
             [ Text
"third quarter"
             , Text
"3rd quarter"
             , Text
"third qtr"
             , Text
"3rd qtr"
             , Text
"the 3rd qtr"
             ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples (Datetime -> Grain -> Context -> TimeValue
datetime (Integer
2018, Int
10, Int
1, Int
0, Int
0, Pico
0) Grain
Quarter)
             [ Text
"4th quarter 2018"
             , Text
"4th qtr 2018"
             , Text
"the 4th qtr of 2018"
             , Text
"18q4"
             , Text
"2018Q4"
             ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples (Datetime -> Grain -> Context -> TimeValue
datetime (Integer
2012, Int
1, Int
1, Int
0, Int
0, Pico
0) Grain
Year)
             [ Text
"last year"
             , Text
"last yr"
             ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples (Datetime -> Grain -> Context -> TimeValue
datetime (Integer
2013, Int
1, Int
1, Int
0, Int
0, Pico
0) Grain
Year)
             [ Text
"this year"
             , Text
"current year"
             , Text
"this yr"
             ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples (Datetime -> Grain -> Context -> TimeValue
datetime (Integer
2014, Int
1, Int
1, Int
0, Int
0, Pico
0) Grain
Year)
             [ Text
"next year"
             , Text
"next yr"
             ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples (Datetime -> Grain -> Context -> TimeValue
datetime (Integer
2014, Int
1, Int
1, Int
0, Int
0, Pico
0) Grain
Year)
             [ Text
"in 2014 A.D.",
               Text
"in 2014 AD"
             ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples (Datetime -> Grain -> Context -> TimeValue
datetime (-Integer
2014, Int
1, Int
1, Int
0, Int
0, Pico
0) Grain
Year)
             [ Text
"in 2014 B.C.",
               Text
"in 2014 BC"
             ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples (Datetime -> Grain -> Context -> TimeValue
datetime (Integer
14, Int
1, Int
1, Int
0, Int
0, Pico
0) Grain
Year)
             [ Text
"in 14 a.d."
             ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples (Datetime -> Grain -> Context -> TimeValue
datetime (Integer
2013, Int
2, Int
10, Int
0, Int
0, Pico
0) Grain
Day)
             [ Text
"last sunday"
             , Text
"sunday from last week"
             , Text
"last week's sunday"
             ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples (Datetime -> Grain -> Context -> TimeValue
datetime (Integer
2013, Int
2, Int
5, Int
0, Int
0, Pico
0) Grain
Day)
             [ Text
"last tuesday"
             ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples (Datetime -> Grain -> Context -> TimeValue
datetime (Integer
2013, Int
2, Int
20, Int
0, Int
0, Pico
0) Grain
Day)
             [ Text
"next wednesday"
             ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples (Datetime -> Grain -> Context -> TimeValue
datetime (Integer
2013, Int
2, Int
20, Int
0, Int
0, Pico
0) Grain
Day)
             [ Text
"wednesday of next week"
             , Text
"wednesday next week"
             , Text
"wednesday after next"
             ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples (Datetime -> Grain -> Context -> TimeValue
datetime (Integer
2013, Int
2, Int
22, Int
0, Int
0, Pico
0) Grain
Day)
             [ Text
"friday after next"
             ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples (Datetime -> Grain -> Context -> TimeValue
datetime (Integer
2013, Int
2, Int
11, Int
0, Int
0, Pico
0) Grain
Day)
             [ Text
"monday of this week"
             ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples (Datetime -> Grain -> Context -> TimeValue
datetime (Integer
2013, Int
2, Int
12, Int
0, Int
0, Pico
0) Grain
Day)
             [ Text
"tuesday of this week"
             ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples (Datetime -> Grain -> Context -> TimeValue
datetime (Integer
2013, Int
2, Int
13, Int
0, Int
0, Pico
0) Grain
Day)
             [ Text
"wednesday of this week"
             ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples (Datetime -> Grain -> Context -> TimeValue
datetime (Integer
2013, Int
2, Int
14, Int
0, Int
0, Pico
0) Grain
Day)
             [ Text
"the day after tomorrow"
             ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples (Datetime -> Grain -> Context -> TimeValue
datetime (Integer
2013, Int
2, Int
14, Int
17, Int
0, Pico
0) Grain
Hour)
             [ Text
"day after tomorrow 5pm"
             ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples (Datetime -> Grain -> Context -> TimeValue
datetime (Integer
2013, Int
2, Int
10, Int
0, Int
0, Pico
0) Grain
Day)
             [ Text
"the day before yesterday"
             ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples (Datetime -> Grain -> Context -> TimeValue
datetime (Integer
2013, Int
2, Int
10, Int
8, Int
0, Pico
0) Grain
Hour)
             [ Text
"day before yesterday 8am"
             ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples (Datetime -> Grain -> Context -> TimeValue
datetime (Integer
2013, Int
3, Int
25, Int
0, Int
0, Pico
0) Grain
Day)
             [ Text
"last Monday of March"
             ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples (Datetime -> Grain -> Context -> TimeValue
datetime (Integer
2014, Int
3, Int
30, Int
0, Int
0, Pico
0) Grain
Day)
             [ Text
"last Sunday of March 2014"
             ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples (Datetime -> Grain -> Context -> TimeValue
datetime (Integer
2013, Int
10, Int
3, Int
0, Int
0, Pico
0) Grain
Day)
             [ Text
"third day of october"
             ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples (Datetime -> Grain -> Context -> TimeValue
datetime (Integer
2014, Int
10, Int
6, Int
0, Int
0, Pico
0) Grain
Week)
             [ Text
"first week of october 2014"
             ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples (Datetime -> Grain -> Context -> TimeValue
datetime (Integer
2018, Int
12, Int
10, Int
0, Int
0, Pico
0) Grain
Week)
             [ Text
"third last week of 2018"
             , Text
"the third last week of 2018"
             , Text
"the 3rd last week of 2018"
             ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples (Datetime -> Grain -> Context -> TimeValue
datetime (Integer
2018, Int
10, Int
15, Int
0, Int
0, Pico
0) Grain
Week)
             [ Text
"2nd last week of October 2018"
             , Text
"the second last week of October 2018"
             ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples (Datetime -> Grain -> Context -> TimeValue
datetime (Integer
2013, Int
5, Int
27, Int
0, Int
0, Pico
0) Grain
Day)
             [ Text
"fifth last day of May"
             , Text
"the 5th last day of May"
             ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples (Datetime -> Grain -> Context -> TimeValue
datetime (Integer
2013, Int
10, Int
7, Int
0, Int
0, Pico
0) Grain
Week)
             [ Text
"the week of october 6th"
             ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples (Datetime -> Grain -> Context -> TimeValue
datetime (Integer
2013, Int
10, Int
7, Int
0, Int
0, Pico
0) Grain
Week)
             [ Text
"the week of october 7th"
             ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples (Datetime -> Grain -> Context -> TimeValue
datetime (Integer
2015, Int
10, Int
31, Int
0, Int
0, Pico
0) Grain
Day)
             [ Text
"last day of october 2015"
             , Text
"last day in october 2015"
             ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples (Datetime -> Grain -> Context -> TimeValue
datetime (Integer
2014, Int
9, Int
22, Int
0, Int
0, Pico
0) Grain
Week)
             [ Text
"last week of september 2014"
             ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples (Datetime -> Grain -> Context -> TimeValue
datetime (Integer
2013, Int
10, Int
1, Int
0, Int
0, Pico
0) Grain
Day)
             [ Text
"first tuesday of october"
             , Text
"first tuesday in october"
             ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples (Datetime -> Grain -> Context -> TimeValue
datetime (Integer
2014, Int
9, Int
16, Int
0, Int
0, Pico
0) Grain
Day)
             [ Text
"third tuesday of september 2014"
             ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples (Datetime -> Grain -> Context -> TimeValue
datetime (Integer
2014, Int
10, Int
1, Int
0, Int
0, Pico
0) Grain
Day)
             [ Text
"first wednesday of october 2014"
             ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples (Datetime -> Grain -> Context -> TimeValue
datetime (Integer
2014, Int
10, Int
8, Int
0, Int
0, Pico
0) Grain
Day)
             [ Text
"second wednesday of october 2014"
             ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples (Datetime -> Grain -> Context -> TimeValue
datetime (Integer
2015, Int
1, Int
13, Int
0, Int
0, Pico
0) Grain
Day)
             [ Text
"third tuesday after christmas 2014"
             ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples (Datetime -> Grain -> Context -> TimeValue
datetime (Integer
2013, Int
2, Int
13, Int
3, Int
0, Pico
0) Grain
Hour)
             [ Text
"at 3am"
             , Text
"3 in the AM"
             , Text
"at 3 AM"
             , Text
"3 oclock am"
             , Text
"at three am"
             , Text
"this morning at 3"
             , Text
"3 in the morning"
             , Text
"at 3 in the morning"
             , Text
"early morning @ 3"
             ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples (Datetime -> Grain -> Context -> TimeValue
datetime (Integer
2013, Int
2, Int
12, Int
10, Int
0, Pico
0) Grain
Hour)
             [ Text
"this morning @ 10"
             , Text
"this morning at 10am"
             ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples (Datetime -> Grain -> Context -> TimeValue
datetime (Integer
2013, Int
2, Int
13, Int
3, Int
18, Pico
0) Grain
Minute)
             [ Text
"3:18am"
             , Text
"3:18a"
             , Text
"3h18"
             ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples (Datetime -> Grain -> Context -> TimeValue
datetime (Integer
2016, Int
2, Int
1, Int
7, Int
0, Pico
0) Grain
Hour)
             [ Text
"at 7 in 3 years"
             ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples (Datetime -> Grain -> Context -> TimeValue
datetime (Integer
2013, Int
2, Int
12, Int
15, Int
0, Pico
0) Grain
Hour)
             [ Text
"at 3pm"
             , Text
"@ 3pm"
             , Text
"3PM"
             , Text
"3pm"
             , Text
"3 oclock pm"
             , Text
"3 o'clock in the afternoon"
             , Text
"3ish pm"
             , Text
"3pm approximately"
             , Text
"at about 3pm"
             , Text
"at 3p"
             , Text
"at 3p."
             ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples (Datetime -> Grain -> Context -> TimeValue
datetime (Integer
2013, Int
2, Int
12, Int
15, Int
0, Pico
0) Grain
Minute)
             [ Text
"15h00"
             , Text
"at 15h00"
             , Text
"15h"
             , Text
"at 15h"
             ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples (Datetime -> Grain -> Context -> TimeValue
datetime (Integer
2013, Int
2, Int
12, Int
15, Int
15, Pico
0) Grain
Minute)
             [ Text
"at 15 past 3pm"
             , Text
"a quarter past 3pm"
             , Text
"for a quarter past 3pm"
             , Text
"3:15 in the afternoon"
             , Text
"15:15"
             , Text
"15h15"
             , Text
"3:15pm"
             , Text
"3:15PM"
             , Text
"3:15p"
             , Text
"at 3 15"
             , Text
"15 minutes past 3pm"
             , Text
"15 minutes past 15h"
             ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples (Datetime -> Grain -> Context -> TimeValue
datetime (Integer
2013, Int
2, Int
12, Int
15, Int
20, Pico
0) Grain
Minute)
             [ Text
"at 20 past 3pm"
             , Text
"3:20 in the afternoon"
             , Text
"3:20 in afternoon"
             , Text
"twenty after 3pm"
             , Text
"3:20p"
             , Text
"15h20"
             , Text
"at three twenty"
             , Text
"20 minutes past 3pm"
             , Text
"this afternoon at 3:20"
             , Text
"tonight @ 3:20"
             ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples (Datetime -> Grain -> Context -> TimeValue
datetime (Integer
2013, Int
2, Int
12, Int
15, Int
30, Pico
0) Grain
Minute)
             [ Text
"at half past three pm"
             , Text
"half past 3 pm"
             , Text
"15:30"
             , Text
"15h30"
             , Text
"3:30pm"
             , Text
"3:30PM"
             , Text
"330 p.m."
             , Text
"3:30 p m"
             , Text
"3:30"
             , Text
"half three"
             , Text
"30 minutes past 3 pm"
             ]
   , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples (Datetime -> Grain -> Context -> TimeValue
datetime (Integer
2013, Int
2, Int
12, Int
12, Int
15, Pico
0) Grain
Minute)
              [ Text
"at 15 past noon"
              , Text
"a quarter past noon"
              , Text
"for a quarter past noon"
              , Text
"12:15 in the afternoon"
              , Text
"12:15"
              , Text
"12h15"
              , Text
"12:15pm"
              , Text
"12:15PM"
              , Text
"12:15p"
              , Text
"at 12 15"
              , Text
"15 minutes past noon"
  ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples (Datetime -> Grain -> Context -> TimeValue
datetime (Integer
2013, Int
2, Int
12, Int
9, Int
59, Pico
0) Grain
Minute)
             [ Text
"nine fifty nine a m"
             ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples (Datetime -> Grain -> Context -> TimeValue
datetime (Integer
2013, Int
2, Int
12, Int
15, Int
23, Pico
24) Grain
Second)
             [ Text
"15:23:24"
             ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples (Datetime -> Grain -> Context -> TimeValue
datetime (Integer
2013, Int
2, Int
12, Int
11, Int
45, Pico
0) Grain
Minute)
             [ Text
"a quarter to noon"
             , Text
"11:45am"
             , Text
"11h45"
             , Text
"15 to noon"
             ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples (Datetime -> Grain -> Context -> TimeValue
datetime (Integer
2013, Int
2, Int
12, Int
13, Int
15, Pico
0) Grain
Minute)
             [ Text
"a quarter past 1pm"
             , Text
"for a quarter past 1pm"
             , Text
"1:15pm"
             , Text
"13h15"
             , Text
"15 minutes from 1pm"
             ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples (Datetime -> Grain -> Context -> TimeValue
datetime (Integer
2013, Int
2, Int
12, Int
14, Int
15, Pico
0) Grain
Minute)
             [ Text
"a quarter past 2pm"
             , Text
"for a quarter past 2pm"
             ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples (Datetime -> Grain -> Context -> TimeValue
datetime (Integer
2013, Int
2, Int
12, Int
20, Int
15, Pico
0) Grain
Minute)
             [ Text
"a quarter past 8pm"
             , Text
"for a quarter past 8pm"
             ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples (Datetime -> Grain -> Context -> TimeValue
datetime (Integer
2013, Int
2, Int
12, Int
20, Int
0, Pico
0) Grain
Hour)
             [ Text
"8 tonight"
             , Text
"tonight at 8 o'clock"
             , Text
"eight tonight"
             , Text
"8 this evening"
             , Text
"at 8 in the evening"
             , Text
"in the evening at eight"
             ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples (Datetime -> Grain -> Context -> TimeValue
datetime (Integer
2013, Int
9, Int
20, Int
19, Int
30, Pico
0) Grain
Minute)
             [ Text
"at 7:30 PM on Fri, Sep 20"
             , Text
"at 19h30 on Fri, Sep 20"
             ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples (Datetime -> Grain -> Context -> TimeValue
datetime (Integer
2013, Int
2, Int
16, Int
9, Int
0, Pico
0) Grain
Hour)
             [ Text
"at 9am on Saturday"
             , Text
"Saturday morning at 9"
             ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples (Datetime -> Grain -> Context -> TimeValue
datetime (Integer
2013, Int
2, Int
16, Int
9, Int
0, Pico
0) Grain
Hour)
             [ Text
"on Saturday for 9am"
             ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples (Datetime -> Grain -> Context -> TimeValue
datetime (Integer
2014, Int
7, Int
18, Int
19, Int
0, Pico
0) Grain
Minute)
             [ Text
"Fri, Jul 18, 2014 07:00 PM"
             , Text
"Fri, Jul 18, 2014 19h00"
             , Text
"Fri, Jul 18, 2014 19h"
             ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples (Datetime -> Grain -> Context -> TimeValue
datetime (Integer
2013, Int
2, Int
12, Int
4, Int
30, Pico
1) Grain
Second)
             [ Text
"in a sec"
             , Text
"one second from now"
             , Text
"in 1\""
             ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples (Datetime -> Grain -> Context -> TimeValue
datetime (Integer
2013, Int
2, Int
12, Int
4, Int
31, Pico
0) Grain
Second)
             [ Text
"in a minute"
             , Text
"in one minute"
             , Text
"in 1'"
             ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples (Datetime -> Grain -> Context -> TimeValue
datetime (Integer
2013, Int
2, Int
12, Int
4, Int
32, Pico
0) Grain
Second)
             [ Text
"in 2 minutes"
             , Text
"in 2 more minutes"
             , Text
"2 minutes from now"
             , Text
"in a couple of minutes"
             , Text
"in a pair of minutes"
             ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples (Datetime -> Grain -> Context -> TimeValue
datetime (Integer
2013, Int
2, Int
12, Int
4, Int
33, Pico
0) Grain
Second)
             [ Text
"in three minutes"
             , Text
"in a few minutes"
             ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples (Datetime -> Grain -> Context -> TimeValue
datetime (Integer
2013, Int
2, Int
12, Int
5, Int
30, Pico
0) Grain
Second)
             [ Text
"in 60 minutes"
             ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples (Datetime -> Grain -> Context -> TimeValue
datetime (Integer
2013, Int
2, Int
12, Int
4, Int
45, Pico
0) Grain
Second)
             [ Text
"in a quarter of an hour"
             , Text
"in 1/4h"
             , Text
"in 1/4 h"
             , Text
"in 1/4 hour"
             ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples (Datetime -> Grain -> Context -> TimeValue
datetime (Integer
2013, Int
2, Int
12, Int
5, Int
0, Pico
0) Grain
Second)
             [ Text
"in half an hour"
             , Text
"in 1/2h"
             , Text
"in 1/2 h"
             , Text
"in 1/2 hour"
             ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples (Datetime -> Grain -> Context -> TimeValue
datetime (Integer
2013, Int
2, Int
12, Int
5, Int
15, Pico
0) Grain
Second)
             [ Text
"in three-quarters of an hour"
             , Text
"in 3/4h"
             , Text
"in 3/4 h"
             , Text
"in 3/4 hour"
             ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples (Datetime -> Grain -> Context -> TimeValue
datetime (Integer
2013, Int
2, Int
12, Int
7, Int
0, Pico
0) Grain
Second)
             [ Text
"in 2.5 hours"
             , Text
"in 2 and an half hours"
             ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples (Datetime -> Grain -> Context -> TimeValue
datetime (Integer
2013, Int
2, Int
12, Int
5, Int
30, Pico
0) Grain
Minute)
             [ Text
"in one hour"
             , Text
"in 1h"
             ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples (Datetime -> Grain -> Context -> TimeValue
datetime (Integer
2013, Int
2, Int
12, Int
6, Int
30, Pico
0) Grain
Minute)
             [ Text
"in a couple hours"
             , Text
"in a couple of hours"
             ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples (Datetime -> Grain -> Context -> TimeValue
datetime (Integer
2013, Int
2, Int
12, Int
7, Int
30, Pico
0) Grain
Minute)
             [ Text
"in a few hours"
             , Text
"in few hours"
             ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples (Datetime -> Grain -> Context -> TimeValue
datetime (Integer
2013, Int
2, Int
13, Int
4, Int
30, Pico
0) Grain
Minute)
             [ Text
"in 24 hours"
             ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples (Datetime -> Grain -> Context -> TimeValue
datetime (Integer
2013, Int
2, Int
13, Int
4, Int
0, Pico
0) Grain
Hour)
             [ Text
"in a day"
             , Text
"a day from now"
             ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples (Datetime -> Grain -> Context -> TimeValue
datetime (Integer
2013, Int
2, Int
13, Int
4, Int
30, Pico
0) Grain
Second)
             [ Text
"a day from right now"
             ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples (Datetime -> Grain -> Context -> TimeValue
datetime (Integer
2016, Int
2, Int
12, Int
0, Int
0, Pico
0) Grain
Day)
             [ Text
"3 years from today"
             ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples (Datetime -> Grain -> Context -> TimeValue
datetime (Integer
2013, Int
3, Int
1, Int
0, Int
0, Pico
0) Grain
Day)
             [ Text
"3 fridays from now"
             , Text
"three fridays from now"
             ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples (Datetime -> Grain -> Context -> TimeValue
datetime (Integer
2013, Int
2, Int
24, Int
0, Int
0, Pico
0) Grain
Day)
             [ Text
"2 sundays from now"
             , Text
"two sundays from now"
             ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples (Datetime -> Grain -> Context -> TimeValue
datetime (Integer
2013, Int
3, Int
12, Int
0, Int
0, Pico
0) Grain
Day)
             [ Text
"4 tuesdays from now"
             , Text
"four tuesdays from now"
             ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples (Datetime -> Grain -> Context -> TimeValue
datetime (Integer
2013, Int
2, Int
19, Int
4, Int
0, Pico
0) Grain
Hour)
             [ Text
"in 7 days"
             ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples (Datetime -> Grain -> Context -> TimeValue
datetime (Integer
2013, Int
2, Int
19, Int
17, Int
0, Pico
0) Grain
Hour)
             [ Text
"in 7 days at 5pm"
             ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples (Datetime -> Grain -> Context -> TimeValue
datetime (Integer
2017, Int
2, Int
1, Int
17, Int
0, Pico
0) Grain
Hour)
             [ Text
"in 4 years at 5pm"
             ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples (Datetime -> Grain -> Context -> TimeValue
datetime (Integer
2013, Int
2, Int
19, Int
0, Int
0, Pico
0) Grain
Day)
             [ Text
"in 1 week"
             , Text
"in a week"
             ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples (Datetime -> Grain -> Context -> TimeValue
datetime (Integer
2013, Int
2, Int
12, Int
5, Int
0, Pico
0) Grain
Second)
             [ Text
"in about half an hour"
             ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples (Datetime -> Grain -> Context -> TimeValue
datetime (Integer
2013, Int
2, Int
5, Int
4, Int
0, Pico
0) Grain
Hour)
             [ Text
"7 days ago"
             ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples (Datetime -> Grain -> Context -> TimeValue
datetime (Integer
2013, Int
1, Int
29, Int
4, Int
0, Pico
0) Grain
Hour)
             [ Text
"14 days Ago"
             , Text
"a fortnight ago"
             ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples (Datetime -> Grain -> Context -> TimeValue
datetime (Integer
2013, Int
2, Int
5, Int
0, Int
0, Pico
0) Grain
Day)
             [ Text
"a week ago"
             , Text
"one week ago"
             , Text
"1 week ago"
             ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples (Datetime -> Grain -> Context -> TimeValue
datetime (Integer
2013, Int
1, Int
31, Int
0, Int
0, Pico
0) Grain
Day)
             [ Text
"2 thursdays back"
             , Text
"2 thursdays ago"
             ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples (Datetime -> Grain -> Context -> TimeValue
datetime (Integer
2013, Int
1, Int
22, Int
0, Int
0, Pico
0) Grain
Day)
             [ Text
"three weeks ago"
             ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples (Datetime -> Grain -> Context -> TimeValue
datetime (Integer
2012, Int
11, Int
12, Int
0, Int
0, Pico
0) Grain
Day)
             [ Text
"three months ago"
             ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples (Datetime -> Grain -> Context -> TimeValue
datetime (Integer
2013, Int
02, Int
04, Int
0, Int
0, Pico
0) Grain
Day)
             [ Text
"the first Monday of this month"
             , Text
"the first Monday of the month"
             , Text
"the first Monday in this month"
             , Text
"first Monday in the month"
             ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples (Datetime -> Grain -> Context -> TimeValue
datetime (Integer
2011, Int
2, Int
1, Int
0, Int
0, Pico
0) Grain
Month)
             [ Text
"two years ago"
             ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples (Datetime -> Grain -> Context -> TimeValue
datetime (Integer
2013, Int
2, Int
19, Int
4, Int
0, Pico
0) Grain
Hour)
             [ Text
"7 days hence"
             ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples (Datetime -> Grain -> Context -> TimeValue
datetime (Integer
2013, Int
2, Int
26, Int
4, Int
0, Pico
0) Grain
Hour)
             [ Text
"14 days hence"
             , Text
"a fortnight hence"
             ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples (Datetime -> Grain -> Context -> TimeValue
datetime (Integer
2013, Int
2, Int
19, Int
0, Int
0, Pico
0) Grain
Day)
             [ Text
"a week hence"
             , Text
"one week hence"
             , Text
"1 week hence"
             ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples (Datetime -> Grain -> Context -> TimeValue
datetime (Integer
2013, Int
3, Int
5, Int
0, Int
0, Pico
0) Grain
Day)
             [ Text
"three weeks hence"
             ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples (Datetime -> Grain -> Context -> TimeValue
datetime (Integer
2013, Int
5, Int
12, Int
0, Int
0, Pico
0) Grain
Day)
             [ Text
"three months hence"
             ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples (Datetime -> Grain -> Context -> TimeValue
datetime (Integer
2015, Int
2, Int
1, Int
0, Int
0, Pico
0) Grain
Month)
             [ Text
"two years hence"
             ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples (Datetime -> Grain -> Context -> TimeValue
datetime (Integer
2013, Int
12, Int
25, Int
0, Int
0, Pico
0) Grain
Day)
             [ Text
"one year After christmas"
             , Text
"a year from Christmas"
             ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples ((Datetime, Datetime) -> Grain -> Context -> TimeValue
datetimeInterval ((Integer
2013, Int
12, Int
18, Int
0, Int
0, Pico
0), (Integer
2013, Int
12, Int
29, Int
0, Int
0, Pico
0)) Grain
Day)
             [ Text
"for 10 days from 18th Dec"
             , Text
"from 18th Dec for 10 days"
             , Text
"18th Dec for 10 days"
             ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples ((Datetime, Datetime) -> Grain -> Context -> TimeValue
datetimeInterval ((Integer
2013, Int
2, Int
12, Int
16, Int
0, Pico
0), (Integer
2013, Int
2, Int
12, Int
16, Int
31, Pico
0)) Grain
Minute)
             [ Text
"for 30' starting from 4pm"
             , Text
"from 4pm for thirty minutes"
             , Text
"4pm for 30 mins"
             , Text
"16h for 30 mins"
             ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples ((Datetime, Datetime) -> Grain -> Context -> TimeValue
datetimeInterval ((Integer
2013, Int
6, Int
21, Int
0, Int
0, Pico
0), (Integer
2013, Int
9, Int
24, Int
0, Int
0, Pico
0)) Grain
Day)
             [ Text
"this Summer"
             , Text
"current summer"
             ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples ((Datetime, Datetime) -> Grain -> Context -> TimeValue
datetimeInterval ((Integer
2012, Int
12, Int
21, Int
0, Int
0, Pico
0), (Integer
2013, Int
3, Int
21, Int
0, Int
0, Pico
0)) Grain
Day)
             [ Text
"this winter"
             ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples ((Datetime, Datetime) -> Grain -> Context -> TimeValue
datetimeInterval ((Integer
2012, Int
12, Int
21, Int
0, Int
0, Pico
0), (Integer
2013, Int
3, Int
19, Int
0, Int
0, Pico
0)) Grain
Day)
             [ Text
"this season"
             , Text
"current seasons"
             ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples ((Datetime, Datetime) -> Grain -> Context -> TimeValue
datetimeInterval ((Integer
2012, Int
9, Int
23, Int
0, Int
0, Pico
0), (Integer
2012, Int
12, Int
20, Int
0, Int
0, Pico
0)) Grain
Day)
             [ Text
"last season"
             , Text
"past seasons"
             , Text
"previous seasons"
             ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples ((Datetime, Datetime) -> Grain -> Context -> TimeValue
datetimeInterval ((Integer
2013, Int
3, Int
20, Int
0, Int
0, Pico
0), (Integer
2013, Int
6, Int
20, Int
0, Int
0, Pico
0)) Grain
Day)
             [ Text
"next season"
             ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples ((Datetime, Datetime) -> Grain -> Context -> TimeValue
datetimeInterval ((Integer
2013, Int
2, Int
11, Int
18, Int
0, Pico
0), (Integer
2013, Int
2, Int
12, Int
0, Int
0, Pico
0)) Grain
Hour)
             [ Text
"last night"
             , Text
"yesterday evening"
             ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples ((Datetime, Datetime) -> Grain -> Context -> TimeValue
datetimeInterval ((Integer
2013, Int
2, Int
11, Int
21, Int
0, Pico
0), (Integer
2013, Int
2, Int
12, Int
0, Int
0, Pico
0)) Grain
Hour)
             [ Text
"late last night"
             ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples (Datetime -> Grain -> Text -> Context -> TimeValue
datetimeHoliday (Integer
2013, Int
12, Int
25, Int
0, Int
0, Pico
0) Grain
Day Text
"Christmas")
             [ Text
"xmas"
             , Text
"christmas"
             , Text
"christmas day"
             ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples (Datetime -> Grain -> Text -> Context -> TimeValue
datetimeHoliday (Integer
2013, Int
12, Int
25, Int
18, Int
0, Pico
0) Grain
Hour Text
"Christmas")
             [ Text
"xmas at 6 pm"
             ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples ((Datetime, Datetime) -> Grain -> Text -> Context -> TimeValue
datetimeIntervalHoliday ((Integer
2013, Int
12, Int
25, Int
0, Int
0, Pico
0), (Integer
2013, Int
12, Int
25, Int
12, Int
0, Pico
0)) Grain
Hour Text
"Christmas")
             [ Text
"morning of xmas"
             , Text
"morning of christmas 2013"
             , Text
"morning of this christmas day"
             ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples (Datetime -> Grain -> Text -> Context -> TimeValue
datetimeHoliday (Integer
2013, Int
12, Int
31, Int
0, Int
0, Pico
0) Grain
Day Text
"New Year's Eve")
             [ Text
"new year's eve"
             , Text
"new years eve"
             ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples (Datetime -> Grain -> Text -> Context -> TimeValue
datetimeHoliday (Integer
2014, Int
1, Int
1, Int
0, Int
0, Pico
0) Grain
Day Text
"New Year's Day")
             [ Text
"new year's day"
             , Text
"new years day"
             ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples (Datetime -> Grain -> Text -> Context -> TimeValue
datetimeHoliday (Integer
2013, Int
2, Int
14, Int
0, Int
0, Pico
0) Grain
Day Text
"Valentine's Day")
             [ Text
"valentine's day"
             , Text
"valentine day"
             ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples (Datetime -> Grain -> Context -> TimeValue
datetime (Integer
2013, Int
7, Int
4, Int
0, Int
0, Pico
0) Grain
Day)
             [ Text
"4th of July"
             , Text
"4 of july"
             ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples (Datetime -> Grain -> Text -> Context -> TimeValue
datetimeHoliday (Integer
2013, Int
10, Int
31, Int
0, Int
0, Pico
0) Grain
Day Text
"Halloween")
             [ Text
"halloween"
             , Text
"next halloween"
             , Text
"Halloween 2013"
             ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples (Datetime -> Grain -> Text -> Context -> TimeValue
datetimeHoliday (Integer
2013, Int
11, Int
29, Int
0, Int
0, Pico
0) Grain
Day Text
"Black Friday")
             [ Text
"black friday"
             , Text
"black friday of this year"
             , Text
"black friday 2013"
             ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples (Datetime -> Grain -> Text -> Context -> TimeValue
datetimeHoliday (Integer
2017, Int
11, Int
24, Int
0, Int
0, Pico
0) Grain
Day Text
"Black Friday")
             [ Text
"black friday 2017"
             ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples (Datetime -> Grain -> Text -> Context -> TimeValue
datetimeHoliday (Integer
2013, Int
10, Int
16, Int
0, Int
0, Pico
0) Grain
Day Text
"Boss's Day")
             [ Text
"boss's day"
             , Text
"boss's"
             , Text
"boss day"
             , Text
"next boss's day"
             ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples (Datetime -> Grain -> Text -> Context -> TimeValue
datetimeHoliday (Integer
2016, Int
10, Int
17, Int
0, Int
0, Pico
0) Grain
Day Text
"Boss's Day")
             [ Text
"boss's day 2016"
             ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples (Datetime -> Grain -> Text -> Context -> TimeValue
datetimeHoliday (Integer
2021, Int
10, Int
15, Int
0, Int
0, Pico
0) Grain
Day Text
"Boss's Day")
             [ Text
"boss's day 2021"
             ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples (Datetime -> Grain -> Text -> Context -> TimeValue
datetimeHoliday (Integer
2014, Int
1, Int
20, Int
0, Int
0, Pico
0) Grain
Day Text
"Martin Luther King's Day")
             [ Text
"MLK day"
             , Text
"next Martin Luther King day"
             , Text
"next Martin Luther King's day"
             , Text
"next Martin Luther Kings day"
             , Text
"this MLK day"
             ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples (Datetime -> Grain -> Text -> Context -> TimeValue
datetimeHoliday (Integer
2013, Int
1, Int
21, Int
0, Int
0, Pico
0) Grain
Day Text
"Martin Luther King's Day")
             [ Text
"last MLK Jr. day"
             , Text
"MLK day 2013"
             ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples (Datetime -> Grain -> Text -> Context -> TimeValue
datetimeHoliday (Integer
2012, Int
1, Int
16, Int
0, Int
0, Pico
0) Grain
Day Text
"Martin Luther King's Day")
             [ Text
"MLK day of last year"
             , Text
"MLK day 2012"
             , Text
"Civil Rights Day of last year"
             ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples (Datetime -> Grain -> Text -> Context -> TimeValue
datetimeHoliday (Integer
2013, Int
11, Int
1, Int
0, Int
0, Pico
0) Grain
Day Text
"World Vegan Day")
             [ Text
"world vegan day"
             ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples (Datetime -> Grain -> Text -> Context -> TimeValue
datetimeHoliday (Integer
2013, Int
3, Int
31, Int
0, Int
0, Pico
0) Grain
Day Text
"Easter Sunday")
             [ Text
"easter"
             , Text
"easter 2013"
             ]
 , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples (Datetime -> Grain -> Text -> Context -> TimeValue
datetimeHoliday (Integer
2012, Int
4, Int
08, Int
0, Int
0, Pico
0) Grain
Day Text
"Easter Sunday")
             [ Text
"last easter"
             ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples (Datetime -> Grain -> Text -> Context -> TimeValue
datetimeHoliday (Integer
2013, Int
4, Int
1, Int
0, Int
0, Pico
0) Grain
Day Text
"Easter Monday")
             [ Text
"easter mon"
             ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples (Datetime -> Grain -> Text -> Context -> TimeValue
datetimeHoliday (Integer
2010, Int
4, Int
4, Int
0, Int
0, Pico
0) Grain
Day Text
"Easter Sunday")
             [ Text
"easter 2010"
             , Text
"Easter Sunday two thousand ten"
             ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples (Datetime -> Grain -> Context -> TimeValue
datetime (Integer
2013, Int
4, Int
3, Int
0, Int
0, Pico
0) Grain
Day)
             [ Text
"three days after Easter"
             ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples (Datetime -> Grain -> Text -> Context -> TimeValue
datetimeHoliday (Integer
2013, Int
3, Int
28, Int
0, Int
0, Pico
0) Grain
Day Text
"Maundy Thursday")
             [ Text
"Maundy Thursday"
             , Text
"Covenant thu"
             , Text
"Thu of Mysteries"
             ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples (Datetime -> Grain -> Text -> Context -> TimeValue
datetimeHoliday (Integer
2013, Int
5, Int
19, Int
0, Int
0, Pico
0) Grain
Day Text
"Pentecost")
             [ Text
"Pentecost"
             , Text
"white sunday 2013"
             ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples (Datetime -> Grain -> Text -> Context -> TimeValue
datetimeHoliday (Integer
2013, Int
5, Int
20, Int
0, Int
0, Pico
0) Grain
Day Text
"Whit Monday")
             [ Text
"whit monday"
             , Text
"Monday of the Holy Spirit"
             ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples (Datetime -> Grain -> Text -> Context -> TimeValue
datetimeHoliday (Integer
2013, Int
3, Int
24, Int
0, Int
0, Pico
0) Grain
Day Text
"Palm Sunday")
             [ Text
"palm sunday"
             , Text
"branch sunday 2013"
             ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples (Datetime -> Grain -> Text -> Context -> TimeValue
datetimeHoliday (Integer
2013, Int
5, Int
26, Int
0, Int
0, Pico
0) Grain
Day Text
"Trinity Sunday")
             [ Text
"trinity sunday"
             ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples (Datetime -> Grain -> Text -> Context -> TimeValue
datetimeHoliday (Integer
2013, Int
2, Int
12, Int
0, Int
0, Pico
0) Grain
Day Text
"Shrove Tuesday")
             [ Text
"pancake day 2013"
             , Text
"mardi gras"
             ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples (Datetime -> Grain -> Text -> Context -> TimeValue
datetimeHoliday (Integer
2013, Int
3, Int
17, Int
0, Int
0, Pico
0) Grain
Day Text
"St Patrick's Day")
             [ Text
"st patrick's day 2013"
             , Text
"st paddy's day"
             , Text
"saint paddy's day"
             , Text
"saint patricks day"
             ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples ((Datetime, Datetime) -> Grain -> Text -> Context -> TimeValue
datetimeIntervalHoliday ((Integer
2018, Int
2, Int
14, Int
0, Int
0, Pico
0), (Integer
2018, Int
4, Int
1, Int
0, Int
0, Pico
0)) Grain
Day Text
"Lent")
             [ Text
"lent 2018"
             ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples (Datetime -> Grain -> Text -> Context -> TimeValue
datetimeHoliday (Integer
2018, Int
4, Int
8, Int
0, Int
0, Pico
0) Grain
Day Text
"Orthodox Easter Sunday")
             [ Text
"orthodox easter 2018"
             ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples (Datetime -> Grain -> Text -> Context -> TimeValue
datetimeHoliday (Integer
2020, Int
4, Int
17, Int
0, Int
0, Pico
0) Grain
Day Text
"Orthodox Good Friday")
             [ Text
"orthodox good friday 2020"
             , Text
"orthodox great friday 2020"
             ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples (Datetime -> Grain -> Text -> Context -> TimeValue
datetimeHoliday (Integer
2018, Int
2, Int
19, Int
0, Int
0, Pico
0) Grain
Day Text
"Clean Monday")
             [ Text
"clean monday 2018"
             , Text
"orthodox shrove monday two thousand eighteen"
             ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples (Datetime -> Grain -> Text -> Context -> TimeValue
datetimeHoliday (Integer
2018, Int
3, Int
31, Int
0, Int
0, Pico
0) Grain
Day Text
"Lazarus Saturday")
             [ Text
"lazarus saturday 2018"
             ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples ((Datetime, Datetime) -> Grain -> Text -> Context -> TimeValue
datetimeIntervalHoliday ((Integer
2018, Int
2, Int
19, Int
0, Int
0, Pico
0), (Integer
2018, Int
3, Int
31, Int
0, Int
0, Pico
0)) Grain
Day Text
"Great Lent")
             [ Text
"great fast 2018"
             ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples ((Datetime, Datetime) -> Grain -> Context -> TimeValue
datetimeInterval ((Integer
2013, Int
2, Int
12, Int
18, Int
0, Pico
0), (Integer
2013, Int
2, Int
13, Int
0, Int
0, Pico
0)) Grain
Hour)
             [ Text
"this evening"
             , Text
"today evening"
             , Text
"tonight"
             ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples ((Datetime, Datetime) -> Grain -> Context -> TimeValue
datetimeInterval ((Integer
2013, Int
2, Int
8, Int
18, Int
0, Pico
0), (Integer
2013, Int
2, Int
11, Int
0, Int
0, Pico
0)) Grain
Hour)
             [ Text
"this past weekend"
             ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples ((Datetime, Datetime) -> Grain -> Context -> TimeValue
datetimeInterval ((Integer
2013, Int
2, Int
13, Int
18, Int
0, Pico
0), (Integer
2013, Int
2, Int
14, Int
0, Int
0, Pico
0)) Grain
Hour)
             [ Text
"tomorrow evening"
             ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples ((Datetime, Datetime) -> Grain -> Context -> TimeValue
datetimeInterval ((Integer
2013, Int
2, Int
13, Int
12, Int
0, Pico
0), (Integer
2013, Int
2, Int
13, Int
14, Int
0, Pico
0)) Grain
Hour)
             [ Text
"tomorrow lunch"
             , Text
"tomorrow at lunch"
             ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples ((Datetime, Datetime) -> Grain -> Context -> TimeValue
datetimeInterval ((Integer
2013, Int
2, Int
11, Int
18, Int
0, Pico
0), (Integer
2013, Int
2, Int
12, Int
0, Int
0, Pico
0)) Grain
Hour)
             [ Text
"yesterday evening"
             ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples ((Datetime, Datetime) -> Grain -> Context -> TimeValue
datetimeInterval ((Integer
2013, Int
2, Int
15, Int
18, Int
0, Pico
0), (Integer
2013, Int
2, Int
18, Int
0, Int
0, Pico
0)) Grain
Hour)
             [ Text
"this week-end"
             ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples ((Datetime, Datetime) -> Grain -> Context -> TimeValue
datetimeInterval ((Integer
2013, Int
2, Int
18, Int
0, Int
0, Pico
0), (Integer
2013, Int
2, Int
18, Int
12, Int
0, Pico
0)) Grain
Hour)
             [ Text
"monday mOrnIng"
             ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples ((Datetime, Datetime) -> Grain -> Context -> TimeValue
datetimeInterval ((Integer
2013, Int
2, Int
18, Int
0, Int
0, Pico
0), (Integer
2013, Int
2, Int
18, Int
9, Int
0, Pico
0)) Grain
Hour)
             [ Text
"monday early in the morning"
             , Text
"monday early morning"
             , Text
"monday in the early hours of the morning"
             ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples ((Datetime, Datetime) -> Grain -> Context -> TimeValue
datetimeInterval ((Integer
2013, Int
2, Int
12, Int
21, Int
0, Pico
0), (Integer
2013, Int
2, Int
13, Int
0, Int
0, Pico
0)) Grain
Hour)
             [ Text
"late tonight"
             , Text
"late tonite"
             ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples ((Datetime, Datetime) -> Grain -> Context -> TimeValue
datetimeInterval ((Integer
2013, Int
2, Int
15, Int
0, Int
0, Pico
0), (Integer
2013, Int
2, Int
15, Int
12, Int
0, Pico
0)) Grain
Hour)
             [ Text
"february the 15th in the morning"
             , Text
"15 of february in the morning"
             , Text
"morning of the 15th of february"
             ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples ((Datetime, Datetime) -> Grain -> Context -> TimeValue
datetimeInterval ((Integer
2013, Int
2, Int
12, Int
4, Int
29, Pico
58), (Integer
2013, Int
2, Int
12, Int
4, Int
30, Pico
0)) Grain
Second)
             [ Text
"last 2 seconds"
             , Text
"last two seconds"
             ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples ((Datetime, Datetime) -> Grain -> Context -> TimeValue
datetimeInterval ((Integer
2013, Int
2, Int
12, Int
4, Int
30, Pico
1), (Integer
2013, Int
2, Int
12, Int
4, Int
30, Pico
4)) Grain
Second)
             [ Text
"next 3 seconds"
             , Text
"next three seconds"
             ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples ((Datetime, Datetime) -> Grain -> Context -> TimeValue
datetimeInterval ((Integer
2013, Int
2, Int
12, Int
4, Int
28, Pico
0), (Integer
2013, Int
2, Int
12, Int
4, Int
30, Pico
0)) Grain
Minute)
             [ Text
"last 2 minutes"
             , Text
"last two minutes"
             ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples ((Datetime, Datetime) -> Grain -> Context -> TimeValue
datetimeInterval ((Integer
2013, Int
2, Int
12, Int
4, Int
31, Pico
0), (Integer
2013, Int
2, Int
12, Int
4, Int
34, Pico
0)) Grain
Minute)
             [ Text
"next 3 minutes"
             , Text
"next three minutes"
             ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples ((Datetime, Datetime) -> Grain -> Context -> TimeValue
datetimeInterval ((Integer
2013, Int
2, Int
12, Int
3, Int
0, Pico
0), (Integer
2013, Int
2, Int
12, Int
4, Int
0, Pico
0)) Grain
Hour)
             [ Text
"last 1 hour"
             , Text
"last one hour"
             ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples ((Datetime, Datetime) -> Grain -> Context -> TimeValue
datetimeInterval ((Integer
2013, Int
2, Int
12, Int
5, Int
0, Pico
0), (Integer
2013, Int
2, Int
12, Int
8, Int
0, Pico
0)) Grain
Hour)
             [ Text
"next 3 hours"
             , Text
"next three hours"
             ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples ((Datetime, Datetime) -> Grain -> Context -> TimeValue
datetimeInterval ((Integer
2013, Int
2, Int
10, Int
0, Int
0, Pico
0), (Integer
2013, Int
2, Int
12, Int
0, Int
0, Pico
0)) Grain
Day)
             [ Text
"last 2 days"
             , Text
"last two days"
             , Text
"past 2 days"
             ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples ((Datetime, Datetime) -> Grain -> Context -> TimeValue
datetimeInterval ((Integer
2013, Int
2, Int
13, Int
0, Int
0, Pico
0), (Integer
2013, Int
2, Int
16, Int
0, Int
0, Pico
0)) Grain
Day)
             [ Text
"next 3 days"
             , Text
"next three days"
             ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples ((Datetime, Datetime) -> Grain -> Context -> TimeValue
datetimeInterval ((Integer
2013, Int
2, Int
13, Int
0, Int
0, Pico
0), (Integer
2013, Int
2, Int
16, Int
0, Int
0, Pico
0)) Grain
Day)
             [ Text
"next few days"
             ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples ((Datetime, Datetime) -> Grain -> Context -> TimeValue
datetimeInterval ((Integer
2013, Int
1, Int
28, Int
0, Int
0, Pico
0), (Integer
2013, Int
2, Int
11, Int
0, Int
0, Pico
0)) Grain
Week)
             [ Text
"last 2 weeks"
             , Text
"last two weeks"
             , Text
"past 2 weeks"
             ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples ((Datetime, Datetime) -> Grain -> Context -> TimeValue
datetimeInterval ((Integer
2013, Int
2, Int
18, Int
0, Int
0, Pico
0), (Integer
2013, Int
3, Int
11, Int
0, Int
0, Pico
0)) Grain
Week)
             [ Text
"next 3 weeks"
             , Text
"next three weeks"
             ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples ((Datetime, Datetime) -> Grain -> Context -> TimeValue
datetimeInterval ((Integer
2012, Int
12, Int
1, Int
0, Int
0, Pico
0), (Integer
2013, Int
2, Int
1, Int
0, Int
0, Pico
0)) Grain
Month)
             [ Text
"last 2 months"
             , Text
"last two months"
             ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples ((Datetime, Datetime) -> Grain -> Context -> TimeValue
datetimeInterval ((Integer
2013, Int
3, Int
1, Int
0, Int
0, Pico
0), (Integer
2013, Int
6, Int
1, Int
0, Int
0, Pico
0)) Grain
Month)
             [ Text
"next 3 months"
             , Text
"next three months"
             ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples ((Datetime, Datetime) -> Grain -> Context -> TimeValue
datetimeInterval ((Integer
2011, Int
1, Int
1, Int
0, Int
0, Pico
0), (Integer
2013, Int
1, Int
1, Int
0, Int
0, Pico
0)) Grain
Year)
             [ Text
"last 2 years"
             , Text
"last two years"
             ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples ((Datetime, Datetime) -> Grain -> Context -> TimeValue
datetimeInterval ((Integer
2014, Int
1, Int
1, Int
0, Int
0, Pico
0), (Integer
2017, Int
1, Int
1, Int
0, Int
0, Pico
0)) Grain
Year)
             [ Text
"next 3 years"
             , Text
"next three years"
             ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples ((Datetime, Datetime) -> Grain -> Context -> TimeValue
datetimeInterval ((Integer
2013, Int
7, Int
13, Int
0, Int
0, Pico
0), (Integer
2013, Int
7, Int
16, Int
0, Int
0, Pico
0)) Grain
Day)
             [ Text
"July 13-15"
             , Text
"July 13 to 15"
             , Text
"July 13 thru 15"
             , Text
"July 13 through 15"
             , Text
"July 13 - July 15"
             ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples ((Datetime, Datetime) -> Grain -> Context -> TimeValue
datetimeInterval ((Integer
2013, Int
7, Int
13, Int
0, Int
0, Pico
0), (Integer
2013, Int
7, Int
16, Int
0, Int
0, Pico
0)) Grain
Day)
             [ Text
"from July 13-15"
             , Text
"from 13 to 15 July"
             , Text
"from 13th to 15th July"
             , Text
"from the 13 to 15 July"
             , Text
"from the 13th to 15th July"
             , Text
"from the 13th to the 15th July"
             , Text
"from the 13 to the 15 July"
             ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples ((Datetime, Datetime) -> Grain -> Context -> TimeValue
datetimeInterval ((Integer
2013, Int
7, Int
13, Int
0, Int
0, Pico
0), (Integer
2013, Int
7, Int
16, Int
0, Int
0, Pico
0)) Grain
Day)
             [ Text
"from 13 to 15 of July"
             , Text
"from 13th to 15 of July"
             , Text
"from 13 to 15th of July"
             , Text
"from 13th to 15th of July"
             , Text
"from 13 to the 15 of July"
             , Text
"from 13th to the 15 of July"
             , Text
"from 13 to the 15th of July"
             , Text
"from 13th to the 15th of July"
             , Text
"from the 13 to the 15 of July"
             , Text
"from the 13th to the 15 of July"
             , Text
"from the 13 to the 15th of July"
             , Text
"from the 13th to the 15th of July"
             ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples ((Datetime, Datetime) -> Grain -> Context -> TimeValue
datetimeInterval ((Integer
2013, Int
8, Int
8, Int
0, Int
0, Pico
0), (Integer
2013, Int
8, Int
13, Int
0, Int
0, Pico
0)) Grain
Day)
             [ Text
"Aug 8 - Aug 12"
             ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples ((Datetime, Datetime) -> Grain -> Context -> TimeValue
datetimeInterval ((Integer
2013, Int
2, Int
12, Int
9, Int
30, Pico
0), (Integer
2013, Int
2, Int
12, Int
11, Int
1, Pico
0)) Grain
Minute)
             [ Text
"9:30 - 11:00"
             , Text
"9h30 - 11h00"
             , Text
"9h30 - 11h"
             ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples ((Datetime, Datetime) -> Grain -> Context -> TimeValue
datetimeInterval ((Integer
2013, Int
2, Int
12, Int
13, Int
30, Pico
0), (Integer
2013, Int
2, Int
12, Int
15, Int
1, Pico
0)) Grain
Minute)
             [ Text
"9:30 - 11:00 CST"
             , Text
"9h30 - 11h00 CST"
             , Text
"9h30 - 11h CST"
             ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples ((Datetime, Datetime) -> Grain -> Context -> TimeValue
datetimeInterval ((Integer
2013, Int
2, Int
12, Int
13, Int
0, Pico
0), (Integer
2013, Int
2, Int
12, Int
16, Int
1, Pico
0)) Grain
Minute)
             [ Text
"15:00 GMT - 18:00 GMT"
             , Text
"15h00 GMT - 18h00 GMT"
             , Text
"15h GMT - 18h GMT"
             ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples ((Datetime, Datetime) -> Grain -> Context -> TimeValue
datetimeInterval
      ((Integer
2015, Int
3, Int
28, Int
17, Int
00, Pico
0), (Integer
2015, Int
3, Int
29, Int
21, Int
0, Pico
1)) Grain
Second)
             [ Text
"2015-03-28 17:00:00/2015-03-29 21:00:00"
             ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples ((Datetime, Datetime) -> Grain -> Context -> TimeValue
datetimeInterval ((Integer
2013, Int
2, Int
14, Int
9, Int
30, Pico
0), (Integer
2013, Int
2, Int
14, Int
11, Int
1, Pico
0)) Grain
Minute)
             [ Text
"from 9:30 - 11:00 on Thursday"
             , Text
"between 9:30 and 11:00 on thursday"
             , Text
"between 9h30 and 11h00 on thursday"
             , Text
"9:30 - 11:00 on Thursday"
             , Text
"9h30 - 11h00 on Thursday"
             , Text
"later than 9:30 but before 11:00 on Thursday"
             , Text
"Thursday from 9:30 to 11:00"
             , Text
"from 9:30 untill 11:00 on thursday"
             , Text
"Thursday from 9:30 untill 11:00"
             , Text
"9:30 till 11:00 on Thursday"
             ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples ((Datetime, Datetime) -> Grain -> Context -> TimeValue
datetimeInterval ((Integer
2013, Int
2, Int
13, Int
1, Int
0, Pico
0), (Integer
2013, Int
2, Int
13, Int
2, Int
31, Pico
0)) Grain
Minute)
             [ Text
"tomorrow in between 1-2:30 ish"
             ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples ((Datetime, Datetime) -> Grain -> Context -> TimeValue
datetimeInterval ((Integer
2013, Int
2, Int
12, Int
15, Int
0, Pico
0), (Integer
2013, Int
2, Int
12, Int
17, Int
0, Pico
0)) Grain
Hour)
             [ Text
"3-4pm"
             , Text
"from 3 to 4 in the PM"
             , Text
"around 3-4pm"
             ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples ((Datetime, Datetime) -> Grain -> Context -> TimeValue
datetimeInterval ((Integer
2013, Int
2, Int
12, Int
15, Int
30, Pico
0), (Integer
2013, Int
2, Int
12, Int
18, Int
1, Pico
0)) Grain
Minute)
             [ Text
"3:30 to 6 PM"
             , Text
"3:30-6 p.m."
             , Text
"3:30-6:00pm"
             , Text
"15h30-18h"
             , Text
"from 3:30 to six p.m."
             , Text
"from 3:30 to 6:00pm"
             , Text
"later than 3:30pm but before 6pm"
             , Text
"between 3:30pm and 6 pm"
             ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples ((Datetime, Datetime) -> Grain -> Context -> TimeValue
datetimeInterval ((Integer
2013, Int
2, Int
12, Int
15, Int
0, Pico
0), (Integer
2013, Int
2, Int
12, Int
18, Int
0, Pico
1)) Grain
Second)
             [ Text
"3pm - 6:00:00pm"
             ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples ((Datetime, Datetime) -> Grain -> Context -> TimeValue
datetimeInterval ((Integer
2013, Int
2, Int
12, Int
8, Int
0, Pico
0), (Integer
2013, Int
2, Int
12, Int
14, Int
0, Pico
0)) Grain
Hour)
             [ Text
"8am - 1pm"
             ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples ((Datetime, Datetime) -> Grain -> Context -> TimeValue
datetimeInterval ((Integer
2013, Int
2, Int
14, Int
9, Int
0, Pico
0), (Integer
2013, Int
2, Int
14, Int
12, Int
0, Pico
0)) Grain
Hour)
             [ Text
"Thursday from 9a to 11a"
             , Text
"this Thu 9-11am"
             ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples ((Datetime, Datetime) -> Grain -> Context -> TimeValue
datetimeInterval ((Integer
2013, Int
2, Int
12, Int
11, Int
30, Pico
0), (Integer
2013, Int
2, Int
12, Int
13, Int
31, Pico
0)) Grain
Minute)
             [ Text
"11:30-1:30"
             ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples (Datetime -> Grain -> Context -> TimeValue
datetime (Integer
2013, Int
9, Int
21, Int
13, Int
30, Pico
0) Grain
Minute)
             [ Text
"1:30 PM on Sat, Sep 21"
             ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples ((Datetime, Datetime) -> Grain -> Context -> TimeValue
datetimeInterval ((Integer
2013, Int
2, Int
12, Int
4, Int
30, Pico
0), (Integer
2013, Int
2, Int
26, Int
0, Int
0, Pico
0)) Grain
Second)
             [ Text
"Within 2 weeks"
             ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples ((Datetime, Datetime) -> Grain -> Context -> TimeValue
datetimeInterval ((Integer
2013, Int
2, Int
12, Int
4, Int
30, Pico
0), (Integer
2013, Int
2, Int
12, Int
14, Int
0, Pico
0)) Grain
Second)
             [ Text
"by 2:00pm"
             ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples ((Datetime, Datetime) -> Grain -> Context -> TimeValue
datetimeInterval ((Integer
2013, Int
2, Int
12, Int
4, Int
30, Pico
0), (Integer
2013, Int
2, Int
13, Int
0, Int
0, Pico
0)) Grain
Second)
             [ Text
"by EOD"
             ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples ((Datetime, Datetime) -> Grain -> Context -> TimeValue
datetimeInterval ((Integer
2013, Int
2, Int
12, Int
4, Int
30, Pico
0), (Integer
2013, Int
3, Int
1, Int
0, Int
0, Pico
0)) Grain
Second)
             [ Text
"by EOM"
             , Text
"by the EOM"
             , Text
"by end of the month"
             , Text
"by the end of month"
             ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples ((Datetime, Datetime) -> Grain -> Context -> TimeValue
datetimeInterval ((Integer
2013, Int
2, Int
21, Int
0, Int
0, Pico
0), (Integer
2013, Int
3, Int
1, Int
0, Int
0, Pico
0)) Grain
Day)
             [ Text
"EOM"
             , Text
"the EOM"
             , Text
"at the EOM"
             , Text
"the end of the month"
             , Text
"end of the month"
             , Text
"at the end of month"
             ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples ((Datetime, Datetime) -> Grain -> Context -> TimeValue
datetimeInterval ((Integer
2013, Int
2, Int
1, Int
0, Int
0, Pico
0), (Integer
2013, Int
2, Int
11, Int
0, Int
0, Pico
0)) Grain
Day)
             [ Text
"BOM"
             , Text
"the BOM"
             , Text
"at the BOM"
             , Text
"beginning of the month"
             , Text
"the beginning of the month"
             , Text
"at the beginning of month"
             ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples ((Datetime, Datetime) -> Grain -> Context -> TimeValue
datetimeInterval ((Integer
2013, Int
2, Int
12, Int
4, Int
30, Pico
0), (Integer
2013, Int
4, Int
1, Int
0, Int
0, Pico
0)) Grain
Second)
             [ Text
"by the end of next month"
             ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples (Datetime -> Grain -> Context -> TimeValue
datetime (Integer
2013, Int
2, Int
12, Int
13, Int
0, Pico
0) Grain
Minute)
             [ Text
"4pm CET"
             ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples (Datetime -> Grain -> Context -> TimeValue
datetime (Integer
2013, Int
2, Int
14, Int
6, Int
0, Pico
0) Grain
Minute)
             [ Text
"Thursday 8:00 GMT"
             , Text
"Thursday 8:00 gmt"
             , Text
"Thursday 8h00 GMT"
             , Text
"Thursday 8h00 gmt"
             , Text
"Thursday 8h GMT"
             , Text
"Thursday 8h gmt"
             , Text
"Thu at 8 GMT"
             , Text
"Thu at 8 gmt"
             , Text
"Thursday 9 am BST"
             , Text
"Thursday 9 am (BST)"
             ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples (Datetime -> Grain -> Context -> TimeValue
datetime (Integer
2013, Int
2, Int
14, Int
14, Int
0, Pico
0) Grain
Minute)
             [ Text
"Thursday 8:00 PST"
             , Text
"Thursday 8:00 pst"
             , Text
"Thursday 8h00 PST"
             , Text
"Thursday 8h00 pst"
             , Text
"Thursday 8h PST"
             , Text
"Thursday 8h pst"
             , Text
"Thu at 8 am PST"
             , Text
"Thu at 8 am pst"
             , Text
"Thursday at 9:30pm ist"
             ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples (Datetime -> Grain -> Context -> TimeValue
datetime (Integer
2013, Int
2, Int
12, Int
14, Int
0, Pico
0) Grain
Hour)
             [ Text
"today at 2pm"
             , Text
"at 2pm"
             , Text
"this afternoon at 2"
             , Text
"this evening at 2"
             , Text
"tonight at 2"
             ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples (Datetime -> Grain -> Context -> TimeValue
datetime (Integer
2013, Int
2, Int
13, Int
15, Int
0, Pico
0) Grain
Hour)
             [ Text
"3pm tomorrow"
             ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples (Datetime -> Grain -> Context -> TimeValue
datetime (Integer
2013, Int
2, Int
12, Int
5, Int
30, Pico
0) Grain
Minute)
             [ Text
"today in one hour"
             ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples (IntervalDirection -> Datetime -> Grain -> Context -> TimeValue
datetimeOpenInterval IntervalDirection
After (Integer
2013, Int
2, Int
12, Int
4, Int
30, Pico
0) Grain
Second)
             [ Text
"ASAP"
             , Text
"as soon as possible"
             ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples (IntervalDirection -> Datetime -> Grain -> Context -> TimeValue
datetimeOpenInterval IntervalDirection
Before (Integer
2013, Int
2, Int
12, Int
14, Int
0, Pico
0) Grain
Minute)
             [ Text
"until 2:00pm"
             , Text
"through 2:00pm"
             ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples (IntervalDirection -> Datetime -> Grain -> Context -> TimeValue
datetimeOpenInterval IntervalDirection
After (Integer
2013, Int
2, Int
12, Int
14, Int
0, Pico
0) Grain
Hour)
             [ Text
"after 2 pm"
             , Text
"from 2 pm"
             , Text
"since 2pm"
             ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples (IntervalDirection -> Datetime -> Grain -> Context -> TimeValue
datetimeOpenInterval IntervalDirection
After (Integer
2014, Int
1, Int
1, Int
0, Int
0, Pico
0) Grain
Year)
             [ Text
"anytime after 2014"
             , Text
"since 2014"
             ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples (IntervalDirection -> Datetime -> Grain -> Context -> TimeValue
datetimeOpenInterval IntervalDirection
Before (Integer
2014, Int
1, Int
1, Int
0, Int
0, Pico
0) Grain
Year)
             [ Text
"sometimes before 2014"
             , Text
"through 2014"
             ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples (IntervalDirection -> Datetime -> Grain -> Context -> TimeValue
datetimeOpenInterval IntervalDirection
After (Integer
2013, Int
2, Int
17, Int
4, Int
0, Pico
0) Grain
Hour)
             [ Text
"after 5 days"
             ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples (IntervalDirection -> Datetime -> Grain -> Context -> TimeValue
datetimeOpenInterval IntervalDirection
Before (Integer
2013, Int
2, Int
12, Int
11, Int
0, Pico
0) Grain
Hour)
             [ Text
"before 11 am"
             ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples ((Datetime, Datetime) -> Grain -> Context -> TimeValue
datetimeInterval ((Integer
2013, Int
2, Int
12, Int
12, Int
0, Pico
0), (Integer
2013, Int
2, Int
12, Int
19, Int
0, Pico
0)) Grain
Hour)
             [ Text
"in the afternoon"
             ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples ((Datetime, Datetime) -> Grain -> Context -> TimeValue
datetimeInterval ((Integer
2013, Int
2, Int
12, Int
8, Int
0, Pico
0), (Integer
2013, Int
2, Int
12, Int
19, Int
0, Pico
0)) Grain
Hour)
             [ Text
"8am until 6"
             ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples (Datetime -> Grain -> Context -> TimeValue
datetime (Integer
2013, Int
2, Int
12, Int
13, Int
30, Pico
0) Grain
Minute)
             [ Text
"at 1:30pm"
             , Text
"1:30pm"
             , Text
"at 13h30"
             , Text
"13h30"
             ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples (Datetime -> Grain -> Context -> TimeValue
datetime (Integer
2013, Int
2, Int
12, Int
4, Int
45, Pico
0) Grain
Second)
             [ Text
"in 15 minutes"
             , Text
"in 15'"
             , Text
"in 15"
             ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples ((Datetime, Datetime) -> Grain -> Context -> TimeValue
datetimeInterval ((Integer
2013, Int
2, Int
12, Int
13, Int
0, Pico
0), (Integer
2013, Int
2, Int
12, Int
17, Int
0, Pico
0)) Grain
Hour)
             [ Text
"after lunch"
             ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples ((Datetime, Datetime) -> Grain -> Context -> TimeValue
datetimeInterval ((Integer
2013, Int
2, Int
12, Int
15, Int
0, Pico
0), (Integer
2013, Int
2, Int
12, Int
21, Int
0, Pico
0)) Grain
Hour)
             [ Text
"after school"
             ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples (Datetime -> Grain -> Context -> TimeValue
datetime (Integer
2013, Int
2, Int
12, Int
10, Int
30, Pico
0) Grain
Minute)
             [ Text
"10:30"
             , Text
"approximately 1030"
             ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples ((Datetime, Datetime) -> Grain -> Context -> TimeValue
datetimeInterval ((Integer
2013, Int
2, Int
12, Int
0, Int
0, Pico
0), (Integer
2013, Int
2, Int
12, Int
12, Int
0, Pico
0)) Grain
Hour)
             [ Text
"this morning"
             ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples (Datetime -> Grain -> Context -> TimeValue
datetime (Integer
2013, Int
2, Int
18, Int
0, Int
0, Pico
0) Grain
Day)
             [ Text
"next monday"
             ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples (Datetime -> Grain -> Context -> TimeValue
datetime (Integer
2013, Int
2, Int
12, Int
12, Int
0, Pico
0) Grain
Hour)
             [ Text
"at 12pm"
             , Text
"at noon"
             , Text
"midday"
             , Text
"the midday"
             , Text
"mid day"
             ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples (Datetime -> Grain -> Context -> TimeValue
datetime (Integer
2013, Int
2, Int
13, Int
0, Int
0, Pico
0) Grain
Hour)
             [ Text
"at 12am"
             , Text
"at midnight"
             , Text
"this morning at 12"
             , Text
"this evening at 12"
             , Text
"this afternoon at 12"
             ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples (Datetime -> Grain -> Context -> TimeValue
datetime (Integer
2013, Int
2, Int
13, Int
9, Int
0, Pico
0) Grain
Hour)
             [ Text
"9 tomorrow morning"
             , Text
"9 tomorrow"
             ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples (Datetime -> Grain -> Context -> TimeValue
datetime (Integer
2013, Int
2, Int
13, Int
21, Int
0, Pico
0) Grain
Hour)
             [ Text
"9 tomorrow evening"
             ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples (Datetime -> Grain -> Context -> TimeValue
datetime (Integer
2013, Int
3, Int
1, Int
0, Int
0, Pico
0) Grain
Month)
             [ Text
"March"
             , Text
"in March"
             , Text
"during March"
             ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples (Datetime -> Grain -> Context -> TimeValue
datetime (Integer
2013, Int
2, Int
13, Int
17, Int
0, Pico
0) Grain
Hour)
             [ Text
"tomorrow afternoon at 5"
             , Text
"at 5 tomorrow afternoon"
             , Text
"at 5pm tomorrow"
             , Text
"tomorrow at 5pm"
             , Text
"tomorrow evening at 5"
             ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples ((Datetime, Datetime) -> Grain -> Context -> TimeValue
datetimeInterval ((Integer
2013, Int
2, Int
13, Int
12, Int
0, Pico
0), (Integer
2013, Int
2, Int
13, Int
19, Int
0, Pico
0)) Grain
Hour)
             [ Text
"tomorrow afternoon"
             , Text
"tomorrow afternoonish"
             ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples ((Datetime, Datetime) -> Grain -> Context -> TimeValue
datetimeInterval ((Integer
2013, Int
2, Int
13, Int
13, Int
0, Pico
0), (Integer
2013, Int
2, Int
13, Int
15, Int
0, Pico
0)) Grain
Hour)
             [ Text
"1pm-2pm tomorrow"
             ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples (Datetime -> Grain -> Context -> TimeValue
datetime (Integer
2013, Int
3, Int
1, Int
0, Int
0, Pico
0) Grain
Day)
             [ Text
"on the first"
             , Text
"the 1st"
             ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples (Datetime -> Grain -> Context -> TimeValue
datetime (Integer
2013, Int
2, Int
12, Int
10, Int
30, Pico
0) Grain
Minute)
             [ Text
"at 1030"
             , Text
"around 1030"
             , Text
"ten thirty am"
             ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples (Datetime -> Grain -> Context -> TimeValue
datetime (Integer
2013, Int
2, Int
12, Int
19, Int
30, Pico
0) Grain
Minute)
             [ Text
"at 730 in the evening"
             , Text
"seven thirty p.m."
             ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples (Datetime -> Grain -> Context -> TimeValue
datetime (Integer
2013, Int
2, Int
13, Int
1, Int
50, Pico
0) Grain
Minute)
             [ Text
"tomorrow at 150ish"
             ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples (Datetime -> Grain -> Context -> TimeValue
datetime (Integer
2013, Int
2, Int
12, Int
23, Int
0, Pico
0) Grain
Hour)
             [ Text
"tonight at 11"
             , Text
"this evening at 11"
             , Text
"this afternoon at 11"
             , Text
"tonight at 11pm"
             ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples (Datetime -> Grain -> Context -> TimeValue
datetime (Integer
2013, Int
2, Int
12, Int
4, Int
23, Pico
0) Grain
Minute)
    -- yes, the result is in the past, we may need to revisit
             [ Text
"at 4:23"
             , Text
"4:23am"
             , Text
"four twenty-three a m"
             ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples (Datetime -> Grain -> Context -> TimeValue
datetime (Integer
2013, Int
10, Int
7, Int
0, Int
0, Pico
0) Grain
Day)
             [ Text
"the closest Monday to Oct 5th"
             ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples (Datetime -> Grain -> Context -> TimeValue
datetime (Integer
2013, Int
9, Int
30, Int
0, Int
0, Pico
0) Grain
Day)
             [ Text
"the second closest Mon to October fifth"
             ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples ((Datetime, Datetime) -> Grain -> Context -> TimeValue
datetimeInterval ((Integer
2013, Int
3, Int
1, Int
0, Int
0, Pico
0), (Integer
2013, Int
3, Int
11, Int
0, Int
0, Pico
0)) Grain
Day)
             [ Text
"early March"
             ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples ((Datetime, Datetime) -> Grain -> Context -> TimeValue
datetimeInterval ((Integer
2013, Int
3, Int
11, Int
0, Int
0, Pico
0), (Integer
2013, Int
3, Int
21, Int
0, Int
0, Pico
0)) Grain
Day)
             [ Text
"mid March"
             ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples ((Datetime, Datetime) -> Grain -> Context -> TimeValue
datetimeInterval ((Integer
2013, Int
3, Int
21, Int
0, Int
0, Pico
0), (Integer
2013, Int
4, Int
1, Int
0, Int
0, Pico
0)) Grain
Day)
             [ Text
"late March"
             ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples ((Datetime, Datetime) -> Grain -> Context -> TimeValue
datetimeInterval ((Integer
2013, Int
10, Int
25, Int
18, Int
0, Pico
0), (Integer
2013, Int
10, Int
28, Int
0, Int
0, Pico
0)) Grain
Hour)
             [ Text
"last weekend of October"
             , Text
"last week-end in October"
             , Text
"last week end of October"
             ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples ((Datetime, Datetime) -> Grain -> Context -> TimeValue
datetimeInterval ((Integer
2013, Int
2, Int
11, Int
0, Int
0, Pico
0), (Integer
2013, Int
2, Int
17, Int
0, Int
0, Pico
0)) Grain
Day)
             [ Text
"all week"
             ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples ((Datetime, Datetime) -> Grain -> Context -> TimeValue
datetimeInterval ((Integer
2013, Int
2, Int
12, Int
0, Int
0, Pico
0), (Integer
2013, Int
2, Int
17, Int
0, Int
0, Pico
0)) Grain
Day)
             [ Text
"rest of the week"
             ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples ((Datetime, Datetime) -> Grain -> Context -> TimeValue
datetimeInterval ((Integer
2013, Int
7, Int
26, Int
18, Int
0, Pico
0), (Integer
2013, Int
7, Int
29, Int
0, Int
0, Pico
0)) Grain
Hour)
             [ Text
"last wkend of July"
             ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples ((Datetime, Datetime) -> Grain -> Context -> TimeValue
datetimeInterval ((Integer
2017, Int
10, Int
27, Int
18, Int
0, Pico
0), (Integer
2017, Int
10, Int
30, Int
0, Int
0, Pico
0)) Grain
Hour)
             [ Text
"last weekend of October 2017"
             ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples ((Datetime, Datetime) -> Grain -> Context -> TimeValue
datetimeInterval ((Integer
2013, Int
8, Int
27, Int
0, Int
0, Pico
0), (Integer
2013, Int
8, Int
30, Int
0, Int
0, Pico
0)) Grain
Day)
             [ Text
"August 27th - 29th"
             , Text
"from August 27th - 29th"
             ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples ((Datetime, Datetime) -> Grain -> Context -> TimeValue
datetimeInterval ((Integer
2013, Int
10, Int
23, Int
0, Int
0, Pico
0), (Integer
2013, Int
10, Int
27, Int
0, Int
0, Pico
0)) Grain
Day)
             [ Text
"23rd to 26th Oct"
             ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples ((Datetime, Datetime) -> Grain -> Context -> TimeValue
datetimeInterval ((Integer
2013, Int
9, Int
1, Int
0, Int
0, Pico
0), (Integer
2013, Int
9, Int
9, Int
0, Int
0, Pico
0)) Grain
Day)
             [ Text
"1-8 september"
             ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples ((Datetime, Datetime) -> Grain -> Context -> TimeValue
datetimeInterval ((Integer
2013, Int
9, Int
12, Int
0, Int
0, Pico
0), (Integer
2013, Int
9, Int
17, Int
0, Int
0, Pico
0)) Grain
Day)
             [ Text
"12 to 16 september"
             ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples ((Datetime, Datetime) -> Grain -> Context -> TimeValue
datetimeInterval ((Integer
2013, Int
8, Int
19, Int
0, Int
0, Pico
0), (Integer
2013, Int
8, Int
22, Int
0, Int
0, Pico
0)) Grain
Day)
             [ Text
"19th To 21st aug"
             ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples ((Datetime, Datetime) -> Grain -> Context -> TimeValue
datetimeInterval ((Integer
2013, Int
4, Int
21, Int
0, Int
0, Pico
0), (Integer
2013, Int
5, Int
1, Int
0, Int
0, Pico
0)) Grain
Day)
             [ Text
"end of April"
             , Text
"at the end of April"
             ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples ((Datetime, Datetime) -> Grain -> Context -> TimeValue
datetimeInterval ((Integer
2014, Int
1, Int
1, Int
0, Int
0, Pico
0), (Integer
2014, Int
1, Int
11, Int
0, Int
0, Pico
0)) Grain
Day)
             [ Text
"beginning of January"
             , Text
"at the beginning of January"
             ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples ((Datetime, Datetime) -> Grain -> Context -> TimeValue
datetimeInterval ((Integer
2012, Int
9, Int
1, Int
0, Int
0, Pico
0), (Integer
2013, Int
1, Int
1, Int
0, Int
0, Pico
0)) Grain
Month)
             [ Text
"end of 2012"
             , Text
"at the end of 2012"
             ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples ((Datetime, Datetime) -> Grain -> Context -> TimeValue
datetimeInterval ((Integer
2017, Int
1, Int
1, Int
0, Int
0, Pico
0), (Integer
2017, Int
4, Int
1, Int
0, Int
0, Pico
0)) Grain
Month)
             [ Text
"beginning of 2017"
             , Text
"at the beginning of 2017"
             ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples ((Datetime, Datetime) -> Grain -> Context -> TimeValue
datetimeInterval ((Integer
2013, Int
1, Int
1, Int
0, Int
0, Pico
0), (Integer
2013, Int
4, Int
1, Int
0, Int
0, Pico
0)) Grain
Month)
             [ Text
"beginning of year"
             , Text
"the beginning of the year"
             , Text
"the BOY"
             , Text
"BOY"
             ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples ((Datetime, Datetime) -> Grain -> Context -> TimeValue
datetimeInterval ((Integer
2013, Int
2, Int
12, Int
4, Int
30, Pico
0), (Integer
2014, Int
1, Int
1, Int
0, Int
0, Pico
0)) Grain
Second)
             [ Text
"by EOY"
             , Text
"by the EOY"
             , Text
"by end of the year"
             , Text
"by the end of year"
             ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples ((Datetime, Datetime) -> Grain -> Context -> TimeValue
datetimeInterval ((Integer
2013, Int
9, Int
1, Int
0, Int
0, Pico
0), (Integer
2014, Int
1, Int
1, Int
0, Int
0, Pico
0)) Grain
Month)
             [ Text
"EOY"
             , Text
"the EOY"
             , Text
"at the EOY"
             , Text
"the end of the year"
             , Text
"end of the year"
             , Text
"at the end of year"
             ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples ((Datetime, Datetime) -> Grain -> Context -> TimeValue
datetimeInterval ((Integer
2013, Int
2, Int
11, Int
0, Int
0, Pico
0), (Integer
2013, Int
2, Int
14, Int
0, Int
0, Pico
0)) Grain
Day)
             [ Text
"beginning of this week"
             , Text
"beginning of current week"
             , Text
"at the beginning of this week"
             , Text
"at the beginning of current week"
             ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples ((Datetime, Datetime) -> Grain -> Context -> TimeValue
datetimeInterval ((Integer
2013, Int
2, Int
18, Int
0, Int
0, Pico
0), (Integer
2013, Int
2, Int
21, Int
0, Int
0, Pico
0)) Grain
Day)
             [ Text
"beginning of coming week"
             , Text
"at the beginning of coming week"
             ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples ((Datetime, Datetime) -> Grain -> Context -> TimeValue
datetimeInterval ((Integer
2013, Int
2, Int
4, Int
0, Int
0, Pico
0), (Integer
2013, Int
2, Int
7, Int
0, Int
0, Pico
0)) Grain
Day)
             [ Text
"beginning of last week"
             , Text
"beginning of past week"
             , Text
"beginning of previous week"
             , Text
"at the beginning of last week"
             , Text
"at the beginning of past week"
             , Text
"at the beginning of previous week"
             ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples ((Datetime, Datetime) -> Grain -> Context -> TimeValue
datetimeInterval ((Integer
2013, Int
2, Int
18, Int
0, Int
0, Pico
0), (Integer
2013, Int
2, Int
21, Int
0, Int
0, Pico
0)) Grain
Day)
             [ Text
"beginning of next week"
             , Text
"beginning of the following week"
             , Text
"beginning of around next week"
             , Text
"at the beginning of next week"
             , Text
"at the beginning of the following week"
             , Text
"at the beginning of around next week"
             ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples ((Datetime, Datetime) -> Grain -> Context -> TimeValue
datetimeInterval ((Integer
2013, Int
2, Int
15, Int
0, Int
0, Pico
0), (Integer
2013, Int
2, Int
18, Int
0, Int
0, Pico
0)) Grain
Day)
             [ Text
"end of this week"
             , Text
"end of current week"
             , Text
"at the end of this week"
             , Text
"at the end of current week"
             ]
   , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples ((Datetime, Datetime) -> Grain -> Context -> TimeValue
datetimeInterval ((Integer
2013, Int
2, Int
22, Int
0, Int
0, Pico
0), (Integer
2013, Int
2, Int
25, Int
0, Int
0, Pico
0)) Grain
Day)
             [ Text
"end of coming week"
             , Text
"at the end of coming week"
             ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples ((Datetime, Datetime) -> Grain -> Context -> TimeValue
datetimeInterval ((Integer
2013, Int
2, Int
8, Int
0, Int
0, Pico
0), (Integer
2013, Int
2, Int
11, Int
0, Int
0, Pico
0)) Grain
Day)
             [ Text
"end of last week"
             , Text
"end of past week"
             , Text
"end of previous week"
             , Text
"at the end of last week"
             , Text
"at the end of past week"
             , Text
"at the end of previous week"
             ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples ((Datetime, Datetime) -> Grain -> Context -> TimeValue
datetimeInterval ((Integer
2013, Int
2, Int
22, Int
0, Int
0, Pico
0), (Integer
2013, Int
2, Int
25, Int
0, Int
0, Pico
0)) Grain
Day)
             [ Text
"end of next week"
             , Text
"end of the following week"
             , Text
"end of around next week"
             , Text
"at the end of next week"
             , Text
"at the end of the following week"
             , Text
"at the end of around next week"
             ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples (Datetime -> Grain -> Text -> Context -> TimeValue
datetimeHoliday (Integer
2014, Int
1, Int
31, Int
0, Int
0, Pico
0) Grain
Day Text
"Chinese New Year")
             [ Text
"chinese new year"
             , Text
"chinese lunar new year's day"
             ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples (Datetime -> Grain -> Text -> Context -> TimeValue
datetimeHoliday (Integer
2013, Int
2, Int
10, Int
0, Int
0, Pico
0) Grain
Day Text
"Chinese New Year")
             [ Text
"last chinese new year"
             , Text
"last chinese lunar new year's day"
             , Text
"last chinese new years"
             ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples (Datetime -> Grain -> Text -> Context -> TimeValue
datetimeHoliday (Integer
2018, Int
2, Int
16, Int
0, Int
0, Pico
0) Grain
Day Text
"Chinese New Year")
             [ Text
"chinese new year's day 2018"
             ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples (Datetime -> Grain -> Text -> Context -> TimeValue
datetimeHoliday (Integer
2018, Int
9, Int
18, Int
0, Int
0, Pico
0) Grain
Day Text
"Yom Kippur")
             [ Text
"yom kippur 2018"
             ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples (Datetime -> Grain -> Text -> Context -> TimeValue
datetimeHoliday (Integer
2018, Int
9, Int
30, Int
0, Int
0, Pico
0) Grain
Day Text
"Shemini Atzeret")
             [ Text
"shemini atzeret 2018"
             ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples (Datetime -> Grain -> Text -> Context -> TimeValue
datetimeHoliday (Integer
2018, Int
10, Int
1, Int
0, Int
0, Pico
0) Grain
Day Text
"Simchat Torah")
             [ Text
"simchat torah 2018"
             ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples (Datetime -> Grain -> Text -> Context -> TimeValue
datetimeHoliday (Integer
2018, Int
7, Int
21, Int
0, Int
0, Pico
0) Grain
Day Text
"Tisha B'Av")
             [ Text
"tisha b'av 2018"
             ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples (Datetime -> Grain -> Text -> Context -> TimeValue
datetimeHoliday (Integer
2018, Int
4, Int
18, Int
0, Int
0, Pico
0) Grain
Day Text
"Yom Ha'atzmaut")
             [ Text
"yom haatzmaut 2018"
             ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples (Datetime -> Grain -> Text -> Context -> TimeValue
datetimeHoliday (Integer
2017, Int
5, Int
13, Int
0, Int
0, Pico
0) Grain
Day Text
"Lag BaOmer")
             [ Text
"lag b'omer 2017"
             ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples (Datetime -> Grain -> Text -> Context -> TimeValue
datetimeHoliday (Integer
2018, Int
4, Int
11, Int
0, Int
0, Pico
0) Grain
Day Text
"Yom HaShoah")
             [ Text
"Yom Hashoah 2018"
             , Text
"Holocaust Day 2018"
             ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples ((Datetime, Datetime) -> Grain -> Text -> Context -> TimeValue
datetimeIntervalHoliday ((Integer
2018, Int
9, Int
9, Int
0, Int
0, Pico
0), (Integer
2018, Int
9, Int
12, Int
0, Int
0, Pico
0)) Grain
Day Text
"Rosh Hashanah")
             [ Text
"rosh hashanah 2018"
             , Text
"rosh hashana 2018"
             , Text
"rosh hashanna 2018"
             ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples ((Datetime, Datetime) -> Grain -> Text -> Context -> TimeValue
datetimeIntervalHoliday ((Integer
2018, Int
12, Int
2, Int
0, Int
0, Pico
0), (Integer
2018, Int
12, Int
10, Int
0, Int
0, Pico
0)) Grain
Day Text
"Hanukkah")
             [ Text
"Chanukah 2018"
             , Text
"hanukah 2018"
             , Text
"hannukkah 2018"
             ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples ((Datetime, Datetime) -> Grain -> Text -> Context -> TimeValue
datetimeIntervalHoliday ((Integer
2018, Int
3, Int
30, Int
0, Int
0, Pico
0), (Integer
2018, Int
4, Int
8, Int
0, Int
0, Pico
0)) Grain
Day Text
"Passover")
             [ Text
"passover 2018"
             ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples ((Datetime, Datetime) -> Grain -> Text -> Context -> TimeValue
datetimeIntervalHoliday ((Integer
2018, Int
9, Int
23, Int
0, Int
0, Pico
0), (Integer
2018, Int
10, Int
2, Int
0, Int
0, Pico
0)) Grain
Day Text
"Sukkot")
             [ Text
"feast of the ingathering 2018"
             , Text
"succos 2018"
             ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples ((Datetime, Datetime) -> Grain -> Text -> Context -> TimeValue
datetimeIntervalHoliday ((Integer
2018, Int
5, Int
19, Int
0, Int
0, Pico
0), (Integer
2018, Int
5, Int
22, Int
0, Int
0, Pico
0)) Grain
Day Text
"Shavuot")
             [ Text
"shavuot 2018"
             ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples (Datetime -> Grain -> Text -> Context -> TimeValue
datetimeHoliday (Integer
2017, Int
11, Int
30, Int
0, Int
0, Pico
0) Grain
Day Text
"Mawlid")
             [ Text
"mawlid al-nabawi 2017"
             ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples (Datetime -> Grain -> Text -> Context -> TimeValue
datetimeHoliday (Integer
1950, Int
7, Int
16, Int
0, Int
0, Pico
0) Grain
Day Text
"Eid al-Fitr")
             [ Text
"Eid al-Fitr 1950"
             ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples (Datetime -> Grain -> Text -> Context -> TimeValue
datetimeHoliday (Integer
1975, Int
10, Int
6, Int
0, Int
0, Pico
0) Grain
Day Text
"Eid al-Fitr")
             [ Text
"Eid al-Fitr 1975"
             ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples (Datetime -> Grain -> Text -> Context -> TimeValue
datetimeHoliday (Integer
1988, Int
5, Int
16, Int
0, Int
0, Pico
0) Grain
Day Text
"Eid al-Fitr")
             [ Text
"Eid al-Fitr 1988"
             ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples (Datetime -> Grain -> Text -> Context -> TimeValue
datetimeHoliday (Integer
2018, Int
6, Int
15, Int
0, Int
0, Pico
0) Grain
Day Text
"Eid al-Fitr")
             [ Text
"Eid al-Fitr 2018"
             ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples (Datetime -> Grain -> Text -> Context -> TimeValue
datetimeHoliday (Integer
2034, Int
12, Int
12, Int
0, Int
0, Pico
0) Grain
Day Text
"Eid al-Fitr")
             [ Text
"Eid al-Fitr 2034"
             ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples (Datetime -> Grain -> Text -> Context -> TimeValue
datetimeHoliday (Integer
2046, Int
8, Int
4, Int
0, Int
0, Pico
0) Grain
Day Text
"Eid al-Fitr")
             [ Text
"Eid al-Fitr 2046"
             ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples (Datetime -> Grain -> Text -> Context -> TimeValue
datetimeHoliday (Integer
2050, Int
6, Int
21, Int
0, Int
0, Pico
0) Grain
Day Text
"Eid al-Fitr")
             [ Text
"Eid al-Fitr 2050"
             ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples (Datetime -> Grain -> Text -> Context -> TimeValue
datetimeHoliday (Integer
2018, Int
8, Int
21, Int
0, Int
0, Pico
0) Grain
Day Text
"Eid al-Adha")
             [ Text
"Eid al-Adha 2018"
             , Text
"id ul-adha 2018"
             , Text
"sacrifice feast 2018"
             , Text
"Bakr Id 2018"
             ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples (Datetime -> Grain -> Text -> Context -> TimeValue
datetimeHoliday (Integer
1980, Int
10, Int
19, Int
0, Int
0, Pico
0) Grain
Day Text
"Eid al-Adha")
             [ Text
"Eid al-Adha 1980"
             , Text
"id ul-adha 1980"
             , Text
"sacrifice feast 1980"
             , Text
"Bakr Id 1980"
             ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples (Datetime -> Grain -> Text -> Context -> TimeValue
datetimeHoliday (Integer
1966, Int
4, Int
1, Int
0, Int
0, Pico
0) Grain
Day Text
"Eid al-Adha")
             [ Text
"Eid al-Adha 1966"
             , Text
"id ul-adha 1966"
             , Text
"sacrifice feast 1966"
             , Text
"Bakr Id 1966"
             ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples (Datetime -> Grain -> Text -> Context -> TimeValue
datetimeHoliday (Integer
1974, Int
1, Int
3, Int
0, Int
0, Pico
0) Grain
Day Text
"Eid al-Adha")
             [ Text
"Eid al-Adha 1974"
             , Text
"id ul-adha 1974"
             , Text
"sacrifice feast 1974"
             , Text
"Bakr Id 1974"
             ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples (Datetime -> Grain -> Text -> Context -> TimeValue
datetimeHoliday (Integer
2017, Int
6, Int
22, Int
0, Int
0, Pico
0) Grain
Day Text
"Laylat al-Qadr")
             [ Text
"laylat al kadr 2017"
             , Text
"night of measures 2017"
             ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples (Datetime -> Grain -> Text -> Context -> TimeValue
datetimeHoliday (Integer
2018, Int
6, Int
11, Int
0, Int
0, Pico
0) Grain
Day Text
"Laylat al-Qadr")
             [ Text
"laylat al-qadr 2018"
             , Text
"night of power 2018"
             ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples (Datetime -> Grain -> Text -> Context -> TimeValue
datetimeHoliday (Integer
2018, Int
9, Int
11, Int
0, Int
0, Pico
0) Grain
Day Text
"Islamic New Year")
             [ Text
"Islamic New Year 2018"
             , Text
"Amun Jadid 2018"
             ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples (Datetime -> Grain -> Text -> Context -> TimeValue
datetimeHoliday (Integer
2017, Int
9, Int
30, Int
0, Int
0, Pico
0) Grain
Day Text
"Ashura")
             [ Text
"day of Ashura 2017"
             ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples (Datetime -> Grain -> Text -> Context -> TimeValue
datetimeHoliday (Integer
2018, Int
1, Int
30, Int
0, Int
0, Pico
0) Grain
Day Text
"Tu BiShvat")
             [ Text
"tu bishvat 2018"
             ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples (Datetime -> Grain -> Text -> Context -> TimeValue
datetimeHoliday (Integer
2017, Int
6, Int
23, Int
0, Int
0, Pico
0) Grain
Day Text
"Jumu'atul-Wida")
             [ Text
"Jamat Ul-Vida 2017"
             , Text
"Jumu'atul-Wida 2017"
             ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples (Datetime -> Grain -> Text -> Context -> TimeValue
datetimeHoliday (Integer
2018, Int
6, Int
8, Int
0, Int
0, Pico
0) Grain
Day Text
"Jumu'atul-Wida")
             [ Text
"Jamat Ul-Vida 2018"
             , Text
"Jumu'atul-Wida 2018"
             ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples (Datetime -> Grain -> Text -> Context -> TimeValue
datetimeHoliday (Integer
2018, Int
4, Int
13, Int
0, Int
0, Pico
0) Grain
Day Text
"Isra and Mi'raj")
             [ Text
"isra and mi'raj 2018"
             , Text
"the prophet's ascension 2018"
             ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples (Datetime -> Grain -> Text -> Context -> TimeValue
datetimeHoliday (Integer
2019, Int
4, Int
3, Int
0, Int
0, Pico
0) Grain
Day Text
"Isra and Mi'raj")
             [ Text
"the night journey 2019"
             , Text
"ascension to heaven 2019"
             ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples ((Datetime, Datetime) -> Grain -> Text -> Context -> TimeValue
datetimeIntervalHoliday ((Integer
1950, Int
6, Int
17, Int
0, Int
0, Pico
0), (Integer
1950, Int
7, Int
16, Int
0, Int
0, Pico
0)) Grain
Day Text
"Ramadan")
             [ Text
"Ramadan 1950"
             ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples ((Datetime, Datetime) -> Grain -> Text -> Context -> TimeValue
datetimeIntervalHoliday ((Integer
1977, Int
8, Int
15, Int
0, Int
0, Pico
0), (Integer
1977, Int
9, Int
14, Int
0, Int
0, Pico
0)) Grain
Day Text
"Ramadan")
             [ Text
"Ramadan 1977"
             ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples ((Datetime, Datetime) -> Grain -> Text -> Context -> TimeValue
datetimeIntervalHoliday ((Integer
2018, Int
5, Int
16, Int
0, Int
0, Pico
0), (Integer
2018, Int
6, Int
15, Int
0, Int
0, Pico
0)) Grain
Day Text
"Ramadan")
             [ Text
"Ramadan 2018"
             ]
 , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples ((Datetime, Datetime) -> Grain -> Text -> Context -> TimeValue
datetimeIntervalHoliday ((Integer
2034, Int
11, Int
12, Int
0, Int
0, Pico
0), (Integer
2034, Int
12, Int
12, Int
0, Int
0, Pico
0)) Grain
Day Text
"Ramadan")
             [ Text
"Ramadan 2034"
             ]
 , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples ((Datetime, Datetime) -> Grain -> Text -> Context -> TimeValue
datetimeIntervalHoliday ((Integer
2046, Int
7, Int
5, Int
0, Int
0, Pico
0), (Integer
2046, Int
8, Int
4, Int
0, Int
0, Pico
0)) Grain
Day Text
"Ramadan")
             [ Text
"Ramadan 2046"
             ]
 , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples ((Datetime, Datetime) -> Grain -> Text -> Context -> TimeValue
datetimeIntervalHoliday ((Integer
2050, Int
5, Int
22, Int
0, Int
0, Pico
0), (Integer
2050, Int
6, Int
21, Int
0, Int
0, Pico
0)) Grain
Day Text
"Ramadan")
             [ Text
"Ramadan 2050"
             ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples (Datetime -> Grain -> Text -> Context -> TimeValue
datetimeHoliday (Integer
2017, Int
10, Int
17, Int
0, Int
0, Pico
0) Grain
Day Text
"Dhanteras")
             [ Text
"dhanatrayodashi in 2017"
             ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples (Datetime -> Grain -> Text -> Context -> TimeValue
datetimeHoliday (Integer
2019, Int
10, Int
25, Int
0, Int
0, Pico
0) Grain
Day Text
"Dhanteras")
             [ Text
"dhanteras 2019"
             ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples (Datetime -> Grain -> Text -> Context -> TimeValue
datetimeHoliday (Integer
2019, Int
10, Int
26, Int
0, Int
0, Pico
0) Grain
Day Text
"Naraka Chaturdashi")
             [ Text
"kali chaudas 2019"
             , Text
"choti diwali two thousand nineteen"
             ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples (Datetime -> Grain -> Text -> Context -> TimeValue
datetimeHoliday (Integer
2019, Int
10, Int
27, Int
0, Int
0, Pico
0) Grain
Day Text
"Diwali")
             [ Text
"diwali 2019"
             , Text
"Deepavali in 2019"
             , Text
"Lakshmi Puja six years hence"
             ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples (Datetime -> Grain -> Text -> Context -> TimeValue
datetimeHoliday (Integer
2019, Int
10, Int
29, Int
0, Int
0, Pico
0) Grain
Day Text
"Bhai Dooj")
             [ Text
"bhai dooj 2019"
             ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples (Datetime -> Grain -> Text -> Context -> TimeValue
datetimeHoliday (Integer
2019, Int
11, Int
2, Int
0, Int
0, Pico
0) Grain
Day Text
"Chhath")
             [ Text
"chhath 2019"
             , Text
"dala puja 2019"
             , Text
"Surya Shashthi in 2019"
             ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples (Datetime -> Grain -> Text -> Context -> TimeValue
datetimeHoliday (Integer
2021, Int
10, Int
12, Int
0, Int
0, Pico
0) Grain
Day Text
"Maha Saptami")
             [ Text
"Maha Saptami 2021"
             ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples (Datetime -> Grain -> Text -> Context -> TimeValue
datetimeHoliday (Integer
2018, Int
10, Int
18, Int
0, Int
0, Pico
0) Grain
Day Text
"Vijayadashami")
             [ Text
"Dussehra 2018"
             , Text
"vijayadashami in five years"
             ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples ((Datetime, Datetime) -> Grain -> Text -> Context -> TimeValue
datetimeIntervalHoliday ((Integer
2018, Int
10, Int
9, Int
0, Int
0, Pico
0), (Integer
2018, Int
10, Int
19, Int
0, Int
0, Pico
0)) Grain
Day Text
"Navaratri")
             [ Text
"navaratri 2018"
             , Text
"durga puja in 2018"
             ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples (Datetime -> Grain -> Text -> Context -> TimeValue
datetimeHoliday (Integer
2018, Int
10, Int
27, Int
0, Int
0, Pico
0) Grain
Day Text
"Karva Chauth")
             [ Text
"karva chauth 2018"
             , Text
"karva chauth in 2018"
             ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples (Datetime -> Grain -> Text -> Context -> TimeValue
datetimeHoliday (Integer
2018, Int
7, Int
14, Int
0, Int
0, Pico
0) Grain
Day Text
"Ratha-Yatra")
             [ Text
"ratha-yatra 2018"
             ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples (Datetime -> Grain -> Text -> Context -> TimeValue
datetimeHoliday (Integer
2018, Int
8, Int
26, Int
0, Int
0, Pico
0) Grain
Day Text
"Raksha Bandhan")
             [ Text
"rakhi 2018"
             ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples (Datetime -> Grain -> Text -> Context -> TimeValue
datetimeHoliday (Integer
2020, Int
4, Int
6, Int
0, Int
0, Pico
0) Grain
Day Text
"Mahavir Jayanti")
             [ Text
"mahavir jayanti 2020"
             , Text
"mahaveer janma kalyanak 2020"
             ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples (Datetime -> Grain -> Text -> Context -> TimeValue
datetimeHoliday (Integer
2020, Int
2, Int
21, Int
0, Int
0, Pico
0) Grain
Day Text
"Maha Shivaratri")
              [ Text
"maha shivaratri 2020"
              ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples (Datetime -> Grain -> Text -> Context -> TimeValue
datetimeHoliday (Integer
2018, Int
2, Int
10, Int
0, Int
0, Pico
0) Grain
Day Text
"Dayananda Saraswati Jayanti")
             [ Text
"saraswati jayanti 2018"
             ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples (Datetime -> Grain -> Text -> Context -> TimeValue
datetimeHoliday (Integer
2018, Int
1, Int
14, Int
0, Int
0, Pico
0) Grain
Day Text
"Thai Pongal")
             [ Text
"pongal 2018"
             , Text
"makara sankranthi 2018"
             ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples (Datetime -> Grain -> Text -> Context -> TimeValue
datetimeHoliday (Integer
2018, Int
1, Int
13, Int
0, Int
0, Pico
0) Grain
Day Text
"Boghi")
             [ Text
"bogi pandigai 2018"
             ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples (Datetime -> Grain -> Text -> Context -> TimeValue
datetimeHoliday (Integer
2018, Int
1, Int
15, Int
0, Int
0, Pico
0) Grain
Day Text
"Mattu Pongal")
             [ Text
"maattu pongal 2018"
             ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples (Datetime -> Grain -> Text -> Context -> TimeValue
datetimeHoliday (Integer
2018, Int
1, Int
16, Int
0, Int
0, Pico
0) Grain
Day Text
"Kaanum Pongal")
             [ Text
"kaanum pongal 2018"
             , Text
"kanni pongal 2018"
             ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples (Datetime -> Grain -> Text -> Context -> TimeValue
datetimeHoliday (Integer
2019, Int
1, Int
15, Int
0, Int
0, Pico
0) Grain
Day Text
"Thai Pongal")
             [ Text
"makar sankranti 2019"
             , Text
"maghi in 2019"
             ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples (Datetime -> Grain -> Text -> Context -> TimeValue
datetimeHoliday (Integer
2018, Int
4, Int
14, Int
0, Int
0, Pico
0) Grain
Day Text
"Vaisakhi")
             [ Text
"Vaisakhi 2018"
             , Text
"baisakhi in 2018"
             , Text
"Vasakhi 2018"
             , Text
"vaishakhi 2018"
             ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples (Datetime -> Grain -> Text -> Context -> TimeValue
datetimeHoliday (Integer
2018, Int
8, Int
24, Int
0, Int
0, Pico
0) Grain
Day Text
"Thiru Onam")
             [ Text
"onam 2018"
             , Text
"Thiru Onam 2018"
             , Text
"Thiruvonam 2018"
             ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples (Datetime -> Grain -> Text -> Context -> TimeValue
datetimeHoliday (Integer
2019, Int
2, Int
10, Int
0, Int
0, Pico
0) Grain
Day Text
"Vasant Panchami")
             [ Text
"vasant panchami in 2019"
             , Text
"basant panchami 2019"
             ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples (Datetime -> Grain -> Text -> Context -> TimeValue
datetimeHoliday (Integer
2019, Int
3, Int
20, Int
0, Int
0, Pico
0) Grain
Day Text
"Holika Dahan")
             [ Text
"chhoti holi 2019"
             , Text
"holika dahan 2019"
             , Text
"kamudu pyre 2019"
             ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples (Datetime -> Grain -> Text -> Context -> TimeValue
datetimeHoliday (Integer
2019, Int
8, Int
23, Int
0, Int
0, Pico
0) Grain
Day Text
"Krishna Janmashtami")
            [ Text
"krishna janmashtami 2019"
            , Text
"gokulashtami 2019"
            ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples (Datetime -> Grain -> Text -> Context -> TimeValue
datetimeHoliday (Integer
2019, Int
3, Int
21, Int
0, Int
0, Pico
0) Grain
Day Text
"Holi")
             [ Text
"holi 2019"
             , Text
"dhulandi 2019"
             , Text
"phagwah 2019"
             ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples (Datetime -> Grain -> Text -> Context -> TimeValue
datetimeHoliday (Integer
2018, Int
8, Int
17, Int
0, Int
0, Pico
0) Grain
Day Text
"Parsi New Year")
             [ Text
"Parsi New Year 2018"
             , Text
"Jamshedi Navroz 2018"
             ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples (Datetime -> Grain -> Text -> Context -> TimeValue
datetimeHoliday (Integer
2022, Int
8, Int
16, Int
0, Int
0, Pico
0) Grain
Day Text
"Parsi New Year")
             [ Text
"jamshedi Navroz 2022"
             , Text
"parsi new year 2022"
             ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples ((Datetime, Datetime) -> Grain -> Text -> Context -> TimeValue
datetimeIntervalHoliday ((Integer
2013, Int
4, Int
26, Int
0, Int
0, Pico
0), (Integer
2013, Int
4, Int
29, Int
0, Int
0, Pico
0)) Grain
Day Text
"Global Youth Service Day")
             [ Text
"GYSD 2013"
             , Text
"global youth service day"
             ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples (Datetime -> Grain -> Text -> Context -> TimeValue
datetimeHoliday (Integer
2013, Int
5, Int
24, Int
0, Int
0, Pico
0) Grain
Day Text
"Vesak")
             [ Text
"vesak"
             , Text
"vaisakha"
             , Text
"Buddha day"
             , Text
"Buddha Purnima"
             ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples ((Datetime, Datetime) -> Grain -> Text -> Context -> TimeValue
datetimeIntervalHoliday ((Integer
2013, Int
3, Int
23, Int
20, Int
30, Pico
0), (Integer
2013, Int
3, Int
23, Int
21, Int
31, Pico
0)) Grain
Minute Text
"Earth Hour")
             [ Text
"earth hour"
             ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples ((Datetime, Datetime) -> Grain -> Text -> Context -> TimeValue
datetimeIntervalHoliday ((Integer
2016, Int
3, Int
19, Int
20, Int
30, Pico
0), (Integer
2016, Int
3, Int
19, Int
21, Int
31, Pico
0)) Grain
Minute Text
"Earth Hour")
             [ Text
"earth hour 2016"
             ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples (Datetime -> Grain -> Text -> Context -> TimeValue
datetimeHoliday (Integer
2013, Int
2, Int
23, Int
0, Int
0, Pico
0) Grain
Day Text
"Purim")
             [ Text
"purim"
             ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples (Datetime -> Grain -> Text -> Context -> TimeValue
datetimeHoliday (Integer
2013, Int
2, Int
24, Int
0, Int
0, Pico
0) Grain
Day Text
"Shushan Purim")
             [ Text
"Shushan Purim"
             ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples (Datetime -> Grain -> Text -> Context -> TimeValue
datetimeHoliday (Integer
2014, Int
1, Int
7, Int
0, Int
0, Pico
0) Grain
Day Text
"Guru Gobind Singh Jayanti")
             [ Text
"guru gobind singh birthday"
             , Text
"guru gobind singh jayanti 2014"
             , Text
"guru gobind singh jayanti"
             , Text
"Guru Govind Singh Jayanti"
             ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples (Datetime -> Grain -> Text -> Context -> TimeValue
datetimeHoliday (Integer
2018, Int
4, Int
27, Int
0, Int
0, Pico
0) Grain
Day Text
"King's Day")
            [ Text
"Koningsdag 2018"
            , Text
"koningsdag 2018"
            , Text
"king's day 2018"
            , Text
"King's Day 2018"
            ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples (Datetime -> Grain -> Text -> Context -> TimeValue
datetimeHoliday (Integer
2014, Int
4, Int
26, Int
0, Int
0, Pico
0) Grain
Day Text
"King's Day")
            [ Text
"Koningsdag 2014"
            , Text
"koningsdag 2014"
            , Text
"King's Day 2014"
            , Text
"king's day 2014"
            ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples (Datetime -> Grain -> Text -> Context -> TimeValue
datetimeHoliday (Integer
2018, Int
5, Int
9, Int
0, Int
0, Pico
0) Grain
Day Text
"Rabindra Jayanti")
            [ Text
"rabindra jayanti 2018"
            , Text
"Rabindranath Jayanti 2018"
            , Text
"Rabindra Jayanti 2018"
            ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples (Datetime -> Grain -> Text -> Context -> TimeValue
datetimeHoliday (Integer
2019, Int
5, Int
9, Int
0, Int
0, Pico
0) Grain
Day Text
"Rabindra Jayanti")
            [ Text
"rabindra jayanti 2019"
            , Text
"Rabindranath Jayanti 2019"
            , Text
"Rabindra Jayanti 2019"
            ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples (Datetime -> Grain -> Text -> Context -> TimeValue
datetimeHoliday (Integer
2018, Int
1, Int
31, Int
0, Int
0, Pico
0) Grain
Day Text
"Guru Ravidass Jayanti")
            [ Text
"guru Ravidas jayanti 2018"
            , Text
"Guru Ravidass birthday 2018"
            , Text
"guru ravidass Jayanti 2018"
            ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples (Datetime -> Grain -> Text -> Context -> TimeValue
datetimeHoliday (Integer
2019, Int
2, Int
19, Int
0, Int
0, Pico
0) Grain
Day Text
"Guru Ravidass Jayanti")
            [ Text
"Guru Ravidass Jayanti 2019"
            , Text
"Guru Ravidas Birthday 2019"
            , Text
"guru ravidas jayanti 2019"
            ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples (Datetime -> Grain -> Text -> Context -> TimeValue
datetimeHoliday (Integer
2019, Int
10, Int
13, Int
0, Int
0, Pico
0) Grain
Day Text
"Pargat Diwas")
            [ Text
"valmiki jayanti 2019"
            , Text
"Valmiki Jayanti 2019"
            , Text
"pargat diwas 2019"
            ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples (Datetime -> Grain -> Text -> Context -> TimeValue
datetimeHoliday (Integer
2018, Int
10, Int
24, Int
0, Int
0, Pico
0) Grain
Day Text
"Pargat Diwas")
            [ Text
"maharishi valmiki jayanti 2018"
            , Text
"pargat diwas 2018"
            , Text
"Pargat Diwas 2018"
            ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples (Datetime -> Grain -> Text -> Context -> TimeValue
datetimeHoliday (Integer
2019, Int
9, Int
2, Int
0, Int
0, Pico
0) Grain
Day Text
"Ganesh Chaturthi")
            [ Text
"ganesh chaturthi 2019"
            ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples (Datetime -> Grain -> Text -> Context -> TimeValue
datetimeHoliday (Integer
2020, Int
4, Int
2, Int
0, Int
0, Pico
0) Grain
Day Text
"Rama Navami")
            [ Text
"rama navami 2020"
            ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples (Datetime -> Grain -> Text -> Context -> TimeValue
datetimeHoliday (Integer
2018, Int
3, Int
18, Int
0, Int
0, Pico
0) Grain
Day Text
"Ugadi")
            [ Text
"Ugadi 2018"
            , Text
"ugadi 2018"
            , Text
"yugadi 2018"
            , Text
"Yugadi 2018"
            , Text
"samvatsaradi 2018"
            , Text
"chaitra sukladi 2018"
            , Text
"chaitra sukhladi 2018"
            ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples (Datetime -> Grain -> Text -> Context -> TimeValue
datetimeHoliday (Integer
2012, Int
12, Int
25, Int
0, Int
0, Pico
0) Grain
Day Text
"Christmas")
            [ Text
"the closest xmas to today"
            ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples (Datetime -> Grain -> Text -> Context -> TimeValue
datetimeHoliday (Integer
2013, Int
12, Int
25, Int
0, Int
0, Pico
0) Grain
Day Text
"Christmas")
            [ Text
"the second closest xmas to today"
            ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples (Datetime -> Grain -> Text -> Context -> TimeValue
datetimeHoliday (Integer
2011, Int
12, Int
25, Int
0, Int
0, Pico
0) Grain
Day Text
"Christmas")
            [ Text
"the 3rd closest xmas to today"
            ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples (Datetime -> Grain -> Context -> TimeValue
datetime (Integer
2013, Int
10, Int
25, Int
0, Int
0, Pico
0) Grain
Day)
            [ Text
"last friday of october"
            , Text
"last friday in october"
            ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples (Datetime -> Grain -> Context -> TimeValue
datetime (Integer
2013, Int
2, Int
25, Int
0, Int
0, Pico
0) Grain
Week)
            [ Text
"upcoming two weeks"
            , Text
"upcoming two week"
            , Text
"upcoming 2 weeks"
            , Text
"upcoming 2 week"
            , Text
"two upcoming weeks"
            , Text
"two upcoming week"
            , Text
"2 upcoming weeks"
            , Text
"2 upcoming week"
            ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples (Datetime -> Grain -> Context -> TimeValue
datetime (Integer
2013, Int
2, Int
14, Int
0, Int
0, Pico
0) Grain
Day)
            [ Text
"upcoming two days"
            , Text
"upcoming two day"
            , Text
"upcoming 2 days"
            , Text
"upcoming 2 day"
            , Text
"two upcoming days"
            , Text
"two upcoming day"
            , Text
"2 upcoming days"
            , Text
"2 upcoming day"
            ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples (Datetime -> Grain -> Context -> TimeValue
datetime (Integer
2013, Int
4, Int
1, Int
0, Int
0, Pico
0) Grain
Month)
            [ Text
"upcoming two months"
            , Text
"upcoming two month"
            , Text
"upcoming 2 months"
            , Text
"upcoming 2 month"
            , Text
"two upcoming months"
            , Text
"two upcoming month"
            , Text
"2 upcoming months"
            , Text
"2 upcoming month"
            ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples (Datetime -> Grain -> Context -> TimeValue
datetime (Integer
2013, Int
7, Int
1, Int
0, Int
0, Pico
0) Grain
Quarter)
            [ Text
"upcoming two quarters"
            , Text
"upcoming two quarter"
            , Text
"upcoming 2 quarters"
            , Text
"upcoming 2 quarter"
            , Text
"two upcoming quarters"
            , Text
"two upcoming quarter"
            , Text
"2 upcoming quarters"
            , Text
"2 upcoming quarter"
            ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples (Datetime -> Grain -> Context -> TimeValue
datetime (Integer
2015, Int
1, Int
1, Int
0, Int
0, Pico
0) Grain
Year)
            [ Text
"upcoming two years"
            , Text
"upcoming two year"
            , Text
"upcoming 2 years"
            , Text
"upcoming 2 year"
            , Text
"two upcoming years"
            , Text
"two upcoming year"
            , Text
"2 upcoming years"
            , Text
"2 upcoming year"
            ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples (Datetime -> Grain -> Context -> TimeValue
datetime (Integer
2013, Int
2, Int
13, Int
13, Int
40, Pico
0) Grain
Minute)
             [ Text
"20 minutes to 2pm tomorrow"
             ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples (Datetime -> Grain -> Context -> TimeValue
datetime (Integer
2013, Int
1, Int
7, Int
0, Int
0, Pico
0) Grain
Day)
             [
               Text
"first monday of last month"
             ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples (Datetime -> Grain -> Context -> TimeValue
datetime (Integer
2013, Int
1, Int
1, Int
0, Int
0, Pico
0) Grain
Day)
             [
               Text
"first tuesday of last month"
             ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples (Datetime -> Grain -> Context -> TimeValue
datetime (Integer
2013, Int
1, Int
14, Int
0, Int
0, Pico
0) Grain
Day)
             [
               Text
"second monday of last month"
             ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples (Datetime -> Grain -> Context -> TimeValue
datetime (Integer
2013, Int
2, Int
23, Int
0, Int
0, Pico
0) Grain
Day)
             [ Text
"next saturday" ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples (Datetime -> Grain -> Context -> TimeValue
datetime (Integer
2013, Int
2, Int
18, Int
0, Int
0, Pico
0) Grain
Day)
             [ Text
"next monday" ]
  ]