-- 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.EL.Corpus
  ( corpus
  , negativeCorpus
  ) 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 hiding (add)

context :: Context
context :: Context
context = Context
testContext {locale :: Locale
locale = Lang -> Maybe Region -> Locale
makeLocale Lang
EL Maybe Region
forall a. Maybe a
Nothing}

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

negativeCorpus :: NegativeCorpus
negativeCorpus :: NegativeCorpus
negativeCorpus = (Context
context, Options
testOptions, [Text]
examples)
  where
    examples :: [Text]
examples =
      [ Text
"ένας ενήληκας"
      , 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
1, Int
0, Int
0, Pico
0) Grain
Day)
             [ Text
"1/2/2013"
             ]
  , (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
"τώρα αμέσως"
             ]
  , (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
"Δευτέρα, 18 Φεβρουαρίου"
             , Text
"Δευτ, 18 Φλεβάρη"
             , Text
"18 Φεβρουαρίου, Δευτ"
             ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples (Datetime -> Grain -> Context -> TimeValue
datetime (Integer
2013, Int
2, Int
19, Int
0, Int
0, Pico
0) Grain
Day)
             [ Text
"Τρίτη η 19η Φλεβάρη"
             , Text
"Τρίτη, 19 Φεβρουαρίου"
             , Text
"19 Φεβρουαρίου, Τρίτη"
             , 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
"Πεμ"
             , 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
"την παρασκευή"
             ]
  , (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
"την σάββάτον"
             ]
  , (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
"την κυριακή"
             ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples (Datetime -> Grain -> Context -> TimeValue
datetime (Integer
2013, Int
8, Int
13, Int
0, Int
0, Pico
0) Grain
Day)
             [ Text
"Τρίτη, 13η Αυγούστου"
             ]
  , (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
Month)
             [ 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
1, 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 -> Grain -> Context -> TimeValue
datetime (Integer
2013, Int
3, Int
1, Int
0, Int
0, Pico
0) Grain
Month)
             [ 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
4, Int
1, 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 -> Grain -> Context -> TimeValue
datetime (Integer
2013, Int
5, Int
1, Int
0, Int
0, Pico
0) Grain
Month)
             [ 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
6, Int
1, 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 -> Grain -> Context -> TimeValue
datetime (Integer
2013, Int
7, Int
1, Int
0, Int
0, Pico
0) Grain
Month)
             [ 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
8, 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
9, 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
10, Int
1, 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 -> Grain -> Context -> TimeValue
datetime (Integer
2013, Int
11, Int
1, 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 -> Grain -> Context -> TimeValue
datetime (Integer
2013, Int
12, Int
1, 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 -> 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
2013, Int
4, Int
3, 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
2014, Int
1, Int
3, 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
3, 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
3, 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
5, Int
3, 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
9, Int
3, Int
0, Int
0, Pico
0) Grain
Day)
             [ Text
"3 σεπτέμβρη"
             , Text
"3 σεπτεμβρίου"
             , Text
"τρίτη σεπτεμβρίου 2013"
             ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples (Datetime -> Grain -> Context -> TimeValue
datetime (Integer
2013, Int
9, Int
3, Int
0, Int
0, Pico
0) Grain
Day)
             [ Text
"3 σεπτέμβρη"
             , Text
"3 σεπτεμβρίου"
             , Text
"τρίτη σεπτεμβρίου"
             , Text
"τρίτη σεπτεμβρίου 2013"
             ]
  , (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
"τρίτη οκτώβρη"
             ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples (Datetime -> Grain -> Context -> TimeValue
datetime (Integer
2013, Int
10, Int
5, 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
9, Int
3, Int
0, Int
0, Pico
0) Grain
Day)
             [ Text
"3 σεπτέμβρη"
             , Text
"3 σεπτεμβρίου"
             , Text
"τρίτη σεπτεμβρίου 2013"
             ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples (Datetime -> Grain -> Context -> TimeValue
datetime (Integer
2016, Int
3, Int
3, Int
0, Int
0, Pico
0) Grain
Day)
             [ Text
"τρίτη μάρτη 2016"
             , Text
"3 μαρτίου 2016"
             ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples (Datetime -> Grain -> Context -> TimeValue
datetime (Integer
2016, Int
4, Int
5, Int
0, Int
0, Pico
0) Grain
Day)
             [ Text
"πέμπτη απρίλη 2016"
             , Text
"5 απρ 2016"
             ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples (Datetime -> Grain -> Context -> TimeValue
datetime (Integer
2016, Int
4, Int
3, Int
0, Int
0, Pico
0) Grain
Day)
             [ Text
"τρίτη απρίλη 2016"
             , Text
"3 απρίλης 2016"
             ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples (Datetime -> Grain -> Context -> TimeValue
datetime (Integer
2016, Int
4, Int
1, Int
0, Int
0, Pico
0) Grain
Month)
             [ Text
"απρίλη 2016"
             , Text
"απρίλης 2016"
             ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples (Datetime -> Grain -> Context -> TimeValue
datetime (Integer
2017, Int
10, Int
1, Int
0, Int
0, Pico
0) Grain
Month)
             [ Text
"Οκτ 2017"
             , Text
"Οκτώβρης 2017"
             , Text
"Οκτώβριος 2017"
             ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples (Datetime -> Grain -> Context -> TimeValue
datetime (Integer
2016, Int
3, Int
3, Int
0, Int
0, Pico
0) Grain
Day)
             [ Text
"τρίτη μάρτη 2016"
             , Text
"3η μάρτη 2016"
             , Text
"πέμπτη τρίτη μάρτη 2016"
             ]
  , (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
"ευαγγελισμός της θεοτόκου"
             , 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
"3 μαρτίου 2015"
             , Text
"3η μαρτίου 2015"
             , Text
"τρεις μαρτίου 2015"
             , Text
"3/3/2015"
             , Text
"3/3/15"
             , Text
"2015-3-3"
             , Text
"2015-03-03"
             ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples (Datetime -> Grain -> Context -> TimeValue
datetime (Integer
2013, Int
2, Int
15, Int
0, Int
0, Pico
0) Grain
Day)
             [ Text
"στις 15 Φεβρουαρίου"
             , Text
"η 15η Φεβρουαρίου"
             , Text
"15 Φεβρουαρίου"
             , Text
"15η Φεβρουαρίου"
             ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples (Datetime -> Grain -> Context -> TimeValue
datetime (Integer
2013, Int
8, Int
8, Int
0, Int
0, Pico
0) Grain
Day)
             [ Text
"8 Αυγ"
             ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples (Datetime -> Grain -> Context -> TimeValue
datetime (Integer
2014, Int
7, Int
18, Int
0, Int
0, Pico
0) Grain
Day)
             [ Text
"Παρασκευή, 18 Ιουλίου"
             , Text
"Ιουλίου 18, Παρασκευή"
             ]
  , (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
"14 Απριλίου, 2015"
             , Text
"14η Απριλίου 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
"περίπου την επόμενη Τρίτη"
             ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples (Datetime -> Grain -> Context -> TimeValue
datetime (Integer
2013, Int
2, Int
21, 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
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 -> Grain -> Context -> TimeValue
datetime (Integer
2013, Int
2, Int
10, Int
0, Int
0, Pico
0) Grain
Day)
             [ Text
"Κυριακή, 10 Φεβρουαρίου"
             ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples (Datetime -> Grain -> Context -> TimeValue
datetime (Integer
2013, Int
2, Int
13, Int
0, Int
0, Pico
0) Grain
Day)
             [ Text
"Τετ, 13Φεβ"
             ]
  , (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
"τρέχουσα εβδομάδα"
             ]
  , (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
"προηγούμενη εβδομάδα"
             ]
  , (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
"περίπου την επόμενη εβδομάδα"
             ]
  , (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
"τον προηγούμενο μήνα"
             ]
  , (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
1, 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 -> Grain -> Context -> TimeValue
datetime (Integer
2013, Int
4, 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 -> Grain -> Context -> TimeValue
datetime (Integer
2013, Int
7, Int
1, Int
0, Int
0, Pico
0) Grain
Quarter)
             [ Text
"τρίτο τρίμηνο"
             , Text
"3ο τρίμηνο"
             , Text
"το τρίτο τρίμηνο"
             ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples (Datetime -> Grain -> Context -> TimeValue
datetime (Integer
2018, Int
10, Int
1, Int
0, Int
0, Pico
0) Grain
Quarter)
             [ Text
"4ο τρίμηνο του 2018"
             , Text
"4ο τρίμηνο 2018"
             , Text
"το 4ο τρίμηνο του 2018"
             ]
  , (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
"πέρυσι"
             , 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
"αυτή τη χρονιά"
             , 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
"του χρόνου"
             , 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
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
7, 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
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
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
21, 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
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
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
13, 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
14, Int
17, Int
0, Pico
0) Grain
Hour)
             [ 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
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
2014, Int
3, Int
30, Int
0, Int
0, Pico
0) Grain
Day)
             [ Text
"τελευταία Κυριακή του Μάρτη του 2014"
             ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples (Datetime -> Grain -> Context -> TimeValue
datetime (Integer
2013, Int
10, Int
3, Int
0, Int
0, Pico
0) Grain
Day)
             [ Text
"τρίτη μέρα του Οκτώβρη"
             ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples (Datetime -> Grain -> Context -> TimeValue
datetime (Integer
2014, Int
10, Int
6, Int
0, Int
0, Pico
0) Grain
Week)
             [ Text
"πρώτη βδομάδα του Οκτώβρη του 2014"
             ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples (Datetime -> Grain -> Context -> TimeValue
datetime (Integer
2013, Int
10, Int
7, Int
0, Int
0, Pico
0) Grain
Week)
             [ Text
"η εβδομάδα της 6ης Οκτωβρίου"
             ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples (Datetime -> Grain -> Context -> TimeValue
datetime (Integer
2013, Int
10, Int
7, Int
0, Int
0, Pico
0) Grain
Week)
             [ Text
"η εβδομάδα της 7ης Οκτωβρίου"
             ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples (Datetime -> Grain -> Context -> TimeValue
datetime (Integer
2015, Int
10, Int
31, Int
0, Int
0, Pico
0) Grain
Day)
             [ Text
"η τελευταία μέρα του Οκτωβρίου του 2015"
             , Text
"η τελευταία μέρα στον Οκτώβρη του 2015"
             ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples (Datetime -> Grain -> Context -> TimeValue
datetime (Integer
2014, Int
9, Int
22, Int
0, Int
0, Pico
0) Grain
Week)
             [ Text
"η τελευταία βδομάδα Σεπτεμβρίου του 2014"
             ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples (Datetime -> Grain -> Context -> TimeValue
datetime (Integer
2013, Int
10, Int
1, Int
0, Int
0, Pico
0) Grain
Day)
             [ Text
"πρώτη Τρίτη του Οκτώβρη"
             ]
  , (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
16, Int
0, Pico
0) Grain
Hour)
             [ Text
"Τρίτη στις 4 το απόγευμα"
             ]
  , (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
16, Int
0, Pico
0) Grain
Hour)
             [ Text
"Τετάρτη στις 4 το απόγευμα"
             ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples (Datetime -> Grain -> Context -> TimeValue
datetime (Integer
2014, Int
9, Int
16, Int
0, Int
0, Pico
0) Grain
Day)
             [ Text
"τρίτη Τρίτη του Σεπτ 2014"
             ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples (Datetime -> Grain -> Context -> TimeValue
datetime (Integer
2014, Int
10, Int
1, Int
0, Int
0, Pico
0) Grain
Day)
             [ Text
"πρώτη Τετάρτη του Οκτωβρίου 2014"
             ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples (Datetime -> Grain -> Context -> TimeValue
datetime (Integer
2014, Int
10, Int
8, Int
0, Int
0, Pico
0) Grain
Day)
             [ Text
"δεύτερη Τετάρτη του Οκτωβρίου 2014"
             ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples (Datetime -> Grain -> Context -> TimeValue
datetime (Integer
2015, Int
1, Int
8, Int
0, Int
0, Pico
0) Grain
Day)
             [ 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
13, Int
3, Int
0, Pico
0) Grain
Hour)
             [ Text
"στις 3πμ"
             , Text
"3 το πρωί"
             , Text
"3πμ"
             , Text
"3 η ώρα το πρωί"
             , Text
"στις 3 πμ"
             ]
  , (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:18πμ"
             , Text
"3:18π"
             ]
  , (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
"στις 3μμ"
             , Text
"@ 3μμ"
             , Text
"3ΜΜ"
             , Text
"3μμ"
             , Text
"3 η ώρα μμ"
             , Text
"3 η ώρα το απόγευμα"
             , Text
"3 το απόγευμα"
             , Text
"3 και κάτι μμ"
             , Text
"3μμ περίπου"
             , Text
"περίπου 3μμ"
             ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples (Datetime -> Grain -> Context -> TimeValue
datetime (Integer
2013, Int
2, Int
12, Int
15, Int
15, Pico
0) Grain
Minute)
             [ Text
"στα 15 λεπτά μετά τις 3μμ"
             , Text
"ένα τέταρτο μετά τις 3μμ"
             , Text
"3 και τέταρτο μμ"
             , Text
"3:15 το απόγευμα"
             , Text
"15:15"
             , Text
"3:15μμ"
             , Text
"3:15ΜΜ"
             , Text
"3:15μ"
             , Text
"στις 3 και 15"
             ]
  , (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
"20 λεπτά μετά τις 3μμ"
             , Text
"3:20 το απόγευμα"
             , Text
"είκοσι μετά τις 3μμ"
             , Text
"3:20μ"
             , 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
"τρεισήμισι μμ"
             , Text
"Τρεισήμισι μμ"
             , Text
"15:30"
             , Text
"3:30μμ"
             , Text
"3:30ΜΜ"
             , Text
"330 μ.μ."
             , Text
"3:30 μ μ"
             , Text
"3:30 μμ"
             , 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
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
"ένα τέταρτο πριν το μεσημέρι"
             , Text
"11:45πμ"
             , Text
"δώδεκα παρά τέταρτο"
             , Text
"12 παρά τέταρτο"
             ]
  , (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
"8 το βράδυ"
             , Text
"στις 8 το βράδυ"
             ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples (Datetime -> Grain -> Context -> TimeValue
datetime (Integer
2013, Int
9, Int
20, Int
19, Int
30, Pico
0) Grain
Minute)
             [ Text
"στις 7:30 μμ την Παρασκευή, 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
2014, Int
7, Int
18, Int
19, Int
0, Pico
0) Grain
Minute)
             [ Text
"Παρ, 18 Ιουλ, 2014 07:00 μμ"
             ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples (Datetime -> Grain -> Context -> TimeValue
datetime (Integer
2013, Int
2, Int
12, Int
4, Int
30, Pico
1) Grain
Second)
             [ Text
"σε ένα δεύτερο"
             , Text
"σε ένα δευτερόλεπτο από τώρα"
             , Text
"σε 1\""
             ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples (Datetime -> Grain -> Context -> TimeValue
datetime (Integer
2013, Int
2, Int
12, Int
4, Int
31, Pico
0) Grain
Second)
             [ Text
"σε ένα λεπτό"
             , Text
"σε 1'"
             ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples (Datetime -> Grain -> Context -> TimeValue
datetime (Integer
2013, Int
2, Int
12, Int
4, Int
32, Pico
0) Grain
Second)
             [ Text
"σε 2 λεπτά"
             , 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
12, Int
11, Int
40, Pico
0) Grain
Minute)
             [ Text
"20 λεπτά πριν τις 12"
             , Text
"11:40"
             ]
  , (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
20, Pico
0) Grain
Minute)
             [ Text
"20 λεπτά μετά τις 12"
             , Text
"12:20"
             ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples (Datetime -> Grain -> Context -> TimeValue
datetime (Integer
2013, Int
2, Int
12, Int
4, Int
33, Pico
0) Grain
Second)
             [ 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
5, Int
30, Pico
0) Grain
Second)
             [ Text
"σε 60 λεπτά"
             ]
  , (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
"σε ένα τέταρτο της ώρας"
             , Text
"σε 1/4ω"
             , Text
"σε 1/4 ω"
             , Text
"σε 1/4 της ώρας"
             ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples (Datetime -> Grain -> Context -> TimeValue
datetime (Integer
2013, Int
2, Int
12, Int
5, Int
0, Pico
0) Grain
Second)
             [ Text
"σε μισή ώρα"
             , Text
"σε 1/2ω"
             , Text
"σε 1/2 ω"
             , Text
"σε 1/2 ώρα"
             ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples (Datetime -> Grain -> Context -> TimeValue
datetime (Integer
2013, Int
2, Int
12, Int
5, Int
15, Pico
0) Grain
Second)
             [ Text
"σε τρία τέταρτα της ώρας"
             , Text
"σε 3/4ω"
             , Text
"σε 3/4 ω"
             , Text
"σε 3/4 της ώρας"
             ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples (Datetime -> Grain -> Context -> TimeValue
datetime (Integer
2013, Int
2, Int
12, Int
7, Int
0, Pico
0) Grain
Second)
             [ Text
"σε 2,5 ώρες"
             , 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
12, Int
5, Int
30, Pico
0) Grain
Minute)
             [ Text
"σε μία ώρα"
             , Text
"σε 1ω"
             ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples (Datetime -> Grain -> Context -> TimeValue
datetime (Integer
2013, Int
2, Int
12, Int
6, Int
30, Pico
0) Grain
Minute)
             [ 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
7, Int
30, Pico
0) Grain
Minute)
             [ 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
4, Int
30, Pico
0) Grain
Minute)
             [ 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
13, Int
4, 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
13, Int
4, Int
30, Pico
0) Grain
Second)
             [ Text
"σε μία μέρα από τώρα αμέσως"
             , Text
"σε μία μέρα από τώρα"
             ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples (Datetime -> Grain -> Context -> TimeValue
datetime (Integer
2016, Int
2, Int
12, Int
0, Int
0, Pico
0) Grain
Day)
             [ Text
"3 χρόνια από σήμερα"
             ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples (Datetime -> Grain -> Context -> TimeValue
datetime (Integer
2013, Int
2, Int
19, Int
4, Int
0, Pico
0) Grain
Hour)
             [ Text
"σε 7 μέρες"
             ]
  , (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
12, Int
5, Int
0, Pico
0) Grain
Second)
             [ 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
4, 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
1, Int
29, Int
4, Int
0, Pico
0) Grain
Hour)
             [ Text
"πριν από 14 μέρες"
             , Text
"14 μέρες πριν"
             ]
  , (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
"πριν από 1 βδομάδα"
             ]
  , (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
"πριν από τρεις βδομάδες"
             ]
  , (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
"πριν από τρεις μήνες"
             ]
  , (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
"πριν από δύο χρόνια"
             ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples (Datetime -> Grain -> Context -> TimeValue
datetime (Integer
1954, Int
1, Int
1, Int
0, Int
0, Pico
0) Grain
Year)
             [ Text
"1954"
             ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples (Datetime -> Grain -> Context -> TimeValue
datetime (Integer
2013, Int
2, Int
19, Int
4, Int
0, Pico
0) Grain
Hour)
             [ Text
"εδώ και 7 μέρες"
             ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples (Datetime -> Grain -> Context -> TimeValue
datetime (Integer
2013, Int
2, Int
26, Int
4, Int
0, Pico
0) Grain
Hour)
             [ Text
"εδώ και 14 μέρες"
             ]
  , (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
"εδώ και 1 βδομάδα"
             ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples (Datetime -> Grain -> Context -> TimeValue
datetime (Integer
2013, Int
3, Int
5, Int
0, Int
0, Pico
0) Grain
Day)
             [ Text
"εδώ και τρεις βδομάδες"
             ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples (Datetime -> Grain -> Context -> TimeValue
datetime (Integer
2013, Int
5, Int
12, Int
0, Int
0, Pico
0) Grain
Day)
             [ Text
"εδώ και τρεις μήνες"
             ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples (Datetime -> Grain -> Context -> TimeValue
datetime (Integer
2015, Int
2, Int
1, Int
0, Int
0, Pico
0) Grain
Month)
             [ Text
"εδώ και δύο χρόνια"
             ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples (Datetime -> Grain -> Context -> TimeValue
datetime (Integer
2013, Int
12, Int
25, Int
0, Int
0, Pico
0) Grain
Day)
             [ Text
"ένα χρόνο μετά τα Χριστούγεννα"
             ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples ((Datetime, Datetime) -> Grain -> Context -> TimeValue
datetimeInterval ((Integer
2013, Int
12, Int
18, Int
0, Int
0, Pico
0), (Integer
2013, Int
12, Int
29, Int
0, Int
0, Pico
0)) Grain
Day)
             [ Text
"για 10 μέρες μετά τις 18 Δεκεμβρίου"
             ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples ((Datetime, Datetime) -> Grain -> Context -> TimeValue
datetimeInterval ((Integer
2013, Int
9, Int
23, Int
0, Int
0, Pico
0), (Integer
2013, Int
12, Int
22, 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
6, Int
21, Int
0, Int
0, Pico
0), (Integer
2013, Int
9, Int
24, 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
21, 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 -> Grain -> Context -> TimeValue
datetime (Integer
2013, Int
12, 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
12, Int
31, 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
2014, Int
1, 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
14, 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
5, 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
2012, Int
5, Int
13, 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
5, Int
11, Int
0, Int
0, Pico
0) Grain
Day)
             [ Text
"η μέρα της μητέρας του 2014"
             ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples (Datetime -> Grain -> Context -> TimeValue
datetime (Integer
2013, Int
6, 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
2012, Int
6, 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
1996, Int
6, Int
16, Int
0, Int
0, Pico
0) Grain
Day)
             [ Text
"η μέρα του πατέρα το 1996"
             ]
  , (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
2012, Int
3, 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 -> Context -> TimeValue
datetime (Integer
2013, Int
10, Int
31, Int
0, Int
0, Pico
0) Grain
Day)
             [ Text
"halloween"
             , Text
"το halloween του 2013"
             ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples (Datetime -> Grain -> Context -> TimeValue
datetime (Integer
2014, Int
10, Int
31, Int
0, Int
0, Pico
0) Grain
Day)
             [ Text
"το επόμενο halloween"
             ]
  , (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
"απόψε το βράδυ"
             ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples ((Datetime, Datetime) -> Grain -> Context -> TimeValue
datetimeInterval ((Integer
2013, Int
2, Int
8, Int
18, Int
0, Pico
0), (Integer
2013, Int
2, Int
11, Int
0, Int
0, Pico
0)) Grain
Hour)
             [ Text
"το περασμένο σαββατοκύριακο"
             , 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
18, Int
0, Pico
0), (Integer
2013, Int
2, Int
14, 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
13, Int
12, Int
0, Pico
0), (Integer
2013, Int
2, Int
13, Int
18, 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
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
"δευτέρα πρωί"
             ]
  , (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
9, 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
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ης Φεβρουαρίου"
             ]
  , (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
"τα τελευταία 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
2, Int
12, Int
4, Int
30, Pico
1), (Integer
2013, Int
2, Int
12, Int
4, Int
30, Pico
4)) Grain
Second)
             [ Text
"τα επόμενα 3 δευτερόλεπτα"
             , 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
"τα τελευταία 2 λεπτά"
             , 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
"τα επόμενα 3 λεπτά"
             , 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
3, Int
0, Pico
0), (Integer
2013, Int
2, Int
12, Int
4, Int
0, Pico
0)) Grain
Hour)
             [ Text
"η τελευταία 1 ώρα"
             ]
  , (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
"οι επόμενες 3 ώρες"
             , 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
"τελευταίες 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
2, Int
13, Int
0, Int
0, Pico
0), (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, 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
"επόμενες μερικές μέρες"
             ]
  , (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
"τελευταίες 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
18, Int
0, Int
0, Pico
0), (Integer
2013, Int
3, Int
11, Int
0, Int
0, Pico
0)) Grain
Week)
             [ Text
"επόμενες 3 βδομάδες"
             ]
  , (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
"τελευταίοι 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
3, Int
1, Int
0, Int
0, Pico
0), (Integer
2013, Int
6, Int
1, Int
0, Int
0, Pico
0)) Grain
Month)
             [ Text
"επόμενοι 3 μήνες"
             ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples ((Datetime, Datetime) -> Grain -> Context -> TimeValue
datetimeInterval ((Integer
2011, Int
1, Int
1, Int
0, Int
0, Pico
0), (Integer
2013, Int
1, Int
1, Int
0, Int
0, Pico
0)) Grain
Year)
             [ Text
"τελευταία 2 χρόνια"
             ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples ((Datetime, Datetime) -> Grain -> Context -> TimeValue
datetimeInterval ((Integer
2014, Int
1, Int
1, Int
0, Int
0, Pico
0), (Integer
2017, Int
1, Int
1, Int
0, Int
0, Pico
0)) Grain
Year)
             [ Text
"επόμενα 3 χρόνια"
             ]
  , (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 Ιουλίου"
             , Text
"13 Ιουλίου - 15 Ιουλίου"
             , Text
"από τις 13-15 Ιουλίου"
             , 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
12, Int
9, Int
30, Pico
0), (Integer
2013, Int
2, Int
12, Int
11, Int
1, Pico
0)) Grain
Minute)
             [ Text
"9:30 - 11:00"
             , Text
"9:30 - 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
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"
             , Text
"Πέμπτη μεταξύ 9:30 και 11:00"
             , Text
"Πέμπτη από τις 9:30 - 11:00"
             , Text
"Πέμπτη από 9:30 μέχρι 11:00"
             , Text
"Πέμπτη 9:30 - 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
13, Int
1, Int
0, Pico
0), (Integer
2013, Int
2, Int
13, Int
2, Int
31, Pico
0)) Grain
Minute)
             [ Text
"αύριο μεταξύ 1-2:30"
             ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples ((Datetime, Datetime) -> Grain -> Context -> TimeValue
datetimeInterval ((Integer
2013, Int
2, Int
12, Int
15, Int
0, Pico
0), (Integer
2013, Int
2, Int
12, Int
17, Int
0, Pico
0)) Grain
Hour)
             [ Text
"3-4 μμ"
             , Text
"από 3 μέχρι 4 το απόγευμα"
             , Text
"περίπου 3-4 μμ"
             ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples ((Datetime, Datetime) -> Grain -> Context -> TimeValue
datetimeInterval ((Integer
2013, Int
2, Int
12, Int
15, Int
30, Pico
0), (Integer
2013, Int
2, Int
12, Int
18, Int
1, Pico
0)) Grain
Minute)
             [ Text
"3:30 μέχρι 6 μμ"
             , Text
"3:30-6 μ.μ."
             ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples ((Datetime, Datetime) -> Grain -> Context -> TimeValue
datetimeInterval ((Integer
2013, Int
2, Int
12, Int
8, Int
0, Pico
0), (Integer
2013, Int
2, Int
12, Int
14, Int
0, Pico
0)) Grain
Hour)
             [ Text
"8πμ - 1μμ"
             ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples ((Datetime, Datetime) -> Grain -> Context -> TimeValue
datetimeInterval ((Integer
2013, Int
2, Int
14, Int
9, Int
0, Pico
0), (Integer
2013, Int
2, Int
14, Int
12, Int
0, Pico
0)) Grain
Hour)
             [ Text
"Πέμπτη από  9π μέχρι 11π"
             , Text
"αυτή την Πέμπτη 9-11πμ"
             ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples ((Datetime, Datetime) -> Grain -> Context -> TimeValue
datetimeInterval ((Integer
2013, Int
2, Int
12, Int
11, Int
30, Pico
0), (Integer
2013, Int
2, Int
12, Int
13, Int
31, Pico
0)) Grain
Minute)
             [ Text
"11:30-1:30"
             ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples (Datetime -> Grain -> Context -> TimeValue
datetime (Integer
2013, Int
9, Int
21, Int
13, Int
30, Pico
0) Grain
Minute)
             [ Text
"1:30 μμ το Σάββατο, 21 Σεπτ"
             ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples ((Datetime, Datetime) -> Grain -> Context -> TimeValue
datetimeInterval ((Integer
2013, Int
2, Int
12, Int
4, Int
30, Pico
0), (Integer
2013, Int
2, Int
26, Int
0, Int
0, Pico
0)) Grain
Second)
             [ Text
"μέσα σε 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
12, Int
4, Int
30, Pico
0), (Integer
2013, Int
2, Int
12, Int
14, Int
0, Pico
0)) Grain
Second)
             [ Text
"μέχρι τις 2: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
13, Int
0, Int
0, Pico
0)) Grain
Second)
             [ 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
0), (Integer
2013, Int
3, Int
1, Int
0, Int
0, Pico
0)) Grain
Second)
             [ 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
0), (Integer
2013, Int
4, Int
1, Int
0, Int
0, Pico
0)) Grain
Second)
             [ 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
"4μμ CET"
             ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples (Datetime -> Grain -> Context -> TimeValue
datetime (Integer
2013, Int
2, Int
14, Int
6, Int
0, Pico
0) Grain
Minute)
             [ Text
"Πέμπτη 8:00 GMT"
             , Text
"Πέμπτη 8:00 gmt"
             , Text
"Πεμ στις 8 GMT"
             , Text
"Πεμ στις 8 gmt"
             ]
  , (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 (IntervalDirection -> Datetime -> Grain -> Context -> TimeValue
datetimeOpenInterval IntervalDirection
After (Integer
2013, Int
2, Int
12, Int
14, Int
0, Pico
0) Grain
Hour)
             [ 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
17, Int
4, Int
0, Pico
0) Grain
Hour)
             [ Text
"σε 5 μέρες"
             ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples (IntervalDirection -> Datetime -> Grain -> Context -> TimeValue
datetimeOpenInterval IntervalDirection
Before (Integer
2013, Int
2, Int
12, Int
11, Int
0, Pico
0) Grain
Hour)
             [ Text
"πριν τις 11 το πρωί"
             ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples ((Datetime, Datetime) -> Grain -> Context -> TimeValue
datetimeInterval ((Integer
2013, Int
2, Int
12, Int
8, Int
0, Pico
0), (Integer
2013, Int
2, Int
12, Int
19, Int
0, Pico
0)) Grain
Hour)
             [ Text
"8πμ μέχρι τις 6"
             ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples (Datetime -> Grain -> Context -> TimeValue
datetime (Integer
2013, Int
2, Int
12, Int
13, Int
30, Pico
0) Grain
Minute)
             [ Text
"στις 1:30μμ"
             , 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 λεπτά"
             , Text
"σε 15'"
             ]
  , (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
"περίπου 1030"
             ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples ((Datetime, Datetime) -> Grain -> Context -> TimeValue
datetimeInterval ((Integer
2013, Int
2, Int
12, Int
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
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
2, Int
12, Int
12, Int
0, Pico
0) Grain
Hour)
             [ Text
"στις 12μμ"
             , 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
Hour)
             [ Text
"στις 12 πμ"
             , 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
"το Μάρτιο"
             ]
  , (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 μμ"
             ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples ((Datetime, Datetime) -> Grain -> Context -> TimeValue
datetimeInterval ((Integer
2013, Int
2, Int
13, Int
12, Int
0, Pico
0), (Integer
2013, Int
2, Int
13, Int
18, 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
13, Int
13, Int
0, Pico
0), (Integer
2013, Int
2, Int
13, Int
15, Int
0, Pico
0)) Grain
Hour)
             [ Text
"1μμ-2μμ αύριο"
             ]
  , (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
2, Int
12, Int
19, Int
30, Pico
0) Grain
Minute)
             [ Text
"στις 7: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"
             ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples (Datetime -> Grain -> Context -> TimeValue
datetime (Integer
2013, Int
2, Int
12, Int
4, Int
23, Pico
0) Grain
Minute)
    -- yes, the result is in the past, we may need to revisit
             [ Text
"στις 4:23"
             , 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
"αρχές Μάρτη"
             ]
  , (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
25, Int
18, Int
0, Pico
0), (Integer
2013, Int
10, Int
28, 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
7, Int
26, Int
18, Int
0, Pico
0), (Integer
2013, Int
7, Int
29, 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
2017, Int
10, Int
27, Int
18, Int
0, Pico
0), (Integer
2017, Int
10, Int
30, Int
0, Int
0, Pico
0)) Grain
Hour)
             [ Text
"τελευταίο σκ του Οκτ 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η αυγ"
             ]
  ]