{-# LANGUAGE OverloadedStrings #-}
module Duckling.AmountOfMoney.ZH.Corpus
( corpus
) where
import Data.String
import Prelude
import Duckling.AmountOfMoney.Types
import Duckling.Locale
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
[ AmountOfMoneyValue -> [Text] -> [Example]
forall a. ToJSON a => a -> [Text] -> [Example]
examples (Currency -> Double -> AmountOfMoneyValue
simple Currency
Cent Double
5)
[ Text
"五分"
, Text
"5分"
, Text
"五仙"
]
, AmountOfMoneyValue -> [Text] -> [Example]
forall a. ToJSON a => a -> [Text] -> [Example]
examples (Currency -> Double -> AmountOfMoneyValue
simple Currency
Cent Double
20)
[ Text
"20分"
, Text
"二十分"
, Text
"2角"
, Text
"两毛"
, Text
"两毫"
]
, AmountOfMoneyValue -> [Text] -> [Example]
forall a. ToJSON a => a -> [Text] -> [Example]
examples (Currency -> Double -> AmountOfMoneyValue
simple Currency
Cent Double
25)
[ Text
"25分"
, Text
"二十五分"
, Text
"两角五分"
, Text
"两毛五"
]
, AmountOfMoneyValue -> [Text] -> [Example]
forall a. ToJSON a => a -> [Text] -> [Example]
examples (Currency -> Double -> AmountOfMoneyValue
simple Currency
Dollar Double
7)
[ Text
"7块"
, Text
"七元"
, Text
"七蚊"
]
, AmountOfMoneyValue -> [Text] -> [Example]
forall a. ToJSON a => a -> [Text] -> [Example]
examples (Currency -> Double -> AmountOfMoneyValue
simple Currency
Dollar Double
5.5)
[ Text
"五個半"
]
, AmountOfMoneyValue -> [Text] -> [Example]
forall a. ToJSON a => a -> [Text] -> [Example]
examples (Currency -> Double -> AmountOfMoneyValue
simple Currency
Dollar Double
1.5)
[ Text
"個半"
, Text
"一個半"
]
, AmountOfMoneyValue -> [Text] -> [Example]
forall a. ToJSON a => a -> [Text] -> [Example]
examples (Currency -> Double -> AmountOfMoneyValue
simple Currency
Dollar Double
1.9)
[ Text
"個九"
]
, AmountOfMoneyValue -> [Text] -> [Example]
forall a. ToJSON a => a -> [Text] -> [Example]
examples (Currency -> Double -> AmountOfMoneyValue
simple Currency
CNY Double
3.14)
[ Text
"3.14人民币"
, Text
"人民幣3.14"
]
, AmountOfMoneyValue -> [Text] -> [Example]
forall a. ToJSON a => a -> [Text] -> [Example]
examples (Currency -> Double -> AmountOfMoneyValue
simple Currency
HKD Double
3.14)
[ Text
"3.14港幣"
, Text
"港幣3.14"
, Text
"港幣三個一毫四"
]
, AmountOfMoneyValue -> [Text] -> [Example]
forall a. ToJSON a => a -> [Text] -> [Example]
examples (Currency -> Double -> AmountOfMoneyValue
under Currency
Dollar Double
1.2)
[ Text
"1.2元以下"
, Text
"最多一块二角"
, Text
"最多一块二"
]
, AmountOfMoneyValue -> [Text] -> [Example]
forall a. ToJSON a => a -> [Text] -> [Example]
examples (Currency -> Double -> AmountOfMoneyValue
above Currency
Dollar Double
3.04)
[ Text
"3.04块以上"
, Text
"至少三块四分"
, Text
"至少三块零四"
, Text
"起碼三蚊零四"
]
, AmountOfMoneyValue -> [Text] -> [Example]
forall a. ToJSON a => a -> [Text] -> [Example]
examples (Currency -> (Double, Double) -> AmountOfMoneyValue
between Currency
Dollar (Double
5.6, Double
5.78))
[ Text
"5.6到5.78元"
, Text
"五元六角-五元七毛八分"
, Text
"五块六到五块七毛八"
, Text
"五蚊六毫至五蚊七毫八"
]
]