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

import Data.String
import Prelude

import Duckling.Locale
import Duckling.Numeral.Types
import Duckling.Resolve
import Duckling.Testing.Types

corpus :: Corpus
corpus :: Corpus
corpus = (Context
testContext {locale :: Locale
locale = Lang -> Maybe Region -> Locale
makeLocale Lang
AR 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
  [ NumeralValue -> [Text] -> [Example]
forall a. ToJSON a => a -> [Text] -> [Example]
examples (Double -> NumeralValue
NumeralValue Double
0)
             [ Text
"0"
             , Text
"صفر"
             , Text
"٠"
             , Text
"٠٫٠"
             ]
  , NumeralValue -> [Text] -> [Example]
forall a. ToJSON a => a -> [Text] -> [Example]
examples (Double -> NumeralValue
NumeralValue Double
1)
             [ Text
"1"
             , Text
"واحد"
             , Text
"١"
             , Text
"١٫٠"
             ]
  , NumeralValue -> [Text] -> [Example]
forall a. ToJSON a => a -> [Text] -> [Example]
examples (Double -> NumeralValue
NumeralValue Double
4)
             [ Text
"4"
             , Text
"أربعة"
             , Text
"أربع"
             , Text
"اربعه"
             , Text
"٤"
             , Text
"٤٫٠"
             ]
  , NumeralValue -> [Text] -> [Example]
forall a. ToJSON a => a -> [Text] -> [Example]
examples (Double -> NumeralValue
NumeralValue Double
6)
             [ Text
"6"
             , Text
"ستة"
             , Text
"ست"
             , Text
"سته"
             , Text
"٦"
             , Text
"٦٫٠"
             ]
  , NumeralValue -> [Text] -> [Example]
forall a. ToJSON a => a -> [Text] -> [Example]
examples (Double -> NumeralValue
NumeralValue Double
10)
             [ Text
"10"
             , Text
"عشرة"
             , Text
"عشره"
             , Text
"١٠"
             , Text
"١٠٫٠"
             ]
  , NumeralValue -> [Text] -> [Example]
forall a. ToJSON a => a -> [Text] -> [Example]
examples (Double -> NumeralValue
NumeralValue Double
11)
             [ Text
"11"
             , Text
"إحدى عشرة"
             , Text
"إحدى عشر"
             , Text
"احد عشر"
             , Text
"١١"
             , Text
"١١٫٠"
             ]
  , NumeralValue -> [Text] -> [Example]
forall a. ToJSON a => a -> [Text] -> [Example]
examples (Double -> NumeralValue
NumeralValue Double
12)
             [ Text
"12"
             , Text
"إثنتى عشر"
             , Text
"إثنى عشر"
             , Text
"١٢"
             , Text
"١٢٫٠"
             ]
  , NumeralValue -> [Text] -> [Example]
forall a. ToJSON a => a -> [Text] -> [Example]
examples (Double -> NumeralValue
NumeralValue Double
14)
             [ Text
"14"
             , Text
"أربع عشر"
             , Text
"١٤"
             , Text
"١٤٫٠"
             ]
  , NumeralValue -> [Text] -> [Example]
forall a. ToJSON a => a -> [Text] -> [Example]
examples (Double -> NumeralValue
NumeralValue Double
16)
             [ Text
"16"
             , Text
"ستة عشر"
             , Text
"١٦"
             , Text
"١٦٫٠"
             ]
  , NumeralValue -> [Text] -> [Example]
forall a. ToJSON a => a -> [Text] -> [Example]
examples (Double -> NumeralValue
NumeralValue Double
17)
             [ Text
"17"
             , Text
"سبع عشر"
             , Text
"١٧"
             , Text
"١٧٫٠"
             ]
  , NumeralValue -> [Text] -> [Example]
forall a. ToJSON a => a -> [Text] -> [Example]
examples (Double -> NumeralValue
NumeralValue Double
18)
             [ Text
"18"
             , Text
"ثمان عشرة"
             , Text
"١٨"
             , Text
"١٨٫٠"
             ]
  , NumeralValue -> [Text] -> [Example]
forall a. ToJSON a => a -> [Text] -> [Example]
examples (Double -> NumeralValue
NumeralValue Double
20)
             [ Text
"عشرون"
             , Text
"عشرين"
             , Text
"٢٠"
             , Text
"٢٠٫٠"
             ]
  , NumeralValue -> [Text] -> [Example]
forall a. ToJSON a => a -> [Text] -> [Example]
examples (Double -> NumeralValue
NumeralValue Double
21)
             [ Text
"واحدة و عشرون"
             , Text
"21"
             , Text
"٢١"
             , Text
"٢١٫٠"
             ]
  , NumeralValue -> [Text] -> [Example]
forall a. ToJSON a => a -> [Text] -> [Example]
examples (Double -> NumeralValue
NumeralValue Double
24)
             [ Text
"أربعة و عشرون"
             , Text
"24"
             , Text
"٢٤"
             , Text
"٢٤٫٠"
             ]
  , NumeralValue -> [Text] -> [Example]
forall a. ToJSON a => a -> [Text] -> [Example]
examples (Double -> NumeralValue
NumeralValue Double
26)
             [ Text
"ستة و عشرون"
             , Text
"26"
             , Text
"٢٦"
             , Text
"٢٦٫٠"
             ]
  , NumeralValue -> [Text] -> [Example]
forall a. ToJSON a => a -> [Text] -> [Example]
examples (Double -> NumeralValue
NumeralValue Double
20)
             [ Text
"عشرون"
             , Text
"عشرين"
             , Text
"٢٠"
             ]
  , NumeralValue -> [Text] -> [Example]
forall a. ToJSON a => a -> [Text] -> [Example]
examples (Double -> NumeralValue
NumeralValue Double
30)
             [ Text
"ثلاثون"
             , Text
"ثلاثين"
             , Text
"٣٠"
             , Text
"٣٠٫٠"
             ]
  , NumeralValue -> [Text] -> [Example]
forall a. ToJSON a => a -> [Text] -> [Example]
examples (Double -> NumeralValue
NumeralValue Double
33)
             [ Text
"33"
             , Text
"ثلاث و ثلاثون"
             , Text
"٣٣"
             , Text
"٣٣٫٠"
             ]
  , NumeralValue -> [Text] -> [Example]
forall a. ToJSON a => a -> [Text] -> [Example]
examples (Double -> NumeralValue
NumeralValue Double
40)
             [ Text
"اربعون"
             , Text
"أربعين"
             , Text
"٤٠"
             , Text
"٤٠٫٠"
             ]
  , NumeralValue -> [Text] -> [Example]
forall a. ToJSON a => a -> [Text] -> [Example]
examples (Double -> NumeralValue
NumeralValue Double
200)
             [ Text
"مائتين"
             , Text
"مائتان"
             , Text
"٢٠٠"
             , Text
"٢٠٠٫٠"
             ]
  , NumeralValue -> [Text] -> [Example]
forall a. ToJSON a => a -> [Text] -> [Example]
examples (Double -> NumeralValue
NumeralValue Double
300)
             [ Text
"ثلاثمائة"
             , Text
"٣٠٠"
             , Text
"٣٠٠٫٠"
             ]
  , NumeralValue -> [Text] -> [Example]
forall a. ToJSON a => a -> [Text] -> [Example]
examples (Double -> NumeralValue
NumeralValue Double
350)
             [ Text
"ثلاثمائة وخمسين"
             , Text
"٣٥٠"
             , Text
"٣٥٠٫٠"
             ]
  , NumeralValue -> [Text] -> [Example]
forall a. ToJSON a => a -> [Text] -> [Example]
examples (Double -> NumeralValue
NumeralValue Double
500)
             [ Text
"خمسمائة"
             , Text
"٥٠٠"
             , Text
"٥٠٠٫٠"
             ]
  , NumeralValue -> [Text] -> [Example]
forall a. ToJSON a => a -> [Text] -> [Example]
examples (Double -> NumeralValue
NumeralValue Double
525)
             [ Text
"خمسمائة و خمسة و عشرون"
             , Text
"525"
             , Text
"٥٢٥"
             , Text
"٥٢٥٫٠"
             ]
  , NumeralValue -> [Text] -> [Example]
forall a. ToJSON a => a -> [Text] -> [Example]
examples (Double -> NumeralValue
NumeralValue Double
700)
             [ Text
"سبعمائة"
             , Text
"٧٠٠"
             , Text
"٧٠٠٫٠"
             ]
  , NumeralValue -> [Text] -> [Example]
forall a. ToJSON a => a -> [Text] -> [Example]
examples (Double -> NumeralValue
NumeralValue Double
1.1)
             [ Text
"1.1"
             , Text
"1.10"
             , Text
"01.10"
             , Text
"1 فاصلة 1"
             , Text
"واحد فاصلة واحد"
             , Text
"١١/١٠"
             , Text
"١٫١"
             , Text
"١٫١٠"
             ]
  , NumeralValue -> [Text] -> [Example]
forall a. ToJSON a => a -> [Text] -> [Example]
examples (Double -> NumeralValue
NumeralValue Double
0.77)
             [ Text
"0.77"
             , Text
".77"
             , Text
"٧٧/١٠٠"
             , Text
"٫٧٧"
             , Text
"٠٫٧٧"
             , Text
"٠٫٧٧٠"
             ]
  , NumeralValue -> [Text] -> [Example]
forall a. ToJSON a => a -> [Text] -> [Example]
examples (Double -> NumeralValue
NumeralValue Double
2000)
             [ Text
"2000"
             , Text
"الفان"
             , Text
"٢٠٠٠"
             , Text
"الفين"
             ]
  , NumeralValue -> [Text] -> [Example]
forall a. ToJSON a => a -> [Text] -> [Example]
examples (Double -> NumeralValue
NumeralValue Double
100000)
             [ Text
"100000"
             , Text
"100 الف"
             , Text
"١٠٠٠٠٠"
             , Text
"١٠٠٠٠٠٫٠٠"
             , Text
"١٠٠٬٠٠٠"
             , Text
"١٠٠٬٠٠٠٫٠"
             ]
  , NumeralValue -> [Text] -> [Example]
forall a. ToJSON a => a -> [Text] -> [Example]
examples (Double -> NumeralValue
NumeralValue Double
10000)
             [ Text
"10000"
             , Text
"10 آلاف"
             , Text
"١٠٠٠٠"
             , Text
"١٠٠٠٠٫٠٠"
             , Text
"١٠٬٠٠٠"
             , Text
"١٠٬٠٠٠٫٠٠"
             ]
  , NumeralValue -> [Text] -> [Example]
forall a. ToJSON a => a -> [Text] -> [Example]
examples (Double -> NumeralValue
NumeralValue Double
1000000)
             [ Text
"1000000"
             , Text
"مليون"
             , Text
"١٠٠٠٠٠٠"
             , Text
"١٠٠٠٠٠٠٫٠٠"
             , Text
"١٬٠٠٠٬٠٠٠"
             , Text
"١٬٠٠٠٬٠٠٠٫٠٠"
             ]
  , NumeralValue -> [Text] -> [Example]
forall a. ToJSON a => a -> [Text] -> [Example]
examples (Double -> NumeralValue
NumeralValue Double
2000000)
             [ Text
"2000000"
             , Text
"2 مليون"
             , Text
"مليونان"
             , Text
"مليونين"
             , Text
"٢٠٠٠٠٠٠"
             , Text
"٢٠٠٠٠٠٠٫٠٠"
             , Text
"٢٬٠٠٠٬٠٠٠"
             , Text
"٢٬٠٠٠٬٠٠٠٫٠٠"
             ]
  , NumeralValue -> [Text] -> [Example]
forall a. ToJSON a => a -> [Text] -> [Example]
examples (Double -> NumeralValue
NumeralValue Double
3000000)
             [ Text
"3 ملايين"
             , Text
"3000000"
             , Text
"3 مليون"
             , Text
"٣٠٠٠٠٠٠"
             , Text
"٣٠٠٠٠٠٠٫٠٠"
             , Text
"٣٬٠٠٠٬٠٠٠"
             , Text
"٣٬٠٠٠٬٠٠٠٫٠٠"
             ]
  , NumeralValue -> [Text] -> [Example]
forall a. ToJSON a => a -> [Text] -> [Example]
examples (Double -> NumeralValue
NumeralValue (-Double
1200000))
             [ Text
"-1200000"
             , Text
"-١٢٠٠٠٠٠"
             , Text
"-١٢٠٠٠٠٠٫٠٠"
             , Text
"-١٬٢٠٠٬٠٠٠"
             , Text
"-١٬٢٠٠٬٠٠٠٫٠٠"
             ]
  , NumeralValue -> [Text] -> [Example]
forall a. ToJSON a => a -> [Text] -> [Example]
examples (Double -> NumeralValue
NumeralValue (-Double
1.2))
             [ Text
"-١٢/١٠"
             , Text
"-1.2"
             , Text
"-١٫٢"
             , Text
"-١٫٢٠"
             ]
  ]