-- 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.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
"五蚊六毫至五蚊七毫八"
             ]
  ]