-- 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.ZH.Corpus
  ( corpus
  , defaultCorpus
  ) where

import Data.String
import Prelude

import Duckling.Locale
import Duckling.Resolve
import Duckling.Time.Corpus
import Duckling.TimeGrain.Types hiding (add)
import Duckling.Testing.Types hiding (examples)

defaultCorpus :: Corpus
defaultCorpus :: Corpus
defaultCorpus = Corpus
corpus

corpus :: Corpus
corpus :: Corpus
corpus = (Context
testContext {locale :: Locale
locale = Lang -> Maybe Region -> Locale
makeLocale Lang
ZH Maybe Region
forall a. Maybe a
Nothing}, Options
testOptions, [Example]
allExamples)

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
"现在"
             , Text
"此时"
             , Text
"此刻"
             , Text
"当前"
             , Text
"現在"
             , Text
"此時"
             , Text
"當前"
             , Text
"宜家"
             , Text
"而家"
             , Text
"依家"
             ]
  , (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
"今天"
             , Text
"今日"
             ]
  , (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
"昨天"
             , Text
"昨日"
             , Text
"尋日"
             ]
  , (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
"明天"
             , Text
"明日"
             , Text
"聽日"
             ]
  , (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
"后天"
             , Text
"後天"
             , Text
"後日"
             ]
  , (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
"大後日"
             , Text
"大後天"
             ]
  , (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
"前天"
             , Text
"前日"
             ]
  , (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
"星期一"
             , Text
"礼拜一"
             , Text
"周一"
             , Text
"禮拜一"
             , Text
"週一"
             ]
  , (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
"星期二"
             , Text
"礼拜二"
             , Text
"周二"
             , Text
"禮拜二"
             , Text
"週二"
             ]
  , (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
"星期三"
             , Text
"礼拜三"
             , Text
"周三"
             , Text
"禮拜三"
             , Text
"週三"
             ]
  , (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
"星期四"
             , Text
"礼拜四"
             , Text
"周四"
             , Text
"禮拜四"
             , Text
"週四"
             ]
  , (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
"星期五"
             , Text
"礼拜五"
             , Text
"周五"
             , Text
"禮拜五"
             , Text
"週五"
             ]
  , (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
"星期六"
             , Text
"礼拜六"
             , Text
"周六"
             , Text
"禮拜六"
             , Text
"週六"
             ]
  , (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
"星期日"
             , Text
"星期天"
             , Text
"礼拜天"
             , Text
"周日"
             , Text
"禮拜天"
             , Text
"週日"
             ]
  , (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
"这周末"
             , Text
"這週末"
             ]
  , (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
4, Int
0, Pico
0), (Integer
2013, Int
2, Int
18, Int
12, Int
0, Pico
0)) Grain
Hour)
             [ Text
"周一早上"
             , Text
"周一早晨"
             , Text
"礼拜一早上"
             , Text
"礼拜一早晨"
             , Text
"週一早上"
             , Text
"週一早晨"
             , Text
"禮拜一早上"
             , Text
"禮拜一早晨"
             ]
  , (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
"上周日"
             , Text
"上星期天"
             , Text
"上礼拜天"
             , Text
"上週日"
             , Text
"上星期天"
             , Text
"上禮拜天"
             , Text
"上禮拜日"
             ]
  , (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
"周日, 二月十号"
             , Text
"星期天, 二月十号"
             , Text
"礼拜天, 二月十号"
             , Text
"週日, 二月十號"
             , Text
"星期天, 二月十號"
             , Text
"禮拜天, 二月十號"
             , Text
"禮拜日, 二月十號"
             ]
  , (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
"十月第一个星期一"
             , Text
"十月的第一个星期一"
             , Text
"十月第一個星期一"
             , Text
"十月的第一個星期一"
             ]
  , (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
"上周二"
             , Text
"上礼拜二"
             , Text
"上週二"
             , Text
"上禮拜二"
             , Text
"上星期二"
             ]
  , (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
"三月一号"
             , Text
"三月一日"
             , Text
"三月一號"
             ]
  , (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
"2015年3月3号"
             , Text
"2015年3月三号"
             , Text
"2015年三月3号"
             , Text
"2015年三月三号"
             , Text
"2015年3月3號"
             , Text
"2015年3月三號"
             , Text
"2015年三月3號"
             , Text
"2015年三月三號"
             , Text
"3/3/2015"
             , Text
"3/3/15"
             , Text
"2015-3-3"
             , Text
"2015-03-03"
             , Text
"二零一五年三月三號"
             ]
  , (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
"2013年2月15号"
             , Text
"2013年二月十五号"
             , Text
"2月15号"
             , Text
"二月十五号"
             , Text
"2013年2月15號"
             , Text
"2013年二月十五號"
             , Text
"2月15號"
             , Text
"二月十五號"
             , Text
"2/15"
             , Text
"二零一三年二月十五號"
             ]
  , (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"
             ]
  , (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
4, Int
0, Pico
0), (Integer
2013, Int
2, Int
15, Int
12, Int
0, Pico
0)) Grain
Hour)
             [ Text
"二月十五号早上"
             , Text
"二月十五号早晨"
             , Text
"2月15号早上"
             , Text
"2月15号早晨"
             , Text
"二月十五號早上"
             , Text
"二月十五號早晨"
             , 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
2013, Int
2, Int
19, Int
0, Int
0, Pico
0) Grain
Day)
             [ Text
"下周二"
             , Text
"下週二"
             , Text
"下星期二"
             , Text
"下禮拜二"
             , Text
"下礼拜二"
             ]
  , (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
"这周三"
             , Text
"这礼拜三"
             , Text
"這週三"
             , Text
"這禮拜三"
             , Text
"今個星期三"
             , Text
"今個礼拜三"
             , Text
"今個禮拜三"
             ]
  , (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
"下周三"
             , Text
"下礼拜三"
             , Text
"下週三"
             , Text
"下禮拜三"
             , Text
"下星期三"
             ]
  , (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
"这周一"
             , Text
"这礼拜一"
             , Text
"這週一"
             , Text
"這禮拜一"
             , Text
"今個星期一"
             , Text
"今個礼拜一"
             , Text
"今個禮拜一"
             ]
  , (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
"这周二"
             , Text
"这礼拜二"
             , Text
"這週二"
             , Text
"這禮拜二"
             , Text
"今個星期二"
             , Text
"今個礼拜二"
             , Text
"今個禮拜二"
             , Text
"今星期二"
             , Text
"今礼拜二"
             , Text
"今禮拜二"
             ]
  , (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
"这周"
             , Text
"这一周"
             , Text
"这礼拜"
             , Text
"这一礼拜"
             , Text
"這週"
             , Text
"這一周"
             , Text
"這禮拜"
             , Text
"這一禮拜"
             , Text
"今個星期"
             , Text
"今個礼拜"
             , Text
"今個禮拜"
             ]
  , (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
"上周"
             , Text
"上週"
             , Text
"上個星期"
             , Text
"上個礼拜"
             , Text
"上個禮拜"
             ]
  , (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
"下周"
             , Text
"下週"
             , Text
"下星期"
             , Text
"下礼拜"
             , Text
"下禮拜"
             ]
  , (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
"上月"
             , Text
"上个月"
             , Text
"上個月"
             ]
  , (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
"下月"
             , Text
"下个月"
             , Text
"下個月"
             , Text
"3月"
             , Text
"3月份"
             , Text
"三月"
             ]
  , (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
"今個月二十號"
             , Text
"今個月20号"
             , Text
"今個月廿號"
             ]
  , (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
"下個月二十號"
             , Text
"下個月20号"
             , Text
"下個月廿號"
             ]
  , (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
"去年"
             , Text
"上年"
             ]
  , (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
"今年"
             , Text
"这一年"
             , Text
"這一年"
             ]
  , (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
"明年"
             , Text
"下年"
             ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples (Datetime -> Grain -> Context -> TimeValue
datetime (Integer
2014, Int
9, Int
1, Int
0, Int
0, Pico
0) Grain
Month)
             [ Text
"下年9月"
             , Text
"明年九月"
             ]
  , (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
"上两秒"
             , Text
"上二秒"
             , Text
"前两秒"
             , Text
"前二秒"
             , Text
"上兩秒"
             , Text
"前兩秒"
             , Text
"兩秒前"
             , Text
"兩秒之前"
             ]
  , (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
"下三秒"
             , Text
"后三秒"
             , Text
"後三秒"
             , Text
"三秒後"
             , Text
"三秒之後"
             ]
  , (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
"上两分钟"
             , Text
"上二分钟"
             , Text
"前两分钟"
             , Text
"前二分钟"
             , Text
"上兩分鐘"
             , Text
"上二分鐘"
             , Text
"前兩分鐘"
             , Text
"前二分鐘"
             , Text
"兩分鐘前"
             , Text
"兩分鐘之前"
             ]
  , (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
"下三分钟"
             , Text
"后三分钟"
             , Text
"下三分鐘"
             , Text
"後三分鐘"
             , Text
"三分鐘後"
             , Text
"三分鐘之後"
             ]
  , (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
2, Int
0, Pico
0), (Integer
2013, Int
2, Int
12, Int
4, Int
0, Pico
0)) Grain
Hour)
             [ Text
"上两小时"
             , Text
"上二小时"
             , Text
"前两小时"
             , Text
"前二小时"
             , Text
"上兩小時"
             , Text
"上二小時"
             , Text
"前兩小時"
             , Text
"前二小時"
             , Text
"兩小時之前"
             , Text
"兩個鐘之前"
             , Text
"兩小時前"
             , Text
"兩個鐘前"
             ]
  , (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
"下三小时"
             , Text
"后三小时"
             , Text
"下三小時"
             , Text
"後三小時"
             , Text
"三小時之後"
             , Text
"三個鐘之後"
             , Text
"三小時後"
             , Text
"三個鐘後"
             ]
  , (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
"上两天"
             , Text
"前两天"
             , Text
"上兩天"
             , Text
"前兩天"
             , Text
"兩天前"
             , Text
"兩天之前"
             , Text
"兩日前"
             , Text
"兩日之前"
             ]
  , (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
"下三天"
             , Text
"后三天"
             , Text
"後三天"
             , Text
"三天後"
             , Text
"三天之後"
             , Text
"三日後"
             , Text
"三日之後"
             ]
  , (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
"上两周"
             , Text
"上二周"
             , Text
"上兩週"
             , Text
"上二週"
             , Text
"兩星期前"
             , Text
"兩星期之前"
             , Text
"兩個禮拜前"
             , Text
"兩個禮拜之前"
             ]
  , (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
"下三周"
             , Text
"下三个周"
             , Text
"下三週"
             , Text
"下三個週"
             , Text
"三星期後"
             , Text
"三星期之後"
             , Text
"三個禮拜後"
             , Text
"三個禮拜之後"
             ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples ((Datetime, Datetime) -> Grain -> Context -> TimeValue
datetimeInterval ((Integer
2012, Int
12, Int
0, Int
0, Int
0, Pico
0), (Integer
2013, Int
2, Int
0, Int
0, Int
0, Pico
0)) Grain
Month)
             [ Text
"上两个月"
             , Text
"上二个月"
             , Text
"前两个月"
             , Text
"前二个月"
             , Text
"前两月"
             , Text
"上兩個月"
             , Text
"上二個月"
             , Text
"前兩個月"
             , Text
"前二個月"
             , Text
"前兩月"
             , Text
"兩個月前"
             , Text
"兩個月之前"
             ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples ((Datetime, Datetime) -> Grain -> Context -> TimeValue
datetimeInterval ((Integer
2013, Int
3, Int
0, Int
0, Int
0, Pico
0), (Integer
2013, Int
6, Int
0, Int
0, Int
0, Pico
0)) Grain
Month)
             [ Text
"下三个月"
             , Text
"后三个月"
             , Text
"後三個月"
             , Text
"三個月後"
             , Text
"三個月之後"
             ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples ((Datetime, Datetime) -> Grain -> Context -> TimeValue
datetimeInterval ((Integer
2011, Int
0, Int
0, Int
0, Int
0, Pico
0), (Integer
2013, Int
0, Int
0, Int
0, Int
0, Pico
0)) Grain
Year)
             [ Text
"前两年"
             , Text
"前兩年"
             , Text
"兩年前"
             , Text
"兩年之前"
             ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples ((Datetime, Datetime) -> Grain -> Context -> TimeValue
datetimeInterval ((Integer
2014, Int
0, Int
0, Int
0, Int
0, Pico
0), (Integer
2017, Int
0, Int
0, Int
0, Int
0, Pico
0)) Grain
Year)
             [ Text
"下三年"
             , Text
"三年後"
             , Text
"三年之後"
             ]
  , (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
"三点"
             , Text
"三點"
             , Text
"3pm"
             , Text
"下午三點"
             , Text
"晏晝三點"
             , Text
"下午三時"
             ]
  , (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
"下午三点十五"
             , Text
"下午3:15"
             , Text
"15:15"
             , Text
"3:15pm"
             , Text
"3:15PM"
             , Text
"3:15p"
             , Text
"下午三點十五"
             , Text
"晏晝三點十五"
             , Text
"下午三点十五分"
             , Text
"下午三點十五分"
             , Text
"晏晝三點十五分"
             , Text
"晏晝三點三"
             , Text
"晏晝三點踏三"
             , Text
"晏晝三點搭三"
             , Text
"晏晝三點三個字"
             ]
  , (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
05, Pico
0) Grain
Minute)
             [ Text
"下午三点零五"
             , Text
"下午3:05"
             , Text
"15:05"
             , Text
"3:05pm"
             , Text
"3:05PM"
             , Text
"3:05p"
             , Text
"下午三點零五"
             , Text
"晏晝三點零五"
             , Text
"下午三点零五分"
             , Text
"下午三點零五分"
             , Text
"晏晝三點零五分"
             , Text
"晏晝三點一"
             , Text
"晏晝三點踏一"
             , Text
"晏晝三點搭一"
             , Text
"晏晝三點一個字"
             ]
  , (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
"下午三点半"
             , Text
"下午3:30"
             , Text
"15:30"
             , Text
"3:30pm"
             , Text
"3:30PM"
             , Text
"3:30p"
             , Text
"下午三點半"
             , Text
"晏晝三點半"
             , Text
"下午三点三十分"
             , Text
"下午三點三十分"
             , Text
"晏晝三點三十分"
             , Text
"晏晝三點踏半"
             , Text
"晏晝三點搭半"
             ]
  , (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
2015, Int
4, Int
14, Int
0, Int
0, Pico
0) Grain
Day)
             [ Text
"2015年4月14号"
             , Text
"2015年4月14號"
             ]
  , (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点"
             , Text
"今晚八点"
             , Text
"今晚8點"
             , Text
"今晚八點"
             ]
  , (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
"元旦")
             [ Text
"元旦"
             , Text
"元旦节"
             , Text
"元旦節"
             , Text
"阳历新年"
             ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples (Datetime -> Grain -> Text -> Context -> TimeValue
datetimeHoliday (Integer
2013, Int
3, Int
8, Int
0, Int
0, Pico
0) Grain
Day Text
"妇女节")
             [ Text
"妇女节"
             , Text
"婦女節"
             ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples (Datetime -> Grain -> Text -> Context -> TimeValue
datetimeHoliday (Integer
2013, Int
5, Int
1, Int
0, Int
0, Pico
0) Grain
Day Text
"劳动节")
             [ Text
"劳动节"
             , Text
"勞動節"
             , Text
"五一国际劳动节"
             ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples (Datetime -> Grain -> Text -> Context -> TimeValue
datetimeHoliday (Integer
2013, Int
6, Int
1, Int
0, Int
0, Pico
0) Grain
Day Text
"儿童节")
             [ Text
"儿童节"
             , Text
"兒童節"
             , Text
"国际儿童节"
             ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples (Datetime -> Grain -> Text -> Context -> TimeValue
datetimeHoliday (Integer
2013, Int
8, Int
1, Int
0, Int
0, Pico
0) Grain
Day Text
"建军节")
             [ Text
"建军节"
             , Text
"八一建軍節"
             , Text
"建軍節"
             ]
  , (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
"圣诞节")
             [ Text
"圣诞"
             , Text
"聖誕"
             , Text
"圣诞节"
             , Text
"聖誕節"
             ]
  , (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
"愚人节")
             [ Text
"愚人节"
             , Text
"愚人節"
             ]
  , (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
"万圣节")
             [ Text
"万圣节"
             , Text
"萬聖節"
             ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples (Datetime -> Grain -> Text -> Context -> TimeValue
datetimeHoliday (Integer
2013, Int
12, Int
20, Int
0, Int
0, Pico
0) Grain
Day Text
"澳门回归纪念日")
             [ Text
"澳门回归纪念日"
             , Text
"澳門回歸紀念日"
             ]
  , (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
"情人节")
             [ Text
"情人节"
             , Text
"情人節"
             , Text
"圣瓦伦丁节"
             ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples (Datetime -> Grain -> Text -> Context -> TimeValue
datetimeHoliday (Integer
2013, Int
3, Int
15, Int
0, Int
0, Pico
0) Grain
Day Text
"国际消费者权益日")
             [ Text
"国际消费者权益日"
             , Text
"国际消費者權益日"
             , Text
"三一五"
             ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples (Datetime -> Grain -> Text -> Context -> TimeValue
datetimeHoliday (Integer
2013, Int
6, Int
1, Int
15, Int
15, Pico
0) Grain
Minute Text
"儿童节")
             [ Text
"儿童节下午三点十五"
             , Text
"兒童節下午三點十五"
             ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples ((Datetime, Datetime) -> Grain -> Text -> Context -> TimeValue
datetimeIntervalHoliday ((Integer
2013, Int
2, Int
14, Int
18, Int
0, Pico
0), (Integer
2013, Int
2, Int
15, Int
0, Int
0, Pico
0)) Grain
Hour Text
"情人节")
             [ Text
"情人节晚上"
             , Text
"情人節晚上"
             ]
   , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples (Datetime -> Grain -> Text -> Context -> TimeValue
datetimeHoliday (Integer
2013, Int
9, Int
13, Int
0, Int
0, Pico
0) Grain
Day Text
"赎罪日")
            [ Text
"赎罪日"
            , Text
"贖罪日"
            ]
 , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples (Datetime -> Grain -> Text -> Context -> TimeValue
datetimeHoliday (Integer
2013, Int
9, Int
13, Int
0, Int
0, Pico
0) Grain
Day Text
"赎罪日")
            [ Text
"赎罪日"
            , Text
"贖罪日"
            ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples (Datetime -> Grain -> Text -> Context -> TimeValue
datetimeHoliday (Integer
2013, Int
2, Int
13, Int
0, Int
0, Pico
0) Grain
Day Text
"大斋首日")
             [ Text
"大斋首日"
             , Text
"聖灰星期三"
             , Text
"灰日"
             , Text
"圣灰礼仪日"
             , Text
"圣灰日"
             ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples (Datetime -> Grain -> Text -> Context -> TimeValue
datetimeHoliday (Integer
2013, Int
11, Int
13, Int
0, Int
0, Pico
0) Grain
Day Text
"阿舒拉节")
             [ Text
"阿舒拉節"
             ]
  -- wiki says 11/8
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples (Datetime -> Grain -> Text -> Context -> TimeValue
datetimeHoliday (Integer
2013, Int
11, Int
9, Int
0, Int
0, Pico
0) Grain
Day Text
"克哈特普迦节")
             [ Text
"克哈特普迦节"
             ]
   , (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
"春节")
             [ Text
"春节"
             , Text
"农历新年"
             , Text
"新春"
             , Text
"正月正时"
             , Text
"正月朔日"
             , Text
"正月正時"
             ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples (Datetime -> Grain -> Text -> Context -> TimeValue
datetimeHoliday (Integer
2013, Int
5, Int
30, Int
0, Int
0, Pico
0) Grain
Day Text
"基督圣体节")
             [ Text
"基督聖體节"
             , Text
"基督聖體聖血瞻礼"
             , Text
"基督聖體聖血節"
             ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples (Datetime -> Grain -> Text -> Context -> TimeValue
datetimeHoliday (Integer
2013, Int
11, Int
3, Int
0, Int
0, Pico
0) Grain
Day Text
"排灯节")
             [ Text
"万灯节"
             , Text
"印度燈節"
             , Text
"排灯节"
             ]
  , (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
"复活节星期一")
             [ Text
"复活节星期一"
             , Text
"復活節星期一"
             ]
  , (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
"复活节")
             [ Text
"复活节"
             , Text
"復活節"
             , Text
"主復活日"
             ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples (Datetime -> Grain -> Text -> Context -> TimeValue
datetimeHoliday (Integer
2013, Int
10, Int
15, Int
0, Int
0, Pico
0) Grain
Day Text
"古尔邦节")
             [ Text
"古尔邦节"
             , Text
"古爾邦節"
             , Text
"宰牲节"
             ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples (Datetime -> Grain -> Text -> Context -> TimeValue
datetimeHoliday (Integer
2013, Int
8, Int
8, Int
0, Int
0, Pico
0) Grain
Day Text
"开斋节")
             [ Text
"开斋节"
             , Text
"開齋節"
             , Text
"肉孜节"
             , Text
"尔代节"
             , Text
"爾代節"
             ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples (Datetime -> Grain -> Text -> Context -> TimeValue
datetimeHoliday (Integer
2013, Int
3, Int
29, Int
0, Int
0, Pico
0) Grain
Day Text
"耶稣受难日")
             [ Text
"主受难日"
             , Text
"主受难节"
             , Text
"沈默周五"
             , Text
"聖週五"
             , Text
"耶穌受難日"
             ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples (Datetime -> Grain -> Text -> Context -> TimeValue
datetimeHoliday (Integer
2013, Int
3, Int
26, Int
0, Int
0, Pico
0) Grain
Day Text
"侯丽节")
             [ Text
"侯丽节"
             , Text
"荷麗节"
             , Text
"洒红节"
             , Text
"灑紅节"
             , Text
"欢悦节"
             , Text
"五彩節"
             , Text
"胡里节"
             , Text
"好利节"
             , Text
"霍利節"
             ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples (Datetime -> Grain -> Text -> Context -> TimeValue
datetimeHoliday (Integer
2013, Int
3, Int
30, Int
0, Int
0, Pico
0) Grain
Day Text
"圣周六")
             [ Text
"神圣周六"
             , Text
"聖週六"
             , Text
"耶稣受难日翌日"
             , Text
"主受難節翌日"
             , Text
"復活節前夜"
             , Text
"黑色星期六"
             ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples (Datetime -> Grain -> Text -> Context -> TimeValue
datetimeHoliday (Integer
2013, Int
11, Int
4, Int
0, Int
0, Pico
0) Grain
Day Text
"伊斯兰新年")
             [ Text
"伊斯兰新年"
             , Text
"伊斯兰教新年"
             , Text
"伊斯兰历新年"
             ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples (Datetime -> Grain -> Text -> Context -> TimeValue
datetimeHoliday (Integer
2013, Int
6, Int
6, Int
0, Int
0, Pico
0) Grain
Day Text
"登霄节")
             [ Text
"登霄节"
             , Text
"夜行登霄節"
             ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples (Datetime -> Grain -> Text -> Context -> TimeValue
datetimeHoliday (Integer
2014, Int
1, Int
16, Int
0, Int
0, Pico
0) Grain
Day Text
"印度丰收节第四天")
             [ Text
"印度丰收节第四天"
             , Text
"龐格爾節第四天"
             , Text
"庞格尔节第四天"
             ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples (Datetime -> Grain -> Text -> Context -> TimeValue
datetimeHoliday (Integer
2013, Int
4, Int
27, Int
0, Int
0, Pico
0) Grain
Day Text
"篝火节")
             [ Text
"篝火节"
             , Text
"犹太教篝火节"
             , Text
"猶太教篝火節"
             ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples (Datetime -> Grain -> Text -> Context -> TimeValue
datetimeHoliday (Integer
2013, Int
8, Int
4, Int
0, Int
0, Pico
0) Grain
Day Text
"法令之夜")
             [ Text
"法令之夜"
             , Text
"权力之夜"
             ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples (Datetime -> Grain -> Text -> Context -> TimeValue
datetimeHoliday (Integer
2013, Int
4, Int
27, Int
0, Int
0, Pico
0) Grain
Day Text
"拉撒路圣周六")
             [ Text
"拉撒路聖週六"
             , Text
"拉匝路周六"
             ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples (Datetime -> Grain -> Text -> Context -> TimeValue
datetimeHoliday (Integer
2014, Int
1, Int
15, Int
0, Int
0, Pico
0) Grain
Day Text
"印度丰收节第三天")
             [ Text
"印度丰收节第三天"
             , Text
"龐格爾節第三天"
             , Text
"庞格尔节第三天"
             ]
  , (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
"神圣星期四")
             [ Text
"濯足節"
             , Text
"神聖星期四"
             , Text
"圣周星期四"
             , Text
"圣周四"
             , Text
"設立聖餐日"
             ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples (Datetime -> Grain -> Text -> Context -> TimeValue
datetimeHoliday (Integer
2014, Int
1, Int
13, Int
0, Int
0, Pico
0) Grain
Day Text
"圣纪节")
             [ Text
"圣纪节"
             , Text
"聖紀節"
             ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples (Datetime -> Grain -> Text -> Context -> TimeValue
datetimeHoliday (Integer
2013, Int
5, Int
6, Int
0, Int
0, Pico
0) Grain
Day Text
"东正教复活节星期一")
             [ Text
"东正教复活节星期一"
             , Text
"東正教復活節星期一"
             ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples (Datetime -> Grain -> Text -> Context -> TimeValue
datetimeHoliday (Integer
2013, Int
5, Int
4, Int
0, Int
0, Pico
0) Grain
Day Text
"东正教圣周六")
             [ Text
"東正教神聖週六"
             , Text
"東正教聖週六"
             , Text
"東正教耶稣受难日翌日"
             , Text
"東正教主受難節翌日"
             , Text
"東正教复活节前夜"
             ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples (Datetime -> Grain -> Text -> Context -> TimeValue
datetimeHoliday (Integer
2013, Int
5, Int
3, Int
0, Int
0, Pico
0) Grain
Day Text
"东正教耶稣受难日")
             [ Text
"東正教耶穌受难日"
             , Text
"东正教主受难节"
             , Text
"东正教圣周五"
             , Text
"東正教聖週五"
             , Text
"東正教沈默週五"
             ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples (Datetime -> Grain -> Text -> Context -> TimeValue
datetimeHoliday (Integer
2013, Int
4, Int
28, Int
0, Int
0, Pico
0) Grain
Day Text
"东正教棕枝主日")
             [ Text
"东正教棕枝主日"
             , Text
"东正教圣枝主日"
             , Text
"东正教聖樹主日"
             , Text
"東正教基督苦難主日"
             ]
  , (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
"棕枝主日")
             [ Text
"棕枝主日"
             , Text
"圣枝主日"
             , Text
"聖樹主日"
             , Text
"基督苦難主日"
             ]
  , (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
"五旬节")
             [ Text
"五旬节"
             , Text
"圣灵降临节"
             , Text
"聖靈降臨日"
             ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples (Datetime -> Grain -> Text -> Context -> TimeValue
datetimeHoliday (Integer
2013, Int
8, Int
20, Int
0, Int
0, Pico
0) Grain
Day Text
"印度兄妹节")
             [ Text
"印度兄妹节"
             , Text
"拉克沙班丹節"
             ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples (Datetime -> Grain -> Text -> Context -> TimeValue
datetimeHoliday (Integer
2013, Int
9, Int
25, Int
0, Int
0, Pico
0) Grain
Day Text
"圣会节")
              [ Text
"圣会节"
              , Text
"聖会節"
              ]
   , (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
"忏悔节")
              [ Text
"忏悔節"
              , Text
"忏悔火曜日"
              , Text
"煎餅星期二"
              ]
   , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples (Datetime -> Grain -> Text -> Context -> TimeValue
datetimeHoliday (Integer
2013, Int
9, Int
26, Int
0, Int
0, Pico
0) Grain
Day Text
"西赫托拉节")
              [ Text
"西赫托拉节"
              , Text
"西赫妥拉节"
              , Text
"诵经节"
              , Text
"誦經节"
              , Text
"转经节"
              , Text
"轉經節"
              , Text
"律法節"
              , Text
"歡慶聖法節"
              ]
   , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples (Datetime -> Grain -> Text -> Context -> TimeValue
datetimeHoliday (Integer
2014, Int
1, Int
14, Int
0, Int
0, Pico
0) Grain
Day Text
"印度丰收节")
              [ Text
"印度丰收节"
              , Text
"淡米爾豐收節"
              , Text
"淡米尔丰收节"
              ]
   , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples (Datetime -> Grain -> Text -> Context -> TimeValue
datetimeHoliday (Integer
2013, Int
8, Int
20, Int
0, Int
0, Pico
0) Grain
Day Text
"欧南节")
              [ Text
"欧南节"
              , Text
"欧南節"
              ]
   , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples (Datetime -> Grain -> Text -> Context -> TimeValue
datetimeHoliday (Integer
2013, Int
7, Int
15, Int
0, Int
0, Pico
0) Grain
Day Text
"圣殿被毁日")
              [ Text
"圣殿被毁日"
              , Text
"禁食日"
              , Text
"聖殿被毁日"
              ]
   , (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
"圣三一主日")
              [ Text
"圣三一主日"
              , Text
"天主三一主日"
              , Text
"天主聖三一节"
              , Text
"聖三主日"
              , Text
"圣三节"
              ]
   , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples (Datetime -> Grain -> Text -> Context -> TimeValue
datetimeHoliday (Integer
2013, Int
10, Int
14, Int
0, Int
0, Pico
0) Grain
Day Text
"十胜节")
              [ Text
"十勝節"
              , Text
"凯旋节"
              , Text
"圣母节"
              ]
   , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples (Datetime -> Grain -> Text -> Context -> TimeValue
datetimeHoliday (Integer
2014, Int
1, Int
15, Int
0, Int
0, Pico
0) Grain
Day Text
"犹太植树节")
              [ Text
"犹太植树节"
              , Text
"猶太植樹節"
              , Text
"图比舍巴特节"
              , Text
"圖比舍巴特節"
              , Text
"树木新年"
              , Text
"樹木新年"
              ]
   , (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
"卫塞节")
              [ Text
"卫塞节"
              , Text
"衛塞節"
              , Text
"威瑟节"
              , Text
"比萨宝蕉节"
              , Text
"比薩寶蕉節"
              ]
   , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples (Datetime -> Grain -> Text -> Context -> TimeValue
datetimeHoliday (Integer
2013, Int
4, Int
15, Int
0, Int
0, Pico
0) Grain
Day Text
"以色列独立日")
              [ Text
"以色列独立日"
              , Text
"以色列獨立日"
              , Text
"以色列国庆节"
              , Text
"以色列國慶節"
              ]
   , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples (Datetime -> Grain -> Text -> Context -> TimeValue
datetimeHoliday (Integer
2013, Int
9, Int
13, Int
0, Int
0, Pico
0) Grain
Day Text
"赎罪日")
              [ Text
"赎罪日"
              , Text
"贖罪日"
              ]
   , (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
"圣灵节庆日")
              [ Text
"圣灵节庆日"
              , Text
"聖靈節慶日"
              ]
   , (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
"老板节")
              [ Text
"老板节"
              , Text
"老闆節"
              ]
   , (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
"全球青年服务日")
              [ Text
"全球青年服务日"
              , Text
"全球青年服務日"
              ]
   , (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
"四旬节")
              [ Text
"2018年四旬节"
              , Text
"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
"光明节")
              [ Text
"2018年光明节"
              , Text
"2018年修殿节"
              , Text
"2018年献殿节"
              , Text
"2018年獻殿节"
              , Text
"2018年烛光节"
              , Text
"2018年哈努卡节"
              , Text
"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
14, Int
0, Int
0, Pico
0), (Integer
2018, Int
4, Int
1, Int
0, Int
0, Pico
0)) Grain
Day Text
"大斋期")
              [ Text
"2018年大斋期"
              , Text
"2018年大齋節"
              , Text
"2018年大斋节"
              ]
    , (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
"九夜节")
               [ Text
"2018年九夜节"
               , Text
"2018年难近母节"
               , Text
"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
"逾越节")
              [ Text
"2018年逾越节"
              , Text
"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
"斋月")
               [ Text
"2034年斋月"
               , Text
"2034年穆斯林斋月"
               , Text
"2034年穆斯林齋月"
               ]
   , (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
"犹太新年")
              [ Text
"2018年犹太新年"
              , Text
"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
"七七节")
             [ Text
"2018年七七节"
             , Text
"2018年沙夫幼特节"
             , Text
"2018年週日節"
             , Text
"2018年收获节"
             , Text
"2018年新果实节"
             , Text
"2018年新果實節"
             , Text
"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
"住棚节")
              [ Text
"2018年住棚节"
              , Text
"2018年住棚節"
              ]
  , (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
"地球一小时")
             [ Text
"2016年地球一小时"
             , Text
"2016年地球一小時"
             ]
  ]