-- 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.NB.Corpus
  ( corpus
  ) where

import Data.String
import Prelude

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

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

allExamples :: [Example]
allExamples :: [Example]
allExamples = [[Example]] -> [Example]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
  [ (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples (Datetime -> Grain -> Context -> TimeValue
datetime (Integer
2013, Int
2, Int
12, Int
4, Int
30, Pico
0) Grain
Second)
             [ Text
"nå"
             , Text
"akkurat nå"
             ]
  , (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
"i dag"
             ]
  , (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
"i går"
             ]
  , (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
"i morgen"
             , Text
"i morra"
             ]
  , (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
"mandag"
             , Text
"man."
             , Text
"på mandag"
             ]
  , (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
"Mandag den 18. februar"
             , Text
"Man, 18 februar"
             ]
  , (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
"tirsdag"
             ]
  , (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
"torsdag"
             , Text
"tors"
             , Text
"tors."
             ]
  , (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
"fredag"
             , Text
"fre"
             , Text
"fre."
             ]
  , (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
"lørdag"
             , Text
"lør"
             , Text
"lør."
             ]
  , (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
"søndag"
             , Text
"søn"
             , Text
"søn."
             ]
  , (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
"Den første mars"
             , Text
"1. mars"
             , Text
"Den 1. mars"
             ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples (Datetime -> Grain -> Context -> TimeValue
datetime (Integer
2013, Int
3, Int
3, Int
0, Int
0, Pico
0) Grain
Day)
             [ Text
"3 mars"
             , Text
"den tredje mars"
             , Text
"den 3. mars"
             ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples (Datetime -> Grain -> Context -> TimeValue
datetime (Integer
2013, Int
10, Int
30, Int
0, Int
0, Pico
0) Grain
Day)
             [ Text
"30.10"
             , Text
"30/10"
             , Text
"30-10"
             ]
  , (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 mars 2015"
             , Text
"tredje mars 2015"
             , Text
"3. mars 2015"
             , Text
"3-3-2015"
             , Text
"03-03-2015"
             , Text
"3/3/2015"
             , Text
"3/3/15"
             , Text
"2015-3-3"
             , Text
"2015-03-03"
             , Text
"2015.03.03"
             , Text
"03/03/2015"
             , Text
"03.03.2015"
             ]
  , (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
"På den 15."
             , Text
"På den 15"
             , Text
"Den 15."
             , Text
"Den femtende"
             ]
  , (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
"den 15. februar"
             , Text
"15. februar"
             , Text
"februar 15"
             , Text
"15-02"
             , Text
"15/02"
             , Text
"15.2"
             ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples (Datetime -> Grain -> Context -> TimeValue
datetime (Integer
2013, Int
11, Int
27, Int
0, Int
0, Pico
0) Grain
Day)
             [ Text
"den 27. november"
             , Text
"27. november"
             , Text
"november 27"
             , Text
"27-11"
             , Text
"27/11"
             , Text
"27.11"
             ]
  , (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 Aug"
             ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples (Datetime -> Grain -> Context -> TimeValue
datetime (Integer
2014, Int
10, Int
0, Int
0, Int
0, Pico
0) Grain
Month)
             [ Text
"Oktober 2014"
             ]
  , (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.1974"
             , Text
"31/10/74"
             , Text
"31-10-74"
             , Text
"31.10.74"
             , Text
"1974/10/31"
             , Text
"1974-10-31"
             , Text
"1974.10.31"
             ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples (Datetime -> Grain -> Context -> TimeValue
datetime (Integer
2015, Int
4, Int
14, Int
0, Int
0, Pico
0) Grain
Day)
             [ Text
"14april 2015"
             , Text
"April 14, 2015"
             , Text
"fjortende April 15"
             ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples (Datetime -> Grain -> Context -> TimeValue
datetime (Integer
2013, Int
2, Int
22, Int
0, Int
0, Pico
0) Grain
Day)
             [ Text
"neste fredag igjen"
             ]
  , (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
"neste mars"
             ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples (Datetime -> Grain -> Context -> TimeValue
datetime (Integer
2014, Int
3, Int
0, Int
0, Int
0, Pico
0) Grain
Month)
             [ Text
"neste mars igjen"
             ]
  , (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
"Søndag, 10 feb"
             , Text
"Søndag 10 Feb"
             ]
  , (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
"Ons, Feb13"
             , Text
"Ons feb13"
             ]
  , (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
"Mandag, Feb 18"
             , Text
"Man, februar 18"
             ]
  , (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
"denne uken"
             ]
  , (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
"forrige uke"
             , Text
"sist uke"
             ]
  , (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
"neste uke"
             ]
  , (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
"forrige måned"
             , Text
"sist måned"
             ]
  , (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
"neste måned"
             ]
  , (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
"dette kvartalet"
             ]
  , (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
"neste kvartal"
             ]
  , (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
"tredje kvartal"
             , Text
"3. kvartal"
             ]
  , (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. kvartal 2018"
             , Text
"fjerde kvartal 2018"
             ]
  , (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
"forrige år"
             , Text
"sist år"
             ]
  , (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
"i fjor"
             ]
  , (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
"i år"
             , Text
"dette år"
             ]
  , (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
"neste år"
             ]
  , (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
"forrige søndag"
             , Text
"sist søndag"
             , Text
"søndag i forrige uke"
             ]
  , (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
"forrige tirsdag"
             , Text
"sist tirsdag"
             ]
  , (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
"neste tirsdag"
             ]
  , (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
"neste onsdag"
             ]
  , (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
"onsdag i neste uke"
             , Text
"onsdag neste uke"
             , Text
"neste onsdag igjen"
             ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples (Datetime -> Grain -> Context -> TimeValue
datetime (Integer
2013, Int
2, Int
22, Int
0, Int
0, Pico
0) Grain
Day)
             [ Text
"neste fredag igjen"
             ]
  , (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
"mandag denne uken"
             ]
  , (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
"tirsdag denne uken"
             ]
  , (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
"onsdag denne uken"
             ]
  , (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
"i overimorgen"
             , Text
"i overimorra"
             ]
  , (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
"i forigårs"
             ]
  , (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
"siste mandag i mars"
             , Text
"siste mandag i mars"
             ]
  , (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
"siste søndag i mars 2014"
             , Text
"siste søndag i mars 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
"tredje dag i oktober"
             , Text
"tredje dag i Oktober"
             ]
  , (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
"første uke i oktober 2014"
             , Text
"første uke i Oktober 2014"
             ]
  , (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
"siste dag i oktober 2015"
             , Text
"siste dag i Oktober 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
"siste uke i september 2014"
             , Text
"siste uke i September 2014"
             ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples (Datetime -> Grain -> Context -> TimeValue
datetime (Integer
2013, Int
10, Int
1, Int
0, Int
0, Pico
0) Grain
Day)
             [ Text
"første tirsdag i oktober"
             , Text
"første tirsdag i Oktober"
             ]
  , (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
"tredje tirsdag i september 2014"
             , Text
"tredje tirsdag i September 2014"
             ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples (Datetime -> Grain -> Context -> TimeValue
datetime (Integer
2014, Int
10, Int
1, Int
0, Int
0, Pico
0) Grain
Day)
             [ Text
"første onsdag i oktober 2014"
             , Text
"første onsdag i Oktober 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
"andre onsdag i oktober 2014"
             , Text
"andre onsdag i Oktober 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
"klokken 3"
             , Text
"klokka 3"
             , Text
"kl. 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"
             ]
  , (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
"klokken 15"
             , Text
"klokka 15"
             , Text
"kl. 15"
             , Text
"15h"
             ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples (Datetime -> Grain -> Context -> TimeValue
datetime (Integer
2013, Int
2, Int
12, Int
15, Int
0, Pico
0) Grain
Hour)
             [ Text
"ca. kl. 15"
             , Text
"cirka kl. 15"
             , Text
"omkring klokken 15"
             , Text
"omkring klokka 15"
             ]
  , (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
"imorgen klokken 17 sharp"
             , Text
"imorra klokken 17 sharp"
             , Text
"imorgen klokka 17 presis"
             , Text
"imorra klokka 17 presis"
             , Text
"imorgen kl. 17 presis"
             , Text
"imorra kl. 17 presis"
             ]
  , (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
"kvarter over 15"
             , Text
"kvart over 15"
             , Text
"15: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
"kl. 20 over 15"
             , Text
"klokken 20 over 15"
             , Text
"klokka 20 over 15"
             , Text
"kl. 15:20"
             , Text
"15:20"
             ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples (Datetime -> Grain -> Context -> TimeValue
datetime (Integer
2013, Int
2, Int
12, Int
15, Int
30, Pico
0) Grain
Minute)
             [ Text
"15:30"
             ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples (Datetime -> Grain -> Context -> TimeValue
datetime (Integer
2013, Int
2, Int
12, Int
15, Int
23, Pico
24) Grain
Second)
             [ Text
"15:23:24"
             ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples (Datetime -> Grain -> Context -> TimeValue
datetime (Integer
2013, Int
2, Int
12, Int
11, Int
45, Pico
0) Grain
Minute)
             [ Text
"kvarter på 12"
             , Text
"kvart på 12"
             , Text
"11:45"
             ]
  , (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
"klokken 9 på lørdag"
             , Text
"klokka 9 på lørdag"
             ]
  , (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
"Fre, Jul 18, 2014 19:00"
             ]
  , (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
"Fre, Jul 18"
             , Text
"Jul 18, Fre"
             ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples (Datetime -> Grain -> Context -> TimeValue
datetime (Integer
2014, Int
9, Int
20, Int
19, Int
30, Pico
0) Grain
Minute)
             [ Text
"kl. 19:30, Lør, 20 sep"
             ]
  , (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
"om 1 sekund"
             , Text
"om ett sekund"
             , Text
"om et sekund"
             , Text
"ett sekund fra nå"
             , Text
"et sekund fra nå"
             ]
  , (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
"om 1 minutt"
             , Text
"om et minutt"
             , Text
"om ett minutt"
             ]
  , (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
"om 2 minutter"
             , Text
"om to minutter"
             , Text
"om 2 minutter mer"
             , Text
"om to minutter mer"
             , Text
"2 minutter fra nå"
             , Text
"to minutter fra nå"
             ]
  , (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
"om 60 minutter"
             ]
  , (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
"om en halv time"
             ]
  , (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
"om 2,5 time"
             , Text
"om 2 og en halv time"
             , Text
"om to og en halv time"
             ]
  , (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
"om én time"
             , Text
"om 1 time"
             , Text
"om 1t"
             ]
  , (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
"om et par timer"
             ]
  , (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
"om 24 timer"
             ]
  , (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
"om en dag"
             ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples (Datetime -> Grain -> Context -> TimeValue
datetime (Integer
2016, Int
2, Int
0, Int
0, Int
0, Pico
0) Grain
Month)
             [ Text
"3 år fra i dag"
             ]
  , (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
"om 7 dager"
             ]
  , (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
"om en uke"
             , Text
"om én uke"
             ]
  , (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
"om ca. en halv time"
             , Text
"om cirka en halv time"
             ]
  , (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 dager siden"
             , Text
"syv dager siden"
             ]
  , (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 dager siden"
             , Text
"fjorten dager siden"
             ]
  , (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
"en uke siden"
             , Text
"én uke siden"
             , Text
"1 uke siden"
             ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples (Datetime -> Grain -> Context -> TimeValue
datetime (Integer
2013, Int
1, Int
22, Int
0, Int
0, Pico
0) Grain
Day)
             [ Text
"3 uker siden"
             , Text
"tre uker siden"
             ]
  , (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
"3 måneder siden"
             , Text
"tre måneder siden"
             ]
  , (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
"to år siden"
             , Text
"2 år siden"
             ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples (Datetime -> Grain -> Context -> TimeValue
datetime (Integer
1954, Int
0, Int
0, 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
12, Int
24, Int
0, Int
0, Pico
0) Grain
Day)
             [ Text
"et år etter julaften"
             , Text
"ett år etter julaften"
             ]
  , (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
"denne sommeren"
             , Text
"den her sommeren"
             ]
  , (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
"denne vinteren"
             , Text
"den her vinteren"
             ]
  , (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
"1 juledag"
             , Text
"1. juledag"
             , Text
"første juledag"
             ]
  , (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
"nyttårsaften"
             ]
  , (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
"nyttårsdag"
             ]
  , (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
"i kveld"
             ]
  , (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
"forrige helg"
             , Text
"sist helg"
             ]
  , (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
"i morgen kveld"
             , Text
"i morra kveld"
             ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples ((Datetime, Datetime) -> Grain -> Context -> TimeValue
datetimeInterval ((Integer
2013, Int
2, Int
13, Int
12, Int
0, Pico
0), (Integer
2013, Int
2, Int
13, Int
14, Int
0, Pico
0)) Grain
Hour)
             [ Text
"i morgen middag"
             , Text
"i morra middag"
             ]
  , (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
"i går kveld"
             ]
  , (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
"denne helgen"
             , Text
"denne helga"
             , Text
"i helga"
             , Text
"i helgen"
             ]
  , (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
"mandag morgen"
             , Text
"mandag morran"
             ]
  , (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
0, Int
0, Pico
0), (Integer
2013, Int
12, Int
31, Int
0, Int
0, Pico
0)) Grain
Day)
             [ Text
"i romjulen"
             , Text
"i romjula"
             ]
  , (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
"siste 2 sekunder"
             , Text
"siste to sekunder"
             ]
  , (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
"neste 3 sekunder"
             , Text
"neste tre sekunder"
             ]
  , (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
"siste 2 minutter"
             , Text
"siste to minutter"
             ]
  , (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
"neste 3 minutter"
             , Text
"neste tre minutter"
             ]
  , (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
"siste 1 time"
             , Text
"seneste 1 time"
             ]
  , (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
"neste 3 timer"
             , Text
"neste tre timer"
             ]
  , (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
"siste 2 dager"
             , Text
"siste to dager"
             , Text
"seneste 2 dager"
             ]
  , (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
"neste 3 dager"
             , Text
"neste tre dager"
             ]
  , (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
"siste 2 uker"
             , Text
"siste to uker"
             , Text
"seneste to uker"
             ]
  , (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
"neste 3 uker"
             , Text
"neste tre uker"
             ]
  , (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
"siste 2 måneder"
             , Text
"siste to måneder"
             , Text
"seneste to måneder"
             ]
  , (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
"neste 3 måneder"
             , Text
"neste tre måneder"
             ]
  , (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
"siste 2 år"
             , Text
"siste to år"
             , Text
"seneste 2 år"
             ]
  , (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
"neste 3 år"
             , Text
"neste tre år"
             ]
  , (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 juli"
             , Text
"13-15 Juli"
             , Text
"13 til 15 Juli"
             , Text
"13 juli til 15 juli"
             ]
  , (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 Aug - 12 Aug"
             , Text
"8 Aug - 12 aug"
             , Text
"8 aug - 12 aug"
             , Text
"8 august - 12 august"
             ]
  , (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 til 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
"fra 9:30 - 11:00 på torsdag"
             , Text
"fra 9:30 til 11:00 på torsdag"
             , Text
"mellom 9:30 og 11:00 på torsdag"
             , Text
"9:30 - 11:00 på torsdag"
             , Text
"9:30 til 11:00 på torsdag"
             , Text
"etter 9:30 men før 11:00 på torsdag"
             , Text
"torsdag fra 9:30 til 11:00"
             , Text
"torsdag mellom 9:30 og 11:00"
             , Text
"fra 9:30 til 11:00 på torsdag"
             ]
  , (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
"torsdag fra 9 til 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-13: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
4, Int
30, Pico
0), (Integer
2013, Int
2, Int
26, Int
0, Int
0, Pico
0)) Grain
Second)
             [ Text
"innenfor 2 uker"
             ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples (IntervalDirection -> Datetime -> Grain -> Context -> TimeValue
datetimeOpenInterval IntervalDirection
Before (Integer
2013, Int
2, Int
12, Int
14, Int
0, Pico
0) Grain
Hour)
             [ Text
"innen kl. 14"
             , Text
"innen klokken 14"
             , Text
"innen klokka 14"
             ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples (Datetime -> Grain -> Context -> TimeValue
datetime (Integer
2013, Int
2, Int
12, Int
13, Int
0, Pico
0) Grain
Minute)
             [ Text
"16h CET"
             , Text
"kl. 16 CET"
             , Text
"klokken 16 CET"
             , Text
"klokka 16 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
"torsdag kl. 8:00 GMT"
             , Text
"torsdag kl. 8:00 gmt"
             , Text
"torsdag klokken 8:00 GMT"
             , Text
"torsdag klokka 8:00 GMT"
             , Text
"torsdag klokken 8:00 gmt"
             , Text
"torsdag klokka 8:00 gmt"
             , Text
"torsdag 08:00 GMT"
             , Text
"torsdag 08:00 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
"idag kl. 14"
             , Text
"idag klokken 14"
             , Text
"idag klokka 14"
             , Text
"kl. 14"
             , Text
"klokken 14"
             , Text
"klokka 14"
             ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples (Datetime -> Grain -> Context -> TimeValue
datetime (Integer
2013, Int
4, Int
25, Int
16, Int
0, Pico
0) Grain
Minute)
             [ Text
"25/4 kl. 16:00"
             , Text
"25/4 klokken 16:00"
             , Text
"25/4 klokka 16:00"
             , Text
"25-04 klokken 16:00"
             , Text
"25-04 klokka 16:00"
             , Text
"25-4 kl. 16:00"
             ]
  , (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
Minute)
             [ Text
"15:00 i morgen"
             , Text
"15:00 i morra"
             , Text
"kl. 15:00 i morgen"
             , Text
"kl. 15:00 i morra"
             , Text
"klokken 15:00 i morgen"
             , Text
"klokken 15:00 i morra"
             , Text
"klokka 15:00 i morgen"
             , Text
"klokka 15:00 i morra"
             ]
  , (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
"etter kl. 14"
             , Text
"etter klokken 14"
             , Text
"etter klokka 14"
             ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples (IntervalDirection -> Datetime -> Grain -> Context -> TimeValue
datetimeOpenInterval IntervalDirection
After (Integer
2013, Int
2, Int
17, Int
4, Int
0, Pico
0) Grain
Hour)
             [ Text
"etter 5 dager"
             , Text
"etter fem dager"
             ]
  , (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
"om 5 dager"
             , Text
"om fem dager"
             ]
  , (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
13, Int
14, Int
0, Pico
0) Grain
Hour)
             [ Text
"etter i morgen kl. 14"
             , Text
"etter i morra kl. 14"
             , Text
"etter i morgen klokken 14"
             , Text
"etter i morra klokken 14"
             , Text
"etter i morgen klokka 14"
             , Text
"etter i morra klokka 14"
             , Text
"i morgen etter kl. 14"
             , Text
"i morra etter kl. 14"
             , Text
"i morgen etter klokken 14"
             , Text
"i morra etter klokken 14"
             , Text
"i morgen etter klokka 14"
             , Text
"i morra etter klokka 14"
             ]
  , (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
"før kl. 11"
             , Text
"før klokken 11"
             , Text
"før klokka 11"
             ]
  , (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
13, Int
11, Int
0, Pico
0) Grain
Hour)
             [ Text
"i morgen før kl. 11"
             , Text
"i morra før kl. 11"
             , Text
"i morgen før klokken 11"
             , Text
"i morra før klokken 11"
             , Text
"i morgen før klokka 11"
             , Text
"i morra før klokka 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
12, Int
0, Pico
0), (Integer
2013, Int
2, Int
12, Int
19, Int
0, Pico
0)) Grain
Hour)
             [ Text
"om ettermiddagen"
             ]
  , (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
"kl. 13:30"
             , Text
"klokken 13:30"
             , Text
"klokka 13: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
"om 15 minutter"
             ]
  , (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
"etter frokost"
             ]
  , (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"
             ]
  , (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
"denne morgen"
             , Text
"denne morran"
             ]
  , (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
"neste mandag"
             ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples (Datetime -> Grain -> Context -> TimeValue
datetime (Integer
2014, Int
2, Int
9, Int
0, Int
0, Pico
0) Grain
Day)
             [ Text
"morsdag"
             ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples (Datetime -> Grain -> Context -> TimeValue
datetime (Integer
2013, Int
11, Int
10, Int
0, Int
0, Pico
0) Grain
Day)
             [ Text
"farsdag"
             ]
  ]