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

import Prelude
import Data.String

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
ZH 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
"零个"
             , Text
"0个"
             ]
  , NumeralValue -> [Text] -> [Example]
forall a. ToJSON a => a -> [Text] -> [Example]
examples (Double -> NumeralValue
NumeralValue Double
1)
             [ Text
"1"
             , Text
"一"
             , Text
"一个"
             , Text
"1个"
             , Text
"壹"
             ]
  , NumeralValue -> [Text] -> [Example]
forall a. ToJSON a => a -> [Text] -> [Example]
examples (Double -> NumeralValue
NumeralValue Double
2)
             [ Text
"2"
             , 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
"拾壹"
             ]
  , NumeralValue -> [Text] -> [Example]
forall a. ToJSON a => a -> [Text] -> [Example]
examples (Double -> NumeralValue
NumeralValue Double
20)
             [ Text
"20"
             , Text
"二十"
             , Text
"貳拾"
             , Text
"廿"
             ]
  , NumeralValue -> [Text] -> [Example]
forall a. ToJSON a => a -> [Text] -> [Example]
examples (Double -> NumeralValue
NumeralValue Double
60)
             [ Text
"60"
             , 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
96)
             [ Text
"96"
             , Text
"九十六"
             , Text
"玖拾陸"
             , Text
"八打"
             ]
  , NumeralValue -> [Text] -> [Example]
forall a. ToJSON a => a -> [Text] -> [Example]
examples (Double -> NumeralValue
NumeralValue Double
203)
             [ Text
"203"
             , Text
"二百零三"
             , Text
"貳佰零參"
             ]
  , NumeralValue -> [Text] -> [Example]
forall a. ToJSON a => a -> [Text] -> [Example]
examples (Double -> NumeralValue
NumeralValue Double
534)
             [ Text
"534"
             , Text
"五百三十四"
             , Text
"伍佰參拾肆"
             , Text
"五百卅四"
             ]
  , NumeralValue -> [Text] -> [Example]
forall a. ToJSON a => a -> [Text] -> [Example]
examples (Double -> NumeralValue
NumeralValue Double
34567)
             [ Text
"34567"
             , Text
"34,567"
             , Text
"三万四千五百六十七"
             , Text
"三萬四千五百六十七"
             , Text
"參萬肆仟伍佰陸拾柒"
             ]
  , NumeralValue -> [Text] -> [Example]
forall a. ToJSON a => a -> [Text] -> [Example]
examples (Double -> NumeralValue
NumeralValue Double
10040)
             [ Text
"10040"
             , Text
"10,040"
             , Text
"一万零四十"
             , 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
"一點一"
             , 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
"零點77"
             ]
  , NumeralValue -> [Text] -> [Example]
forall a. ToJSON a => a -> [Text] -> [Example]
examples (Double -> NumeralValue
NumeralValue Double
34507)
             [ Text
"34507"
             , Text
"34,507"
             , Text
"三万四千五百零七"
             , Text
"三萬四千五百零七"
             , Text
"參萬肆仟伍佰零柒"
             ]
  , NumeralValue -> [Text] -> [Example]
forall a. ToJSON a => a -> [Text] -> [Example]
examples (Double -> NumeralValue
NumeralValue Double
100000)
             [ Text
"100,000"
             , Text
"100000"
             , Text
"100K"
             , Text
"100k"
             , Text
"十万"
             , Text
"十萬"
             , Text
"拾萬"
             ]
  , NumeralValue -> [Text] -> [Example]
forall a. ToJSON a => a -> [Text] -> [Example]
examples (Double -> NumeralValue
NumeralValue Double
3000000)
             [ Text
"3M"
             , Text
"3000000"
             , Text
"3,000,000"
             , Text
"三百万"
             , Text
"三百萬"
             , Text
"參佰萬"
             ]
  , NumeralValue -> [Text] -> [Example]
forall a. ToJSON a => a -> [Text] -> [Example]
examples (Double -> NumeralValue
NumeralValue Double
1040000)
             [ Text
"1,040,000"
             , Text
"1040000"
             , Text
"1.04M"
             , Text
"一百零四万"
             , Text
"一百零四萬"
             , Text
"壹佰零肆萬"
             ]
  , NumeralValue -> [Text] -> [Example]
forall a. ToJSON a => a -> [Text] -> [Example]
examples (Double -> NumeralValue
NumeralValue Double
1200000)
             [ Text
"1,200,000"
             , Text
"1200000"
             , Text
"1.2M"
             , Text
".0012G"
             , Text
"一百二十万"
             , Text
"一百二十萬"
             , Text
"壹佰貳拾萬"
             , Text
"百二萬"
             ]
  , NumeralValue -> [Text] -> [Example]
forall a. ToJSON a => a -> [Text] -> [Example]
examples (Double -> NumeralValue
NumeralValue (-Double
1200000))
             [ Text
"- 1,200,000"
             , Text
"-1200000"
             , Text
"负1,200,000"
             , Text
"负 1,200,000"
             , Text
"負 1,200,000"
             , Text
"负1200000"
             , Text
"负 1200000"
             , Text
"-1.2M"
             , Text
"-1200K"
             , Text
"-.0012G"
             , Text
"负一百二十万"
             , Text
"負一百二十萬"
             , Text
"負壹佰貳拾萬"
             ]
    , NumeralValue -> [Text] -> [Example]
forall a. ToJSON a => a -> [Text] -> [Example]
examples (Double -> NumeralValue
NumeralValue Double
0.5)
             [ Text
"0.5"
             , Text
"一半"
             , Text
"一半半"
             , Text
"1半"
             , Text
"半个"
             , Text
"半個"
             , Text
"零點五"
             , Text
"二分之一"
             , Text
"二份一"
             ]
    , NumeralValue -> [Text] -> [Example]
forall a. ToJSON a => a -> [Text] -> [Example]
examples (Double -> NumeralValue
NumeralValue Double
1100)
             [ Text
"千一"
             , Text
"一千一百"
             ]
    , NumeralValue -> [Text] -> [Example]
forall a. ToJSON a => a -> [Text] -> [Example]
examples (Double -> NumeralValue
NumeralValue Double
19000)
             [ Text
"萬九"
             ]
  ]