-- 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.MX.Corpus (allExamples) where

import Data.String
import Prelude

import Duckling.Numeral.Types
import Duckling.Testing.Types

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"]
    , NumeralValue -> [Text] -> [Example]
forall a. ToJSON a => a -> [Text] -> [Example]
examples (Double -> NumeralValue
NumeralValue Double
33) [Text
"33"]
    , 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"]
    , NumeralValue -> [Text] -> [Example]
forall a. ToJSON a => a -> [Text] -> [Example]
examples (Double -> NumeralValue
NumeralValue Double
0.77) [Text
"0.77", Text
".77"]
    , NumeralValue -> [Text] -> [Example]
forall a. ToJSON a => a -> [Text] -> [Example]
examples (Double -> NumeralValue
NumeralValue Double
100000) [Text
"100,000", Text
"100000"]
    , 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
"3000000", Text
"3,000,000"]
    , NumeralValue -> [Text] -> [Example]
forall a. ToJSON a => a -> [Text] -> [Example]
examples (Double -> NumeralValue
NumeralValue Double
1200000) [Text
"1,200,000", Text
"1200000"]
    , NumeralValue -> [Text] -> [Example]
forall a. ToJSON a => a -> [Text] -> [Example]
examples
        (Double -> NumeralValue
NumeralValue (-Double
1200000))
        [Text
"- 1,200,000", Text
"menos 1,200,000", Text
"-1.2M", Text
"-.0012G"]
    , NumeralValue -> [Text] -> [Example]
forall a. ToJSON a => a -> [Text] -> [Example]
examples (Double -> NumeralValue
NumeralValue Double
1.5) [Text
"1.5"]
    ]