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

-- /Note/: All commented-out tests are failing due to https://github.com/facebook/duckling/issues/541
module Duckling.Time.KA.Corpus
  ( corpus
  , defaultCorpus
  , latentCorpus
  ) where

import Data.String
import Prelude

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

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

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

latentCorpus :: Corpus
latentCorpus :: Corpus
latentCorpus = (Context
testContext {locale :: Locale
locale = Lang -> Maybe Region -> Locale
makeLocale Lang
KA Maybe Region
forall a. Maybe a
Nothing},
  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
"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
7, Int
0, Pico
0) Grain
Hour)
                 [ Text
"7 საათზე"
                 ]
      , (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
"მაისი"
                 ]
      ]

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
"ეხლა"
             ]
  , (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
"დღეს"
             ]
  , (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
Day)
             [ 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
"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
"გუშინ"
             ]
  , (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
"ხვალე"
             ]
  , (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
"ეს ორშაბათი"
             ]
  , (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
"სამშაბათი"
             ]
  , (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
"ხუთშაბათი"
             ]
  , (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
"პარასკევი"
             ]
  , (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
"შაბათი"
             ]
  , (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
"კვირა"
             ]
  , (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
"1-ლი მარტი"
             , Text
"პირველი მარტი"
             ]
  , (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
"3 მარტი"
             ]
  , (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
"3 მარტი 2015"
             , Text
"2015 წლის მე-3 მარტი"
             , 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
"15 თებერვალი"
             , Text
"თებერვლის მეთხუთმეტე დღეს"
             , Text
"თხუთმეტი თებერვალი"
             ]
  , (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
"8 აგვისტო"
             ]
  , (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
"2014 წლის ოქტომბერი"
             ]
  , (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
"14 აპრილი 2015"
             , Text
"2015 წლის 14 აპრილი"
             , Text
"2015 წლის 14 აპრილს"
             ]
  , (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
0, Int
0, Pico
0) Grain
Day)
             [ 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
"შემდეგის შემდეგი პარასკევი"
             ]
  , (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
"შემდეგი მარტი"
             ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples (Datetime -> Grain -> Context -> TimeValue
datetime (Integer
2015, Int
3, Int
1, Int
0, Int
0, Pico
0) Grain
Month)
             [ 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
1, Int
0, Int
0, Pico
0), (Integer
2013, Int
2, Int
1, Int
0, Int
0, Pico
0)) Grain
Month)
             [ 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
1, Int
0, Int
0, Pico
0), (Integer
2013, Int
4, Int
1, Int
0, Int
0, Pico
0)) Grain
Month)
             [ Text
"შემდეგი თვე"
             ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples ((Datetime, Datetime) -> Grain -> Context -> TimeValue
datetimeInterval ((Integer
2013, Int
4, Int
1, Int
0, Int
0, Pico
0), (Integer
2013, Int
7, Int
1, Int
0, Int
0, Pico
0)) Grain
Quarter)
             [ Text
"შემდეგ კვარტალში"
             ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples ((Datetime, Datetime) -> Grain -> Context -> TimeValue
datetimeInterval ((Integer
2012, 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
"შარშან"
             , Text
"წინა წელს"
             ]
  , (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
2015, 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
2, Int
10, Int
0, Int
0, Pico
0) Grain
Day)
             [ 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
"ბოლო სამშაბათს"
             ]
  , (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
0, Int
0, Pico
0) Grain
Day)
             [ 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
"შემდეგი ოთხშაბათი"
             ]
  , (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
"შემდეგი კვირის ოთხშაბათი"
             ]
  , (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
"შემდეგის შემდეგი პარასკევი"
             ]
  , (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
"გუშინწინ"
             ]
  , (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
"გუშინწინ8-ზე"
             ]
  , (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
"მარტის ბოლო ორშაბათი"
             ]
  , (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
"ოქტომბრის მესამე დღე"
             , Text
"ოქტომბრის მე-3 დღე"
             ]
  , (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
"ოქტომბრის პირველი სამშაბათი"
             , Text
"ოქტომბრის 1-ლი სამშაბათი"
             ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples (Datetime -> Grain -> Context -> TimeValue
datetime (Integer
2013, Int
9, Int
17, Int
0, Int
0, Pico
0) Grain
Day)
             [ Text
"სექტემბრის მესამე სამშაბათი"
             , Text
"სექტემბრის მე-3 სამშაბათი"
             ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples (Datetime -> Grain -> Context -> TimeValue
datetime (Integer
2013, Int
10, Int
2, Int
0, Int
0, Pico
0) Grain
Day)
             [ Text
"ოქტომბრის პირველი ოთხშაბათი"
             , Text
"ოქტომბრის 1-ლი ოთხშაბათი"
             ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples (Datetime -> Grain -> Context -> TimeValue
datetime (Integer
2013, Int
10, Int
9, Int
0, Int
0, Pico
0) Grain
Day)
             [ Text
"ოქტომბრის მეორე ოთხშაბათი"
             , Text
"ოქტომბრის მე-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
3, Int
18, Pico
0) Grain
Minute)
             [ Text
"3:18am"
             , Text
"3:18a"
             ]
  , (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
"15 საათზე"
             , Text
"3PM"
             , Text
"3pm"
             ]
  , (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
"4-ის 15 წუთზე"
             , Text
"3 საათსა და 15 წუთზე"
             , Text
"15:15"
             , Text
"3:15pm"
             , Text
"3:15PM"
             , Text
"3:15p"
             ]
  , (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
"15 საათსა და 20 წუთზე"
             , Text
"4-ის 20 წუთზე"
             , Text
"3:20p"
             ]
  , (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
"4-ის ნახევარზე"
             , Text
"15 საათსა და 30 წუთზე"
             , Text
"15:30"
             , Text
"3:30pm"
             , Text
"3:30PM"
             , Text
"330 p.m."
             , Text
"3:30 p m"
             , Text
"3:30"
             ]
  , (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
"11 საათსა და 45 წუთზე"
             , Text
"11:45am"
             ]
  , (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
"20 საათი"
             , Text
"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
"შაბათს 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
"შაბათს 9 საათზე"
             ]
  , (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 დღის წინ"
             , Text
"შვიდი დღის წინ"
             ]
  , (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 დღის წინ"
             , 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
"1 კვირის წინ"
             , Text
"ერთი კვირის წინ"
             ]
  , (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
"3 კვირის წინ"
             , Text
"სამი კვირის წინ"
             ]
  , (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
"სამი თვის წინ"
             , Text
"3 თვის წინ"
             ]
  , (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
"ორი წლის წინ"
             , Text
"ორი წლის წინ"
             ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples ((Datetime, Datetime) -> Grain -> Context -> TimeValue
datetimeInterval ((Integer
2013, Int
6, Int
1, Int
0, Int
0, Pico
0), (Integer
2013, Int
9, Int
1, Int
0, Int
0, Pico
0)) Grain
Day)
             [ 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
1, Int
0, Int
0, Pico
0), (Integer
2013, Int
3, Int
1, Int
0, Int
0, Pico
0)) Grain
Day)
             [ Text
"ამ ზამთარს"
             , Text
"ამ ზამთარში"
             ]
  , (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
"წინა სეზონზე"
             ]
  , (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
"გუშინ ღამე"
             , 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
11, Int
21, Int
0, Pico
0), (Integer
2013, Int
2, Int
12, 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
12, Int
18, Int
0, Pico
0), (Integer
2013, Int
2, Int
13, 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
9, Int
0, Int
0, Pico
0), (Integer
2013, Int
2, Int
11, Int
0, Int
0, Pico
0)) Grain
Day)
             [ 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
18, Int
0, Pico
0), (Integer
2013, Int
2, Int
14, Int
0, Int
0, Pico
0)) Grain
Hour)
             [ 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
11, Int
18, Int
0, Pico
0), (Integer
2013, Int
2, Int
12, Int
0, Int
0, Pico
0)) Grain
Hour)
             [ 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
16, Int
0, Int
0, Pico
0), (Integer
2013, Int
2, Int
18, Int
0, Int
0, Pico
0)) Grain
Day)
             [ 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
"ორშაბათს დილა"
             ]
  , (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
"15 თებერვალი დილა"
             , Text
"15 თებერვალს დილას"
             , Text
"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
4, Int
29, Pico
58), (Integer
2013, Int
2, Int
12, Int
4, Int
30, Pico
1)) Grain
Second)
             [ Text
"ბოლო 2 წამი"
             , Text
"ბოლო 2 წამში"
             ]
  , (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
"ივლისი 13-15"
             , Text
"13-15 ივლისი"
             ]
  , (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
"8-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
14, Int
9, Int
30, Pico
0), (Integer
2013, Int
2, Int
14, Int
11, Int
1, Pico
0)) Grain
Minute)
             [ Text
"ხუთშაბათი 9:30-დან 11:00-მდე"
             -- , "ხუთშაბათს 10-ის ნახევრიდან 11: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
12, Int
4, Int
30, Pico
0), (Integer
2013, Int
2, Int
26, Int
0, Int
0, Pico
0)) Grain
Second)
             [ Text
"ორი კვირის განმავლობაში"
             , Text
"2 კვირის განმავლობაში"
             ]
  , (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
"თვის ბოლო"
             , 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
14, Int
0, Pico
0) Grain
Hour)
             [ Text
"დღეს შუადღის 2-ზე"
             , Text
"დღეს დღის 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
"ხვალ დღის 3-ზე"
             -- , "ხვალ დღის სამზე"
             ]
  , (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
"საღამოს"
             , 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
30, Pico
0) Grain
Minute)
             [ Text
"1 საათსა და 30 წუთზე"
             , Text
"2-ის ნახევარზე"
             , Text
"2-ის ნახევარი"
             , Text
"1 საათი და 30 წუთი"
             ]
  , (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
"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
4, Int
0, Pico
0), (Integer
2013, Int
2, Int
12, Int
12, Int
0, Pico
0)) Grain
Hour)
             [ 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
"ორშაბათს"
             ]
  , (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
"12 საათი"
             , Text
"12 საათზე"
             , Text
"დღის 12 საათზე"
             ]
  , (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
"მარტი"
             ]
  , (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
"ხვალ დღის 5"
             , Text
"ხვალ შუადღის 5"
             , Text
"ხვალ დღის 5-ზე"
             , Text
"ხვალ შუადღის 5-ზე"
             , Text
"ხვალ დღის 5 საათი"
             , Text
"ხვალ შუადღის 5 საათი"
             , Text
"ხვალ დღის 5 საათზე"
             , Text
"ხვალ შუადღის 5 საათზე"
             ]
  , (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
"დილის 10 საათსა და 30 წუთზე"
             , Text
"დილის 10 საათი და 30 წუთი"
             ]
  , (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
"დღეს ღამის 11"
             , Text
"დღეს ღამის 11-ზე"
             , Text
"დღეს ღამის 11 საათი"
             , Text
"დღეს ღამის 11 საათზე"
             ]
  , (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)
             [ Text
"4:23-ზე"
             ]
  , (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
"მარტის დასაწყისი"
             , 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
11, Int
0, Int
0, Pico
0), (Integer
2013, Int
3, Int
21, Int
0, Int
0, Pico
0)) Grain
Day)
             [ 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
21, Int
0, Int
0, Pico
0), (Integer
2013, Int
4, Int
1, Int
0, Int
0, Pico
0)) Grain
Day)
             [ Text
"მარტის ბოლო"
             ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples ((Datetime, Datetime) -> Grain -> Context -> TimeValue
datetimeInterval ((Integer
2013, Int
10, Int
26, Int
0, Int
0, Pico
0), (Integer
2013, Int
10, Int
28, Int
0, Int
0, Pico
0)) Grain
Day)
             [ Text
"ოქტომბრის ბოლო უქმეები"
             , Text
"ოქტომბრის ბოლო შაბათ-კვირა"
             ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples ((Datetime, Datetime) -> Grain -> Context -> TimeValue
datetimeInterval ((Integer
2017, Int
12, Int
23, Int
0, Int
0, Pico
0), (Integer
2017, Int
12, Int
25, Int
0, Int
0, Pico
0)) Grain
Day)
             [ Text
"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
"27-29 აგვისტო"
             ]
  , (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
"23-26 ოქტომბერი"
             ]
  , (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 სექტემბერი"
             ]
  , (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-16 სექტემბერი"
             ]
  , (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
"19-21 აგვისტო"
             ]
  , (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
"აპრილის ბოლო"
             ]
  , (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
"იანვრის დასაწყისი"
             ]
  , (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
"წლის დასაწყისი"
             , 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
1, Int
0, Int
0, Pico
0), (Integer
2013, Int
2, Int
1, Int
0, Int
0, Pico
0)) Grain
Month)
             [ Text
"გასულ ორ თვეში"
             , Text
"გასულ 2 თვეში"
             , Text
"გასულ 2 თვეს"
             ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples ((Datetime, Datetime) -> Grain -> Context -> TimeValue
datetimeInterval ((Integer
2013, Int
1, Int
21, Int
0, Int
0, Pico
0), (Integer
2013, Int
2, Int
11, Int
0, Int
0, Pico
0)) Grain
Week)
             [ Text
"გასული 3 კვირა"
             ]
{-
  , examples (datetimeInterval ((2013, 5, 1, 0, 0, 0), (2013, 6, 1, 0, 0, 0)) Month)
             [ "მიმდინარე წლის მაისში"
             , "წელს მაისში"
             ]
-}
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples ((Datetime, Datetime) -> Grain -> Context -> TimeValue
datetimeInterval ((Integer
2013, Int
4, Int
1, Int
0, Int
0, Pico
0), (Integer
2013, Int
7, Int
1, Int
0, Int
0, Pico
0)) Grain
Quarter)
             [ Text
"წელს მეორე კვარტალში"
             ]
  ]