-- 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.FR.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)

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

negativeCorpus :: NegativeCorpus
negativeCorpus :: NegativeCorpus
negativeCorpus = (Context
testContext {locale :: Locale
locale = Lang -> Maybe Region -> Locale
makeLocale Lang
FR Maybe Region
forall a. Maybe a
Nothing}, Options
testOptions, [Text]
examples)
  where
    examples :: [Text]
examples =
      [ Text
"Ana a un court de tennis"
      , Text
"deux trois"
      , Text
"deux trois minutes"
      ]

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
"maintenant"
             , Text
"tout de suite"
             ]
  , (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
"aujourd'hui"
             , Text
"ce jour"
             , Text
"dans la journée"
             , Text
"en ce moment"
             ]
  , (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
"hier"
             , Text
"le jour d'avant"
             , Text
"le jour précédent"
             , Text
"la veille"
             ]
  , (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
"avant-hier"
             ]
  , (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
"demain"
             , Text
"jour suivant"
             , Text
"le jour d'après"
             , Text
"le lendemain"
             , Text
"un jour après"
             ]
  , (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
"après-demain"
             , Text
"le lendemain du 13 février"
             ]
  , (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
"lundi"
             , Text
"lun."
             , Text
"ce lundi"
             ]
  , (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
"lundi 18 février"
             ]
  , (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
"mardi"
             ]
  , (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
"mercredi 13 février"
             ]
  , (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
"jeudi"
             , Text
"deux jours plus tard"
             , Text
"deux jours après"
             ]
  , (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
"vendredi"
             ]
  , (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
"samedi"
             ]
  , (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
"dimanche"
             ]
  , (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
"le 1er mars"
             , Text
"premier mars"
             , Text
"le 1 mars"
             , Text
"vendredi 1er mars"
             ]
  , (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
"le premier mars 2013"
             , Text
"1/3/2013"
             , Text
"2013-03-01"
             ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples (Datetime -> Grain -> Context -> TimeValue
datetime (Integer
2013, Int
3, Int
2, Int
0, Int
0, Pico
0) Grain
Day)
             [ Text
"le 2 mars"
             , Text
"2 mars"
             , Text
"le 2/3"
             ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples (Datetime -> Grain -> Context -> TimeValue
datetime (Integer
2013, Int
3, Int
2, Int
5, Int
0, Pico
0) Grain
Hour)
             [ Text
"le 2 mars à 5h"
             , Text
"2 mars à 5h"
             , Text
"le 2/3 à 5h"
             , Text
"le 2 mars à 5h du matin"
             , Text
"le 2 mars vers 5h"
             , Text
"2 mars vers 5h"
             , Text
"2 mars à environ 5h"
             , Text
"2 mars aux alentours de 5h"
             , Text
"2 mars autour de 5h"
             , Text
"le 2/3 vers 5h"
             ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples (Datetime -> Grain -> Context -> TimeValue
datetime (Integer
2013, Int
3, Int
2, Int
0, Int
0, Pico
0) Grain
Day)
             [ Text
"le 2"
             ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples (Datetime -> Grain -> Context -> TimeValue
datetime (Integer
2013, Int
3, Int
2, Int
5, Int
0, Pico
0) Grain
Hour)
             [ Text
"le 2 à 5h"
             , Text
"le 2 vers 5h"
             , Text
"le 2 à 5h du mat"
             ]
  , (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
"le 3 mars"
             , Text
"3 mars"
             , Text
"le 3/3"
             ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples (Datetime -> Grain -> Context -> TimeValue
datetime (Integer
2013, Int
4, Int
5, Int
0, Int
0, Pico
0) Grain
Day)
             [ Text
"le 5 avril"
             , Text
"5 avril"
             ]
  , (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
"le 3 mars 2015"
             , Text
"3 mars 2015"
             , Text
"3/3/2015"
             , 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
"le 15 février"
             , Text
"15 février"
             ]
  , (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/02/2013"
             , Text
"15 fev 2013"
             ]
  , (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
"le 16"
             ]
  , (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
18, Int
0, Pico
0) Grain
Hour)
             [ Text
"le 16 à 18h"
             , Text
"le 16 vers 18h"
             , Text
"le 16 plutôt vers 18h"
             , Text
"le 16 à 6h du soir"
             , Text
"le 16 vers 6h du soir"
             , Text
"le 16 vers 6h dans la soirée"
             , Text
"samedi 16 à 18h"
             ]
  , (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
"17 février"
             , Text
"le 17 février"
             , Text
"17/2"
             , Text
"17/02"
             , Text
"le 17/02"
             , Text
"17 02"
             , Text
"17 2"
             , Text
"le 17 02"
             , Text
"le 17 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
0, Int
0, Pico
0) Grain
Day)
             [ Text
"mercredi 13"
             ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples (Datetime -> Grain -> Context -> TimeValue
datetime (Integer
2014, Int
2, Int
20, Int
0, Int
0, Pico
0) Grain
Day)
             [ Text
"20/02/2014"
             , Text
"20/2/2014"
             , Text
"20/02/14"
             , Text
"le 20/02/14"
             , Text
"le 20/2/14"
             , Text
"20 02 2014"
             , Text
"20 02 14"
             , Text
"20 2 2014"
             , Text
"20 2 14"
             , Text
"le 20 02 2014"
             , Text
"le 20 02 14"
             , Text
"le 20 2 2014"
             , Text
"le 20 2 14"
             ]
  , (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
"31 octobre"
             , Text
"le 31 octobre"
             , Text
"31/10"
             , Text
"le 31/10"
             , Text
"31 10"
             , Text
"le 31 10"
             ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples (Datetime -> Grain -> Context -> TimeValue
datetime (Integer
2014, Int
12, Int
24, Int
0, Int
0, Pico
0) Grain
Day)
             [ Text
"24/12/2014"
             , Text
"24/12/14"
             , Text
"le 24/12/14"
             , Text
"24 12 2014"
             , Text
"24 12 14"
             , Text
"le 24 12 2014"
             , Text
"le 24 12 14"
             ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples (Datetime -> Grain -> Context -> TimeValue
datetime (Integer
1974, Int
10, Int
31, Int
0, Int
0, Pico
0) Grain
Day)
             [ Text
"31/10/1974"
             , Text
"31/10/74"
             ]
  , (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
"lundi prochain"
             , Text
"lundi la semaine prochaine"
             , Text
"lundi de la semaine prochaine"
             ]
  , (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
"mardi prochain"
             , Text
"mardi suivant"
             , Text
"mardi d'après"
             , Text
"mardi la semaine prochaine"
             , Text
"mardi de la semaine prochaine"
             , Text
"mardi la semaine suivante"
             , Text
"mardi de la semaine suivante"
             , Text
"mardi la semaine d'après"
             , Text
"mardi de la semaine d'après"
             ]
  , (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
"mercredi prochain"
             ]
  , (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
"mercredi suivant"
             , Text
"mercredi d'après"
             , Text
"mercredi la semaine prochaine"
             , Text
"mercredi de la semaine prochaine"
             , Text
"mercredi la semaine suivante"
             , Text
"mercredi de la semaine suivante"
             , Text
"mercredi la semaine d'après"
             , Text
"mercredi de la semaine d'après"
             ]
  , (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
"lundi en huit"
             , Text
"lundi en 8"
             ]
  , (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
"mardi en huit"
             , Text
"mardi en 8"
             ]
  , (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
"mercredi en huit"
             , Text
"mercredi en 8"
             ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples (Datetime -> Grain -> Context -> TimeValue
datetime (Integer
2013, Int
3, Int
4, Int
0, Int
0, Pico
0) Grain
Day)
             [ Text
"lundi en quinze"
             , Text
"lundi en 15"
             ]
  , (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
"mardi en quinze"
             , Text
"mardi en 15"
             ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples (Datetime -> Grain -> Context -> TimeValue
datetime (Integer
2013, Int
2, Int
27, Int
0, Int
0, Pico
0) Grain
Day)
             [ Text
"mercredi en quinze"
             , Text
"mercredi en 15"
             ]
  , (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
"lundi cette semaine"
             ]
  , (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
"mardi cette semaine"
             ]
  , (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
"mercredi cette semaine"
             ]
  , (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
"cette semaine"
             , Text
"dans la semaine"
             ]
  , (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
"la semaine dernière"
             ]
  , (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
"la semaine prochaine"
             , Text
"la semaine suivante"
             , Text
"la semaine qui suit"
             ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples (Datetime -> Grain -> Context -> TimeValue
datetime (Integer
2013, Int
1, Int
0, Int
0, Int
0, Pico
0) Grain
Month)
             [ Text
"le mois dernier"
             ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples (Datetime -> Grain -> Context -> TimeValue
datetime (Integer
2013, Int
3, Int
0, Int
0, Int
0, Pico
0) Grain
Month)
             [ Text
"le mois prochain"
             , Text
"le mois suivant"
             ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples (Datetime -> Grain -> Context -> TimeValue
datetime (Integer
2012, Int
0, Int
0, Int
0, Int
0, Pico
0) Grain
Year)
             [ Text
"l'année dernière"
             ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples (Datetime -> Grain -> Context -> TimeValue
datetime (Integer
2013, Int
0, Int
0, Int
0, Int
0, Pico
0) Grain
Year)
             [ Text
"cette année"
             ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples (Datetime -> Grain -> Context -> TimeValue
datetime (Integer
2014, Int
0, Int
0, Int
0, Int
0, Pico
0) Grain
Year)
             [ Text
"l'année prochaine"
             ]
  , (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
"dimanche dernier"
             , Text
"dimanche de la semaine dernière"
             ]
  , (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
"3eme jour d'octobre"
             , Text
"le 3eme jour d'octobre"
             ]
  , (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
"premiere semaine d'octobre 2014"
             , Text
"la premiere semaine d'octobre 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
"la semaine du 6 octobre"
             , Text
"la semaine du 7 octobre"
             ]
  , (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
"dernier jour d'octobre 2015"
             , Text
"le dernier jour d'octobre 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
"dernière semaine de septembre 2014"
             , Text
"la dernière semaine de septembre 2014"
             ]
  , (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
"à quinze heures"
             , Text
"à 15 heures"
             , Text
"à 3 heures cet après-midi"
             , Text
"15h"
             , Text
"15H"
             , Text
"vers 15 heures"
             , Text
"à environ 15 heures"
             ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples (Datetime -> Grain -> Context -> TimeValue
datetime (Integer
2013, Int
2, Int
12, Int
15, Int
0, Pico
0) Grain
Minute)
             [ Text
"15:00"
             , Text
"15h00"
             , Text
"15H00"
             ]
  , (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
"minuit"
             ]
  , (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
"midi"
             , Text
"aujourd'hui à midi"
             ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples (Datetime -> Grain -> Context -> TimeValue
datetime (Integer
2013, Int
2, Int
12, Int
12, Int
15, Pico
0) Grain
Minute)
             [ Text
"midi et quart"
             , Text
"midi quinze"
             ]
  , (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
55, Pico
0) Grain
Minute)
             [ Text
"midi moins cinq"
             ]
  , (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
30, Pico
0) Grain
Minute)
             [ Text
"midi et demi"
             , Text
"midi trente"
             ]
  , (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
3, Pico
0) Grain
Minute)
             [ Text
"minuit trois"
             ]
  , (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
3, Pico
0) Grain
Minute)
             [ Text
"aujourd'hui à minuit trois"
             ]
  , (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
"à quinze heures quinze"
             , Text
"à quinze heures et quinze minutes"
             , Text
"15h passé de 15 minutes"
             , Text
"à trois heures et quart cet après-midi"
             , Text
"15:15"
             , Text
"15h15"
             ]
  , (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
15, Pico
0) Grain
Minute)
             [ Text
"à trois heures et quart demain après-midi"
             ]
  , (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
"à quinze heures trente"
             , Text
"à quinze heures passé de trente minutes"
             , Text
"à trois heures et demi cet après-midi"
             , Text
"15:30"
             , Text
"15h30"
             ]
  , (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
"midi moins le quart"
             , Text
"11h45"
             , Text
"onze heures trois quarts"
             , Text
"aujourd'hui à 11h45"
             ]
  , (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
11, Int
0, Pico
0) Grain
Hour)
             [ Text
"mercredi à 11h"
             ]
  , (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
11, Int
0, Pico
0) Grain
Hour)
             [ Text
"demain à 11 heures"
             , Text
"demain à 11H"
             ]
  , (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
11, Int
0, Pico
0) Grain
Hour)
             [ Text
"jeudi à 11h"
             , Text
"après-demain à 11 heures"
             , Text
"après-demain à 11H"
             ]
  , (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
12, Int
0, Pico
0) Grain
Hour)
             [ Text
"vendredi à midi"
             , Text
"vendredi à 12h"
             ]
  , (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
16, Int
0, Pico
0) Grain
Hour)
             [ Text
"vendredi quinze à seize heures"
             , Text
"vendredi 15 à 16h"
             , Text
"vendredi quinze à 16h"
             ]
  , (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
"dans une seconde"
             , Text
"dans 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
"dans une minute"
             , Text
"dans 1 min"
             ]
  , (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
"dans 2 minutes"
             , Text
"dans deux min"
             , Text
"dans 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
Second)
             [ Text
"dans 60 minutes"
             ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples (Datetime -> Grain -> Context -> TimeValue
datetime (Integer
2013, Int
2, Int
12, Int
5, Int
30, Pico
0) Grain
Minute)
             [ Text
"dans une heure"
             ]
  , (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
2, Int
30, Pico
0) Grain
Minute)
             [ Text
"il y a deux heures"
             ]
  , (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
"dans 24 heures"
             , Text
"dans vingt quatre heures"
             ]
  , (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
"dans un jour"
             ]
  , (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
"dans 7 jours"
             ]
  , (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
"dans 1 semaine"
             , Text
"dans une semaine"
             ]
  , (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
"il y a trois semaines"
             ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples (Datetime -> Grain -> Context -> TimeValue
datetime (Integer
2013, Int
4, Int
12, Int
0, Int
0, Pico
0) Grain
Day)
             [ Text
"dans deux mois"
             ]
  , (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
"il y a trois mois"
             ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples (Datetime -> Grain -> Context -> TimeValue
datetime (Integer
2014, Int
2, Int
0, Int
0, Int
0, Pico
0) Grain
Month)
             [ Text
"dans une année"
             , Text
"dans 1 an"
             ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples (Datetime -> Grain -> Context -> TimeValue
datetime (Integer
2011, Int
2, Int
0, Int
0, Int
0, Pico
0) Grain
Month)
             [ Text
"il y a deux ans"
             ]
  , (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
"cet été"
             ]
  , (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
"cet hiver"
             ]
  , (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
"Noel"
             , Text
"noël"
             , Text
"jour de noel"
             ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples ((Datetime, Datetime) -> Grain -> Context -> TimeValue
datetimeInterval ((Integer
2013, Int
12, Int
24, Int
18, Int
0, Pico
0), (Integer
2013, Int
12, Int
25, Int
0, Int
0, Pico
0)) Grain
Hour)
             [ Text
"le soir de noël"
             ]
  , (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
"jour de l'an"
             , Text
"nouvel an"
             , Text
"premier janvier"
             ]
  , (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
Day)
             [ Text
"la toussaint"
             , Text
"le jour de la toussaint"
             , Text
"la journée de la toussaint"
             , Text
"toussaint"
             , Text
"le jour des morts"
             ]
  , (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
Day)
             [ Text
"fête du travail"
             ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples ((Datetime, Datetime) -> Grain -> Context -> TimeValue
datetimeInterval ((Integer
2013, Int
2, Int
12, Int
12, Int
0, Pico
0), (Integer
2013, Int
2, Int
12, Int
19, Int
0, Pico
0)) Grain
Hour)
             [ Text
"cet après-midi"
             , Text
"l'après-midi"
             ]
  , (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
7, Int
0, Pico
0), (Integer
2013, Int
2, Int
12, Int
9, Int
0, Pico
0)) Grain
Hour)
             [ Text
"aujourd'hui en début de matinée"
             , Text
"en début de matinée"
             , Text
"le 12 février en début de matinée"
             , Text
"aujourd'hui très tôt le matin"
             , Text
"aujourd'hui tôt le matin"
             , Text
"aujourd'hui le matin tôt"
             , Text
"aujourd'hui le matin très tôt"
             , Text
"le matin très tôt"
             , Text
"le matin tôt"
             , Text
"tôt le matin"
             , Text
"très tôt le matin"
             ]
  , (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
0, Pico
0), (Integer
2013, Int
2, Int
12, Int
11, Int
0, Pico
0)) Grain
Hour)
             [ Text
"aujourd'hui en milieu de matinée"
             , Text
"le 12 février en milieu de matinée"
             , Text
"en milieu de matinée"
             ]
  , (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
10, Int
0, Pico
0), (Integer
2013, Int
2, Int
12, Int
12, Int
0, Pico
0)) Grain
Hour)
             [ Text
"aujourd'hui en fin de matinée"
             , Text
"en fin de matinée"
             , Text
"le 12 février en fin de matinée"
             ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples ((Datetime, Datetime) -> Grain -> Context -> TimeValue
datetimeInterval ((Integer
2013, Int
2, Int
12, Int
13, Int
0, Pico
0), (Integer
2013, Int
2, Int
12, Int
17, Int
0, Pico
0)) Grain
Hour)
             [ Text
"après déjeuner"
             ]
  , (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
10, Int
0, Pico
0), (Integer
2013, Int
2, Int
12, Int
12, Int
0, Pico
0)) Grain
Hour)
             [ Text
"avant déjeuner"
             ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples ((Datetime, Datetime) -> Grain -> Context -> TimeValue
datetimeInterval ((Integer
2013, Int
2, Int
12, Int
12, Int
0, Pico
0), (Integer
2013, Int
2, Int
12, Int
14, Int
0, Pico
0)) Grain
Hour)
             [ Text
"aujourd'hui pendant le déjeuner"
             , Text
"à l'heure du déjeuner"
             , Text
"au moment de déjeuner"
             , Text
"pendant le déjeuner"
             ]
  , (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
17, Int
0, Pico
0), (Integer
2013, Int
2, Int
12, Int
21, Int
0, Pico
0)) Grain
Hour)
             [ Text
"après le travail"
             ]
  , (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
"dès le matin"
             , Text
"dès la matinée"
             ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples ((Datetime, Datetime) -> Grain -> Context -> TimeValue
datetimeInterval ((Integer
2013, Int
2, Int
12, Int
12, Int
0, Pico
0), (Integer
2013, Int
2, Int
12, Int
14, Int
0, Pico
0)) Grain
Hour)
             [ Text
"aujourd'hui en début d'après-midi"
             , Text
"en début d'après-midi"
             , Text
"le 12 février en début d'après-midi"
             , Text
"au début de l'après-midi"
             ]
  , (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
14, Int
0, Pico
0), (Integer
2013, Int
2, Int
12, Int
17, Int
0, Pico
0)) Grain
Hour)
             [ Text
"aujourd'hui en milieu d'après-midi"
             , Text
"en milieu d'après-midi"
             , Text
"le 12 février en milieu d'après-midi"
             , Text
"au milieu de l'après-midi"
             ]
  , (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
17, Int
0, Pico
0), (Integer
2013, Int
2, Int
12, Int
19, Int
0, Pico
0)) Grain
Hour)
             [ Text
"aujourd'hui en fin d'après-midi"
             , Text
"en fin d'après-midi"
             , Text
"le 12 février en fin d'après-midi"
             , Text
"à la fin de l'après-midi"
             ]
  , (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
6, Int
0, Pico
0), (Integer
2013, Int
2, Int
12, Int
10, Int
0, Pico
0)) Grain
Hour)
             [ Text
"aujourd'hui en début de journée"
             , Text
"le 12 février en début de journée"
             , Text
"en début de journée"
             , Text
"au début de la journée"
             ]
  , (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
0, Pico
0), (Integer
2013, Int
2, Int
12, Int
16, Int
0, Pico
0)) Grain
Hour)
             [ Text
"aujourd'hui en milieu de journée"
             , Text
"en milieu de journée"
             , Text
"le 12 février en milieu de journée"
             , Text
"au milieu de la journée"
             ]
  , (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
17, Int
0, Pico
0), (Integer
2013, Int
2, Int
12, Int
21, Int
0, Pico
0)) Grain
Hour)
             [ Text
"aujourd'hui en fin de journée"
             , Text
"en fin de journée"
             , Text
"le 12 février en fin de journée"
             , Text
"à la fin de la journée"
             ]
  , (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
"ce soir"
             , Text
"le soir"
             , Text
"dans la soirée"
             ]
  , (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
12, Int
21, Int
0, Pico
0)) Grain
Hour)
             [ Text
"aujourd'hui en début de soirée"
             , Text
"en début de soirée"
             , Text
"le 12 février en début de soirée"
             , Text
"au début de la soirée"
             ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples ((Datetime, Datetime) -> Grain -> Context -> TimeValue
datetimeInterval ((Integer
2013, Int
2, Int
12, Int
21, Int
0, Pico
0), (Integer
2013, Int
2, Int
13, Int
0, Int
0, Pico
0)) Grain
Hour)
             [ Text
"aujourd'hui en fin de soirée"
             , Text
"en fin de soirée"
             , Text
"le 12 février en fin de soirée"
             , Text
"à la fin de la soirée"
             ]
  , (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
"demain soir"
             , Text
"mercredi soir"
             , Text
"mercredi en soirée"
             ]
  , (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
"hier soir"
             , Text
"la veille au soir"
             ]
  , (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
"ce week-end"
             ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples ((Datetime, Datetime) -> Grain -> Context -> TimeValue
datetimeInterval ((Integer
2013, Int
2, Int
11, Int
0, Int
0, Pico
0), (Integer
2013, Int
2, Int
13, Int
0, Int
0, Pico
0)) Grain
Day)
             [ Text
"en début de semaine"
             , Text
"au début de la semaine"
             ]
  , (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
15, Int
0, Int
0, Pico
0)) Grain
Day)
             [ Text
"en milieu de semaine"
             , Text
"au milieu de la semaine"
             ]
  , (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
0, Int
0, Pico
0), (Integer
2013, Int
2, Int
18, Int
0, Int
0, Pico
0)) Grain
Day)
             [ Text
"en fin de semaine"
             , Text
"à la fin de la semaine"
             ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples ((Datetime, Datetime) -> Grain -> Context -> TimeValue
datetimeInterval ((Integer
2013, Int
2, Int
11, Int
0, Int
0, Pico
0), (Integer
2013, Int
2, Int
16, Int
0, Int
0, Pico
0)) Grain
Day)
             [ Text
"en semaine"
             ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples ((Datetime, Datetime) -> Grain -> Context -> TimeValue
datetimeInterval ((Integer
2013, Int
9, Int
6, Int
18, Int
0, Pico
0), (Integer
2013, Int
9, Int
9, Int
0, Int
0, Pico
0)) Grain
Hour)
             [ Text
"le premier week-end de septembre"
             ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples ((Datetime, Datetime) -> Grain -> Context -> TimeValue
datetimeInterval ((Integer
2013, Int
9, Int
13, Int
18, Int
0, Pico
0), (Integer
2013, Int
9, Int
16, Int
0, Int
0, Pico
0)) Grain
Hour)
             [ Text
"le deuxième week-end de septembre"
             ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples ((Datetime, Datetime) -> Grain -> Context -> TimeValue
datetimeInterval ((Integer
2013, Int
9, Int
27, Int
18, Int
0, Pico
0), (Integer
2013, Int
9, Int
30, Int
0, Int
0, Pico
0)) Grain
Hour)
             [ Text
"le dernier week-end de septembre"
             ]
  , (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
"lundi matin"
             ]
  , (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
12, Int
0, Pico
0), (Integer
2013, Int
2, Int
18, Int
19, Int
0, Pico
0)) Grain
Hour)
             [ Text
"lundi après-midi"
             , Text
"lundi dans l'après-midi"
             ]
  , (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
17, Int
0, Pico
0), (Integer
2013, Int
2, Int
18, Int
19, Int
0, Pico
0)) Grain
Hour)
             [ Text
"lundi fin d'après-midi"
             , Text
"lundi en fin d'après-midi"
             ]
  , (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
"le 15 février dans la matinée"
             , Text
"matinée du 15 février"
             , Text
"le 15 février le matin"
             ]
  , (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 heures ce soir"
             , Text
"8h du soir"
             ]
  , (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 heures du matin"
             , Text
"3h du mat"
             ]
  , (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 dernières secondes"
             , Text
"deux dernieres secondes"
             ]
  , (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 prochaines secondes"
             , Text
"trois prochaines secondes"
             ]
  , (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 dernieres minutes"
             , Text
"deux dernières minutes"
             ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples ((Datetime, Datetime) -> Grain -> Context -> TimeValue
datetimeInterval ((Integer
2013, Int
2, Int
12, Int
4, Int
31, Pico
0), (Integer
2013, Int
2, Int
12, Int
4, Int
34, Pico
0)) Grain
Minute)
             [ Text
"3 prochaines minutes"
             , Text
"trois prochaines minutes"
             ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples ((Datetime, Datetime) -> Grain -> Context -> TimeValue
datetimeInterval ((Integer
2013, Int
2, Int
12, Int
5, Int
0, Pico
0), (Integer
2013, Int
2, Int
12, Int
8, Int
0, Pico
0)) Grain
Hour)
             [ Text
"3 prochaines heures"
             , Text
"3 heures suivantes"
             ]
  , (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 dernier jours"
             , Text
"deux derniers jour"
             ]
  , (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
"3 prochains jours"
             ]
  , (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 dernieres semaines"
             , Text
"2 semaines passées"
             ]
  , (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 prochaines semaines"
             ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples ((Datetime, Datetime) -> Grain -> Context -> TimeValue
datetimeInterval ((Integer
2012, Int
12, Int
0, Int
0, Int
0, Pico
0), (Integer
2013, Int
2, Int
0, Int
0, Int
0, Pico
0)) Grain
Month)
             [ Text
"2 derniers mois"
             ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples ((Datetime, Datetime) -> Grain -> Context -> TimeValue
datetimeInterval ((Integer
2013, Int
3, Int
0, Int
0, Int
0, Pico
0), (Integer
2013, Int
6, Int
0, Int
0, Int
0, Pico
0)) Grain
Month)
             [ Text
"3 prochains mois"
             , Text
"3 mois suivant"
             ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples ((Datetime, Datetime) -> Grain -> Context -> TimeValue
datetimeInterval ((Integer
2011, Int
0, Int
0, Int
0, Int
0, Pico
0), (Integer
2013, Int
0, Int
0, Int
0, Int
0, Pico
0)) Grain
Year)
             [ Text
"2 dernieres annees"
             , Text
"2 années passées"
             ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples ((Datetime, Datetime) -> Grain -> Context -> TimeValue
datetimeInterval ((Integer
2014, Int
0, Int
0, Int
0, Int
0, Pico
0), (Integer
2017, Int
0, Int
0, Int
0, Int
0, Pico
0)) Grain
Year)
             [ Text
"3 prochaines années"
             ]
  , (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 juillet"
             , Text
"13 au 15 juillet"
             , Text
"13 jusqu'au 15 juillet"
             , Text
"13 juillet au 15 juillet"
             , Text
"13 juillet - 15 juillet"
             , Text
"entre le 13 et le 15 juillet"
             , Text
"samedi 13 au dimanche 15e juillet"
             , Text
"du samedi 13 au dimanche 15 juillet"
             , Text
"du 13 au dimanche 15 juillet"
             , Text
"entre le 13 et le quinze juillet"
             , Text
"du treize au 15 juillet"
             , Text
"du 13e au 15 juillet"
             ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples ((Datetime, Datetime) -> Grain -> Context -> TimeValue
datetimeInterval ((Integer
2013, Int
7, Int
1, Int
0, Int
0, Pico
0), (Integer
2013, Int
7, Int
11, Int
0, Int
0, Pico
0)) Grain
Day)
             [ Text
"1er au 10 juillet"
             , Text
"lundi 1er au mercredi 10 juillet"
             , Text
"lundi 1 au mercredi 10e juillet"
             , Text
"du lundi 1er au mercredi 10 juillet"
             , Text
"du 1er au mercredi 10 juillet"
             , Text
"du 1er au dix juillet"
             , Text
"1er au dix juillet"
             ]
  , (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
19, Int
0, Int
0, Pico
0)) Grain
Day)
             [ Text
"du 13 au 18"
             , Text
"entre le 13 et le dix-huit"
             , Text
"du 13e au dix-huit"
             ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples ((Datetime, Datetime) -> Grain -> Context -> TimeValue
datetimeInterval ((Integer
2013, Int
6, Int
10, Int
0, Int
0, Pico
0), (Integer
2013, Int
7, Int
2, Int
0, Int
0, Pico
0)) Grain
Day)
             [ Text
"10 juin au 1er juillet"
             , Text
"entre le 10 juin et le 1er juillet"
             , Text
"du 10 juin au 1er juillet"
             ]
  , (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
"de 9h30 jusqu'à 11h jeudi"
             , Text
"de 9 heures 30 à 11h jeudi"
             , Text
"de 9 heures 30 a 11h jeudi"
             , Text
"entre 9h30 et 11h jeudi"
             , Text
"jeudi mais entre 9h30 et 11h"
             , Text
"jeudi par exemple entre 9h30 et 11h"
             , Text
"9h30 - 11h00 Jeudi"
             ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples (IntervalDirection -> Datetime -> Grain -> Context -> TimeValue
datetimeOpenInterval IntervalDirection
After (Integer
2013, Int
3, Int
8, Int
0, Int
0, Pico
0) Grain
Day)
             [ Text
"à partir du 8"
             , Text
"à partir du 8 mars"
             ]
  , (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
14, Int
9, Int
30, Pico
0) Grain
Minute)
             [ Text
"à partir de 9h30 jeudi"
             , Text
"jeudi après 9h30"
             , Text
"jeudi plus tard que 9h30"
             , Text
"jeudi matin à partir de 9 heures 30"
             ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples (IntervalDirection -> Datetime -> Grain -> Context -> TimeValue
datetimeOpenInterval IntervalDirection
After (Integer
2013, Int
11, Int
1, Int
16, Int
0, Pico
0) Grain
Hour)
             [ Text
"après 16h le 1er novembre"
             , Text
"plus tard que 16h le 1er novembre"
             ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples (IntervalDirection -> Datetime -> Grain -> Context -> TimeValue
datetimeOpenInterval IntervalDirection
After (Integer
2013, Int
11, Int
1, Int
0, Int
0, Pico
0) Grain
Day)
             [ Text
"après le 1er novembre"
             ]
  , (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
16, Int
0, Pico
0) Grain
Hour)
             [ Text
"avant 16h"
             , Text
"n'importe quand avant 16h"
             ]
  , (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
13, Int
17, Int
0, Pico
0)) Grain
Hour)
             [ Text
"demain jusqu'à 16h"
             ]
  , (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
20, Int
10, Int
0, Pico
0) Grain
Hour)
             [ Text
"le 20 à partir de 10h"
             ]
  , (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
15, Int
12, Int
0, Pico
0) Grain
Hour)
             [ Text
"vendredi à partir de midi"
             ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples ((Datetime, Datetime) -> Grain -> Context -> TimeValue
datetimeInterval ((Integer
2013, Int
2, Int
20, Int
0, Int
0, Pico
0), (Integer
2013, Int
2, Int
20, Int
19, Int
0, Pico
0)) Grain
Hour)
             [ Text
"le 20 jusqu'à 18h"
             ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples ((Datetime, Datetime) -> Grain -> Context -> TimeValue
datetimeInterval ((Integer
2014, Int
9, Int
14, Int
0, Int
0, Pico
0), (Integer
2014, Int
9, Int
21, Int
0, Int
0, Pico
0)) Grain
Day)
             [ Text
"14 - 20 sept. 2014"
             ]
  , (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
"d'ici 2 semaines"
             ]
  , (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
27, Int
4, Int
0, Pico
0)) Grain
Second)
             [ Text
"dans les 15 jours"
             ]
  , (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
"de 5 à 7"
             ]
  , (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
"jeudi de 9h à 11h"
             ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples ((Datetime, Datetime) -> Grain -> Context -> TimeValue
datetimeInterval ((Integer
2013, Int
2, Int
12, Int
12, Int
0, Pico
0), (Integer
2013, Int
2, Int
12, Int
15, Int
0, Pico
0)) Grain
Hour)
             [ Text
"entre midi et 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
11, Int
30, Pico
0), (Integer
2013, Int
2, Int
12, Int
13, Int
31, Pico
0)) Grain
Minute)
             [ Text
"11h30-1h30"
             , Text
"de 11h30 à 1h30"
             , Text
"de 11h30 jusqu'à 1h30"
             ]
  , (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
"13h30 samedi 21 septembre"
             ]
  , (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
"à seize heures CET"
             ]
  , (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
"fin mars"
             , Text
"fin du mois de mars"
             ]
  , (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
4, Int
6, Int
0, Int
0, Pico
0)) Grain
Day)
             [ Text
"début avril"
             , Text
"début du mois d'avril"
             ]
  , (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
4, Int
15, Int
0, Int
0, Pico
0)) Grain
Day)
             [ Text
"la première quinzaine d'avril"
             ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples ((Datetime, Datetime) -> Grain -> Context -> TimeValue
datetimeInterval ((Integer
2013, Int
4, Int
15, Int
0, Int
0, Pico
0), (Integer
2013, Int
5, Int
1, Int
0, Int
0, Pico
0)) Grain
Day)
             [ Text
"la deuxième quinzaine d'avril"
             ]
  , (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
4, Int
6, Int
0, Int
0, Pico
0)) Grain
Day)
             [ Text
"début avril"
             , Text
"début du mois d'avril"
             ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples ((Datetime, Datetime) -> Grain -> Context -> TimeValue
datetimeInterval ((Integer
2013, Int
12, Int
10, Int
0, Int
0, Pico
0), (Integer
2013, Int
12, Int
20, Int
0, Int
0, Pico
0)) Grain
Day)
             [ Text
"mi-décembre"
             ]
  , (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
"en fin de mois"
             , Text
"à la fin du mois"
             ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples ((Datetime, Datetime) -> Grain -> Context -> TimeValue
datetimeInterval ((Integer
2013, Int
11, Int
1, Int
0, Int
0, Pico
0), (Integer
2014, Int
1, Int
1, Int
0, Int
0, Pico
0)) Grain
Month)
             [ Text
"en fin d'année"
             , Text
"à la fin de l'année"
             ]
  , (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
3, Int
1, Int
0, Int
0, Pico
0)) Grain
Month)
             [ Text
"en début d'année"
             , Text
"au début de l'année"
             ]
  , (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
"au début du mois"
             , Text
"en début de mois"
             ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples (Datetime -> Grain -> Context -> TimeValue
datetime (Integer
2013, Int
3, Int
0, Int
0, Int
0, Pico
0) Grain
Month)
             [ Text
"mars"
             , Text
"en mars"
             , Text
"au mois de mars"
             , Text
"le mois de mars"
             ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples (Datetime -> Grain -> Context -> TimeValue
datetime (Integer
2013, Int
8, Int
15, Int
0, Int
0, Pico
0) Grain
Day)
             [ Text
"jeudi 15"
             ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples (Datetime -> Grain -> Context -> TimeValue
datetime (Integer
2013, Int
8, Int
15, Int
8, Int
0, Pico
0) Grain
Hour)
             [ Text
"jeudi 15 à 8h"
             ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples (IntervalDirection -> Datetime -> Grain -> Context -> TimeValue
datetimeOpenInterval IntervalDirection
After (Integer
2013, Int
2, Int
12, Int
4, Int
40, Pico
0) Grain
Minute)
             [ Text
"plus tard"
             , Text
"un peu plus tard"
             ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples ((Datetime, Datetime) -> Grain -> Context -> TimeValue
datetimeInterval ((Integer
2013, Int
2, Int
12, Int
12, Int
0, Pico
0), (Integer
2013, Int
2, Int
12, Int
19, Int
0, Pico
0)) Grain
Hour)
             [ Text
"plus tard dans l'après-midi"
             , Text
"un peu plus tard dans l'après-midi"
             ]
  , (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
00, Int
0, Pico
0)) Grain
Hour)
             [ Text
"plus tard dans la soirée"
             , Text
"un peu plus tard dans la soirée"
             ]
  ]