-- 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.AR.Corpus
  ( corpus
  , negativeCorpus
  ) 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)

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

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

negativeCorpus :: NegativeCorpus
negativeCorpus :: NegativeCorpus
negativeCorpus = (Context
context, Options
testOptions, [Text]
examples)
  where
    examples :: [Text]
examples =
      [ Text
"حب"
      ]

allExamples :: [Example]
allExamples :: [Example]
allExamples = [[Example]] -> [Example]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
  [ (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples (Datetime -> Grain -> Context -> TimeValue
datetime (Integer
2013, Int
2, Int
12, Int
4, Int
30, Pico
0) Grain
Second)
             [ Text
"حالا"
             , Text
"الان"
             , Text
"في هذه اللحظة"
             ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples (Datetime -> Grain -> Context -> TimeValue
datetime (Integer
2013, Int
2, Int
12, Int
0, Int
0, Pico
0) Grain
Day)
             [ Text
"اليوم"
             , Text
"في هذا اليوم"
             ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples (Datetime -> Grain -> Context -> TimeValue
datetime (Integer
2013, Int
2, Int
1, Int
0, Int
0, Pico
0) Grain
Day)
             [ Text
"2/2013"
             , Text
"الاول من شهر شباط"
             , Text
"الاول من شباط"
             , Text
"في اول شباط"
             ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples (Datetime -> Grain -> Context -> TimeValue
datetime (Integer
2013, Int
2, Int
11, Int
0, Int
0, Pico
0) Grain
Day)
             [ Text
"امس"
             , Text
"البارحة"
             , Text
"اليوم الماضي"
             , Text
"اليوم السابق"
             , Text
"اليوم المنصرم"
             ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples (Datetime -> Grain -> Context -> TimeValue
datetime (Integer
2013, Int
2, Int
13, Int
0, Int
0, Pico
0) Grain
Day)
             [ Text
"غدا"
             , Text
"بكرة"
             , Text
"يوم غد"
             , Text
"بكرا"
             ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples (Datetime -> Grain -> Context -> TimeValue
datetime (Integer
2013, Int
2, Int
18, Int
0, Int
0, Pico
0) Grain
Day)
             [ Text
"الاثنين"
             , Text
"هذا الاثنين"
             , Text
"يوم الاثنين في 18 شباط"
             , Text
"الاثنين 18 شباط"
             ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples (Datetime -> Grain -> Context -> TimeValue
datetime (Integer
2013, Int
2, Int
19, Int
0, Int
0, Pico
0) Grain
Day)
             [ Text
"الثلاثاء"
             , Text
"الثلاثاء التاسع عشر من هذا الشهر"
             ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples (Datetime -> Grain -> Context -> TimeValue
datetime (Integer
2013, Int
2, Int
15, Int
0, Int
0, Pico
0) Grain
Day)
             [ Text
"الجمعة"
             , Text
"الجمعه"
             , Text
"يوم الجمعة 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
0, Int
0, Pico
0) Grain
Day)
             [ Text
"الخميس 15 اغسطس"
             ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples (Datetime -> Grain -> Context -> TimeValue
datetime (Integer
2013, Int
2, Int
14, Int
0, Int
0, Pico
0) Grain
Day)
             [ Text
"الخميس"
             , Text
"الخميس الموافق 14 شهر شباط"
             ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples (Datetime -> Grain -> Context -> TimeValue
datetime (Integer
2013, Int
2, Int
16, Int
0, Int
0, Pico
0) Grain
Day)
             [ Text
"السبت"
             , Text
"السبت السادس عشر"
             ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples (Datetime -> Grain -> Context -> TimeValue
datetime (Integer
2013, Int
2, Int
17, Int
0, Int
0, Pico
0) Grain
Day)
             [ Text
"الاحد"
             , Text
"الأحد السابع عشرة"
             ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples (Datetime -> Grain -> Context -> TimeValue
datetime (Integer
2013, Int
3, Int
15, Int
0, Int
0, Pico
0) Grain
Day)
             [ Text
"نص شهر ثلاث"
             , Text
"منتصف اذار"
             , Text
"في نصف شهر مارس"
             ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples (Datetime -> Grain -> Context -> TimeValue
datetime (Integer
2013, Int
3, Int
1, Int
0, Int
0, Pico
0) Grain
Day)
             [ Text
"الاول من اذار"
             , Text
"1 مارس"
             , Text
"في الاول من مارس"
             , Text
"اليوم الاول من شهر ثلاثة"
             , Text
"بداية شهر 3"
             ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples (Datetime -> Grain -> Context -> TimeValue
datetime (Integer
2013, Int
4, Int
4, Int
0, Int
0, Pico
0) Grain
Day)
             [ Text
"الرابع من ابريل"
             , Text
"الرابع من نيسان"
             , Text
"4 ابريل"
             ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples (Datetime -> Grain -> Context -> TimeValue
datetime (Integer
2013, Int
2, Int
19, Int
0, Int
0, Pico
0) Grain
Day)
             [ Text
"الثلاثاء القادم"
             , Text
"قرابة الثلاثاء القادم"
             ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples (Datetime -> Grain -> Context -> TimeValue
datetime (Integer
2013, Int
2, Int
13, Int
0, Int
0, Pico
0) Grain
Day)
             [ Text
"الاربعاء، 13 شباط"
             , Text
"الثالث عشرة من شباط"
             , Text
"الاربعاء الموافق الثالث عشر من شباط 2013"
             ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples (Datetime -> Grain -> Context -> TimeValue
datetime (Integer
2013, Int
2, Int
4, Int
0, Int
0, Pico
0) Grain
Week)
             [ Text
"الاسبوع الماضي"
             , Text
"الاسبوع السابق"
             , Text
"الاسبوع المنصرم"
             ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples (Datetime -> Grain -> Context -> TimeValue
datetime (Integer
2013, Int
2, Int
5, Int
0, Int
0, Pico
0) Grain
Day)
             [ Text
"قبل اسبوع"
             , Text
"من اسبوع"
             ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples (Datetime -> Grain -> Context -> TimeValue
datetime (Integer
2013, Int
2, Int
11, Int
0, Int
0, Pico
0) Grain
Week)
             [ Text
"هذا الاسبوع"
             , Text
"الاسبوع الحالي"
             ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples (Datetime -> Grain -> Context -> TimeValue
datetime (Integer
2013, Int
2, Int
18, Int
0, Int
0, Pico
0) Grain
Week)
             [ Text
"الاسبوع القادم"
             , Text
"الاسبوع التالي"
             , Text
"الاسبوع المقبل"
             , Text
"الاسبوع الجاي"
             ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples (Datetime -> Grain -> Context -> TimeValue
datetime (Integer
2013, Int
1, Int
1, Int
0, Int
0, Pico
0) Grain
Month)
             [ Text
"الشهر الماض" ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples (Datetime -> Grain -> Context -> TimeValue
datetime (Integer
2013, Int
3, Int
1, Int
0, Int
0, Pico
0) Grain
Month)
             [ Text
"الشهر التالي" ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples (Datetime -> Grain -> Context -> TimeValue
datetime (Integer
2012, Int
1, Int
1, Int
0, Int
0, Pico
0) Grain
Year)
             [ Text
"السنة السابقة" ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples (Datetime -> Grain -> Context -> TimeValue
datetime (Integer
2014, Int
1, Int
1, Int
0, Int
0, Pico
0) Grain
Year)
             [ Text
"السنة القادمة" ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples (Datetime -> Grain -> Context -> TimeValue
datetime (Integer
2013, Int
1, Int
1, Int
0, Int
0, Pico
0) Grain
Year)
             [ Text
"السنة الحالية"
             , Text
"هذه السنة"
             ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples (Datetime -> Grain -> Context -> TimeValue
datetime (Integer
2013, Int
2, Int
10, Int
0, Int
0, Pico
0) Grain
Day)
             [ Text
"الاحد الماضي"
             , Text
"احد الاسبوع الماضي"
             , Text
"الاحد من الاسبوع الماضي"
             ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples (Datetime -> Grain -> Context -> TimeValue
datetime (Integer
2013, Int
2, Int
11, Int
0, Int
0, Pico
0) Grain
Day)
             [ Text
"اثنين الاسبوع الحالي"
             , Text
"الاثنين من هذا الاسبوع"
             ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples (Datetime -> Grain -> Context -> TimeValue
datetime (Integer
2013, Int
2, Int
5, Int
0, Int
0, Pico
0) Grain
Day)
             [ Text
"الثلاثاء الماضي"
             , Text
"يوم الثلاثاء السابق"
             , Text
"ثلاثاء الاسبوع الفائت"
             ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples (Datetime -> Grain -> Context -> TimeValue
datetime (Integer
2013, Int
2, Int
14, Int
0, Int
0, Pico
0) Grain
Day)
             [ Text
"يوم بعد غد"
             , Text
"اليوم الذي بعد الغد"
             , Text
"اليوم الي بعد بكرة"
             ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples (Datetime -> Grain -> Context -> TimeValue
datetime (Integer
2013, Int
2, Int
10, Int
0, Int
0, Pico
0) Grain
Day)
             [ Text
"يوم قبل امس"
             , Text
"اليوم القبل البارحة"
             , Text
"اليوم الي قبل امبارح"
             ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples (Datetime -> Grain -> Context -> TimeValue
datetime (Integer
2013, Int
3, Int
25, Int
0, Int
0, Pico
0) Grain
Day)
             [ Text
"اخر اثنين من شهر اذار"
             , Text
"الاثنين الاخير من شهر ثلاثة"
             , Text
"اخر اثنين من الشهر القادم"
             ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples (Datetime -> Grain -> Context -> TimeValue
datetime (Integer
2014, Int
3, Int
25, Int
0, Int
0, Pico
0) Grain
Day)
             [ Text
"الثلاثاء الاخير من شهر مارس السنة القادمة" ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples (Datetime -> Grain -> Context -> TimeValue
datetime (Integer
2013, Int
10, Int
3, Int
0, Int
0, Pico
0) Grain
Day)
             [ Text
"اليوم الثالث من اكتوبر"
             , Text
"اليوم الثالث من شهر عشرة"
             , Text
"ثالث يوم من شهر عشرة"
             ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples (Datetime -> Grain -> Context -> TimeValue
datetime (Integer
2014, Int
10, Int
6, Int
0, Int
0, Pico
0) Grain
Week)
             [ Text
"اول اسبوع بشهر اكتوبر 2014"
             , Text
"الاسبوع الاول من شهر عشرة 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
"اخر يوم بشهر عشرة سنة 2015"
             , Text
"اليوم الاخير من شهر عشرة سنة 2015"
             ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples (Datetime -> Grain -> Context -> TimeValue
datetime (Integer
2014, Int
9, Int
22, Int
0, Int
0, Pico
0) Grain
Week)
             [ Text
"اخر اسبوع في سبتمبر لعام 2014"
             , Text
"الاسبوع الاخير في الشهر التاسع سنة 2014"
             ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples (Datetime -> Grain -> Context -> TimeValue
datetime (Integer
2013, Int
10, Int
1, Int
0, Int
0, Pico
0) Grain
Day)
             [ Text
"اول ثلاثاء من شهر عشرة"
             , Text
"الثلاثاء الأولى من اكتوبر"
             , Text
"الثلاثا الاول من شهر تشرين الاول"
             ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples (Datetime -> Grain -> Context -> TimeValue
datetime (Integer
2014, Int
9, Int
16, Int
0, Int
0, Pico
0) Grain
Day)
             [ Text
"الثلاثاء الثالث من شهر ايلول من عام 2014"
             , Text
"ثالث يوم ثلاثاء بايلول بعام 2014"
             , Text
"ثالث ثلاثاء في ايلول في سنة 2014"
             ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples (Datetime -> Grain -> Context -> TimeValue
datetime (Integer
2014, Int
10, Int
8, Int
0, Int
0, Pico
0) Grain
Day)
             [ Text
"ثاني اربعاء من شهر اكتوبر من عام 2014"
             , Text
"ثان اربعا في اكتوبر لعام 2014"
             , Text
"الاربعاء الثانية من شهر اكتوبر في سنة 2014"
             ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples (Datetime -> Grain -> Context -> TimeValue
datetime (Integer
2015, Int
1, Int
13, Int
0, Int
0, Pico
0) Grain
Day)
             [ Text
"ثالث ثلاثاء بعد كريسماس 2014"
             ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples (Datetime -> Grain -> Context -> TimeValue
datetime (Integer
2013, Int
2, Int
12, Int
3, Int
0, Pico
0) Grain
Hour)
             [ Text
"الساعة 3 صباحا"
             , Text
"الساعة ثلاثة الصبح"
             , Text
"عند الساعة الثالثة صباحا"
             , Text
"الساعة 3 الفجر"
             , Text
"الثالثة فجرا"
             ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples (Datetime -> Grain -> Context -> TimeValue
datetime (Integer
2013, Int
2, Int
12, Int
3, Int
18, Pico
0) Grain
Minute)
             [ Text
"3:18 صباحا"
             , Text
"الساعة ثلاثة وثمانية عشرة دقيقة صباحا"
             , Text
"الساعة الثالثة و18 دقيقة الصبح"
             , Text
"الساعة 3 و 18 دقيقة صباحا"
             , Text
"عند الثالثة وثمانية عشر دقيقة صباحا"
             ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples (Datetime -> Grain -> Context -> TimeValue
datetime (Integer
2013, Int
2, Int
12, Int
15, Int
0, Pico
0) Grain
Hour)
             [ Text
"الساعة الثالثة عصرا"
             , Text
"بحدود الساعة الثالثة"
             , Text
"حوالي الساعة 3"
             , Text
"الساعة 3 بعد الظهر"
             , Text
"الساعة 3 عصرا"
             , Text
"الساعة 3 العصر"
             ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples (Datetime -> Grain -> Context -> TimeValue
datetime (Integer
2013, Int
2, Int
12, Int
15, Int
15, Pico
0) Grain
Minute)
             [ Text
"الساعة 3 و15 دقيقة عصرا"
             , Text
"الساعة الثالثة وربع العصر"
             , Text
"الثالثة وربع بعد الظهر"
             , Text
"15:15"
             , Text
"الساعة الثالثة وخمسة عشر دقيقة عصرا"
             ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples (Datetime -> Grain -> Context -> TimeValue
datetime (Integer
2013, Int
2, Int
12, Int
15, Int
20, Pico
0) Grain
Minute)
             [ Text
"الساعة ثلاثة وثلث مساءا"
             , Text
"3: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
12, Int
30, Pico
0) Grain
Minute)
             [ Text
"الساعة الثانية عشرة ونصف ظهرا"
             , Text
"12:30"
             , Text
"12:30 ظهرا"
             ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples (Datetime -> Grain -> Context -> TimeValue
datetime (Integer
2013, Int
2, Int
12, Int
15, Int
23, Pico
24) Grain
Second)
             [ Text
"15:23:24"
             ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples (Datetime -> Grain -> Context -> TimeValue
datetime (Integer
2013, Int
2, Int
12, Int
11, Int
45, Pico
0) Grain
Minute)
             [ Text
"الساعة 11:45 قبل الظهر"
             , Text
"الساعة 12 الا ربع قبل الظهر"
             , Text
"الساعة الحادية عشر وخمس واربعون دقيقة صباحا"
             , Text
"الساعة الثانية عشر إلا ربعا هذا الصباح"
             ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples (Datetime -> Grain -> Context -> TimeValue
datetime (Integer
2013, Int
2, Int
12, Int
16, Int
40, Pico
0) Grain
Minute)
             [ Text
"الساعة الخامسة الا ثلث بعد العصر"
             , Text
"الساعة خمسة إلا ثلث قبل المغرب"
             , Text
"الساعة الرابعة واربعون دقيقة بعد العصر"
             ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples (Datetime -> Grain -> Context -> TimeValue
datetime (Integer
2013, Int
2, Int
12, Int
20, Int
0, Pico
0) Grain
Hour)
             [ Text
"الساعة 8 بعد المغرب"
             , Text
"الساعة 8 العشاء"
             , Text
"الثامنة هذه الليلة"
             ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples (Datetime -> Grain -> Context -> TimeValue
datetime (Integer
2013, Int
2, Int
14, Int
6, Int
0, Pico
0) Grain
Minute)
             [ Text
"الخميس الساعة 8 بتوقيت GMT"
             , Text
"الخميس الساعة 8 بتوقيت gmt"
             ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples (Datetime -> Grain -> Context -> TimeValue
datetime (Integer
2013, Int
9, Int
21, Int
13, Int
30, Pico
0) Grain
Minute)
             [ Text
"يوم السبت 21/09 الساعة 1:30 بعد الظهر"
             ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples (Datetime -> Grain -> Context -> TimeValue
datetime (Integer
2013, Int
2, Int
12, Int
4, Int
23, Pico
0) Grain
Minute)
             [ Text
"الساعة الرابعة وثلاث وعشرون دقيقة فجرا"
             , Text
"الساعة 4:23 الصبح"
             ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples ((Datetime, Datetime) -> Grain -> Context -> TimeValue
datetimeInterval ((Integer
2013, Int
3, Int
1, Int
0, Int
0, Pico
0), (Integer
2013, Int
3, Int
11, Int
0, Int
0, Pico
0)) Grain
Day)
             [ Text
"في اوائل اذار"
             , Text
"في أوائل شهر مارس"
             ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples ((Datetime, Datetime) -> Grain -> Context -> TimeValue
datetimeInterval ((Integer
2013, Int
3, Int
21, Int
0, Int
0, Pico
0), (Integer
2013, Int
4, Int
1, Int
0, Int
0, Pico
0)) Grain
Day)
             [ Text
"في اواخر اذار"
             , Text
"في أواخر شهر مارس"
             ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples ((Datetime, Datetime) -> Grain -> Context -> TimeValue
datetimeInterval ((Integer
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
"الاسابيع الثلاثة القادمة"
             ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples ((Datetime, Datetime) -> Grain -> Context -> TimeValue
datetimeInterval ((Integer
2013, Int
2, Int
12, Int
15, Int
0, Pico
0), (Integer
2013, Int
2, Int
12, Int
17, Int
0, Pico
0)) Grain
Hour)
             [ Text
"من الساعة 3 الى الساعة 4 بعد العصر"
             , Text
"من الساعة الثالثة الى الساعة الرابعة مساءا"
             ]
  , (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
"الخميس من الساعة التاسعة وحتى الساعة الحادية عشرة صباحا"
             ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples ((Datetime, Datetime) -> Grain -> Context -> TimeValue
datetimeInterval ((Integer
2013, Int
7, Int
13, Int
0, Int
0, Pico
0), (Integer
2013, Int
7, Int
16, Int
0, Int
0, Pico
0)) Grain
Day)
             [ Text
"يوليو 13-15"
             , Text
"تموز 13 الى 15"
             , Text
"13 الى 15 تموز"
             , Text
"من 13 تموز الى 15 تموز"
             , Text
"من 13 الى 15 يوليو"
             ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples ((Datetime, Datetime) -> Grain -> Context -> TimeValue
datetimeInterval ((Integer
2013, Int
2, Int
12, Int
4, Int
30, Pico
0), (Integer
2013, Int
2, Int
12, Int
14, Int
0, Pico
0)) Grain
Second)
             [ Text
"حتى الساعة 2:00"
             ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples ((Datetime, Datetime) -> Grain -> Context -> TimeValue
datetimeInterval ((Integer
2013, Int
2, Int
12, Int
18, Int
0, Pico
0), (Integer
2013, Int
2, Int
13, Int
0, Int
0, Pico
0)) Grain
Hour)
             [ Text
"هذه الليلة"
             , Text
"الليلة"
             ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples ((Datetime, Datetime) -> Grain -> Context -> TimeValue
datetimeInterval ((Integer
2013, Int
2, Int
12, Int
4, Int
30, Pico
0), (Integer
2013, Int
2, Int
26, Int
0, Int
0, Pico
0)) Grain
Second)
             [ Text
"خلال اسبوعين"
             ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples ((Datetime, Datetime) -> Grain -> Context -> TimeValue
datetimeInterval ((Integer
2013, Int
9, Int
1, Int
0, Int
0, Pico
0), (Integer
2013, Int
9, Int
9, Int
0, Int
0, Pico
0)) Grain
Day)
             [ Text
"من 1-8 شهر ايلول"
             ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples ((Datetime, Datetime) -> Grain -> Context -> TimeValue
datetimeInterval ((Integer
2013, Int
10, Int
23, Int
0, Int
0, Pico
0), (Integer
2013, Int
10, Int
27, Int
0, Int
0, Pico
0)) Grain
Day)
             [ Text
"من الثالث والعشرون وحتى السادس والعشرين من شهر اكتوبر"
             ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples ((Datetime, Datetime) -> Grain -> Context -> TimeValue
datetimeInterval ((Integer
2013, Int
8, Int
27, Int
0, Int
0, Pico
0), (Integer
2013, Int
8, Int
30, Int
0, Int
0, Pico
0)) Grain
Day)
             [ Text
"اغسطس 27 الى 29"
             , Text
"من 27-29 من الشهر الثامن"
             ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples (Datetime -> Grain -> Text -> Context -> TimeValue
datetimeHoliday (Integer
2020, Int
12, Int
25, Int
0, Int
0, Pico
0) Grain
Day Text
"عيد الميلاد")
             [ Text
"عيد الميلاد 2020"
             ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples (Datetime -> Grain -> Text -> Context -> TimeValue
datetimeHoliday (Integer
2013, Int
10, Int
15, Int
0, Int
0, Pico
0) Grain
Day Text
"عيد الأضحى")
             [ Text
"عيد الأضحى"
             , Text
"عيد الأضحى 2013"
             ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples (Datetime -> Grain -> Text -> Context -> TimeValue
datetimeHoliday (Integer
2013, Int
8, Int
8, Int
0, Int
0, Pico
0) Grain
Day Text
"عيد الفطر")
             [ Text
"عيد الفطر"
             , Text
"عيد الفطر 2013"
             ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples (Datetime -> Grain -> Text -> Context -> TimeValue
datetimeHoliday (Integer
2013, Int
3, Int
31, Int
0, Int
0, Pico
0) Grain
Day Text
"عيد الفصح")
             [ Text
"عيد الفصح"
             , Text
"عيد الفصح 2013"
             ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples (Datetime -> Grain -> Text -> Context -> TimeValue
datetimeHoliday (Integer
2013, Int
11, Int
4, Int
0, Int
0, Pico
0) Grain
Day Text
"رأس السنة الهجرية")
             [ Text
"رأس السنة الهجرية"
             ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples (Datetime -> Grain -> Text -> Context -> TimeValue
datetimeHoliday (Integer
2019, Int
8, Int
31, Int
0, Int
0, Pico
0) Grain
Day Text
"رأس السنة الهجرية")
             [ Text
"رأس السنة الهجرية 2019"
             ]
  , (Context -> TimeValue) -> [Text] -> [Example]
forall a. ToJSON a => (Context -> a) -> [Text] -> [Example]
examples ((Datetime, Datetime) -> Grain -> Text -> Context -> TimeValue
datetimeIntervalHoliday ((Integer
2019, Int
5, Int
6, Int
0, Int
0, Pico
0), (Integer
2019, Int
6, Int
4, Int
0, Int
0, Pico
0)) Grain
Day Text
"رمضان")
             [ Text
"رمضان 2019"
             ]
  ]