-- 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.ES.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
ES 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
1) [Text
"1", Text
"uno", Text
"una"]
    , NumeralValue -> [Text] -> [Example]
forall a. ToJSON a => a -> [Text] -> [Example]
examples (Double -> NumeralValue
NumeralValue Double
11) [Text
"once"]
    , NumeralValue -> [Text] -> [Example]
forall a. ToJSON a => a -> [Text] -> [Example]
examples
        (Double -> NumeralValue
NumeralValue Double
16)
        [Text
"dieciséis", Text
"dieciseis", Text
"Diesiseis", Text
"diez y seis"]
    , NumeralValue -> [Text] -> [Example]
forall a. ToJSON a => a -> [Text] -> [Example]
examples (Double -> NumeralValue
NumeralValue Double
21) [Text
"veintiuno", Text
"veinte y uno"]
    , NumeralValue -> [Text] -> [Example]
forall a. ToJSON a => a -> [Text] -> [Example]
examples (Double -> NumeralValue
NumeralValue Double
22) [Text
"veintidós"]
    , NumeralValue -> [Text] -> [Example]
forall a. ToJSON a => a -> [Text] -> [Example]
examples (Double -> NumeralValue
NumeralValue Double
23) [Text
"veintitrés", Text
"veinte y tres"]
    , NumeralValue -> [Text] -> [Example]
forall a. ToJSON a => a -> [Text] -> [Example]
examples (Double -> NumeralValue
NumeralValue Double
70) [Text
"setenta"]
    , NumeralValue -> [Text] -> [Example]
forall a. ToJSON a => a -> [Text] -> [Example]
examples (Double -> NumeralValue
NumeralValue Double
78) [Text
"Setenta y ocho"]
    , NumeralValue -> [Text] -> [Example]
forall a. ToJSON a => a -> [Text] -> [Example]
examples (Double -> NumeralValue
NumeralValue Double
80) [Text
"ochenta"]
    , NumeralValue -> [Text] -> [Example]
forall a. ToJSON a => a -> [Text] -> [Example]
examples (Double -> NumeralValue
NumeralValue Double
33) [Text
"33", Text
"treinta y tres", Text
"treinta y 3"]
    , NumeralValue -> [Text] -> [Example]
forall a. ToJSON a => a -> [Text] -> [Example]
examples (Double -> NumeralValue
NumeralValue Double
100000) [Text
"100000", Text
"100K", Text
"100k"]
    , NumeralValue -> [Text] -> [Example]
forall a. ToJSON a => a -> [Text] -> [Example]
examples (Double -> NumeralValue
NumeralValue Double
300) [Text
"trescientos"]
    , NumeralValue -> [Text] -> [Example]
forall a. ToJSON a => a -> [Text] -> [Example]
examples (Double -> NumeralValue
NumeralValue Double
243) [Text
"243"]
    , NumeralValue -> [Text] -> [Example]
forall a. ToJSON a => a -> [Text] -> [Example]
examples (Double -> NumeralValue
NumeralValue Double
3000000) [Text
"3M", Text
"3000K", Text
"3000000"]
    , NumeralValue -> [Text] -> [Example]
forall a. ToJSON a => a -> [Text] -> [Example]
examples (Double -> NumeralValue
NumeralValue Double
1200000) [Text
"1200000", Text
"1200K"]
    , NumeralValue -> [Text] -> [Example]
forall a. ToJSON a => a -> [Text] -> [Example]
examples (Double -> NumeralValue
NumeralValue (-Double
1200000)) [Text
"-1200000", Text
"-1200K"]
    , NumeralValue -> [Text] -> [Example]
forall a. ToJSON a => a -> [Text] -> [Example]
examples (Double -> NumeralValue
NumeralValue Double
1.5) [Text
"1 punto cinco", Text
"una punto cinco"]
    , NumeralValue -> [Text] -> [Example]
forall a. ToJSON a => a -> [Text] -> [Example]
examples (Double -> NumeralValue
NumeralValue Double
1) [Text
"cero uno", Text
"zero uno"]
    , NumeralValue -> [Text] -> [Example]
forall a. ToJSON a => a -> [Text] -> [Example]
examples (Double -> NumeralValue
NumeralValue Double
2) [Text
"cero dos", Text
"zero dos"]
    , NumeralValue -> [Text] -> [Example]
forall a. ToJSON a => a -> [Text] -> [Example]
examples (Double -> NumeralValue
NumeralValue Double
3)
               [
                 Text
"cero tres",
                 Text
"cero trés",
                 Text
"zero tres",
                 Text
"zero trés"
               ]
    , NumeralValue -> [Text] -> [Example]
forall a. ToJSON a => a -> [Text] -> [Example]
examples (Double -> NumeralValue
NumeralValue Double
4) [Text
"cero cuatro", Text
"zero cuatro"]
    , NumeralValue -> [Text] -> [Example]
forall a. ToJSON a => a -> [Text] -> [Example]
examples (Double -> NumeralValue
NumeralValue Double
5) [Text
"cero cinco", Text
"zero cinco"]
    , NumeralValue -> [Text] -> [Example]
forall a. ToJSON a => a -> [Text] -> [Example]
examples (Double -> NumeralValue
NumeralValue Double
6)
               [
                 Text
"cero seis",
                 Text
"cero séis",
                 Text
"zero seis",
                 Text
"zero séis"
               ]
    , NumeralValue -> [Text] -> [Example]
forall a. ToJSON a => a -> [Text] -> [Example]
examples (Double -> NumeralValue
NumeralValue Double
7) [Text
"cero siete", Text
"zero siete"]
    , NumeralValue -> [Text] -> [Example]
forall a. ToJSON a => a -> [Text] -> [Example]
examples (Double -> NumeralValue
NumeralValue Double
8) [Text
"cero ocho", Text
"zero ocho"]
    , NumeralValue -> [Text] -> [Example]
forall a. ToJSON a => a -> [Text] -> [Example]
examples (Double -> NumeralValue
NumeralValue Double
9) [Text
"cero nueve", Text
"zero nueve"]
    ]