-- 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.TR.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
TR 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
"yok"
             , Text
"hiç"
             , Text
"sıfır"
             ]
  , NumeralValue -> [Text] -> [Example]
forall a. ToJSON a => a -> [Text] -> [Example]
examples (Double -> NumeralValue
NumeralValue Double
1)
             [ Text
"1"
             , Text
"bir"
             , Text
"tek"
             , Text
"yek"
             ]
  , NumeralValue -> [Text] -> [Example]
forall a. ToJSON a => a -> [Text] -> [Example]
examples (Double -> NumeralValue
NumeralValue Double
2)
             [ Text
"2"
             , Text
"iki"
             , Text
"çift"
             ]
  , NumeralValue -> [Text] -> [Example]
forall a. ToJSON a => a -> [Text] -> [Example]
examples (Double -> NumeralValue
NumeralValue Double
33)
             [ Text
"33"
             , Text
"otuzüç"
             , Text
"otuz üç"
             , Text
"0033"
             ]
  , NumeralValue -> [Text] -> [Example]
forall a. ToJSON a => a -> [Text] -> [Example]
examples (Double -> NumeralValue
NumeralValue Double
14)
             [ Text
"14"
             , Text
"ondört"
             , Text
"on dört"
             ]
  , NumeralValue -> [Text] -> [Example]
forall a. ToJSON a => a -> [Text] -> [Example]
examples (Double -> NumeralValue
NumeralValue Double
16)
             [ Text
"16"
             , Text
"onaltı"
             , Text
"on altı"
             ]
  , NumeralValue -> [Text] -> [Example]
forall a. ToJSON a => a -> [Text] -> [Example]
examples (Double -> NumeralValue
NumeralValue Double
17)
             [ Text
"17"
             , Text
"onyedi"
             , Text
"on yedi"
             ]
  , NumeralValue -> [Text] -> [Example]
forall a. ToJSON a => a -> [Text] -> [Example]
examples (Double -> NumeralValue
NumeralValue Double
18)
             [ Text
"18"
             , Text
"onsekiz"
             , Text
"on sekiz"
             ]
  , 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
"bir virgül bir"
             , Text
"bir nokta bir"
             ]
  , NumeralValue -> [Text] -> [Example]
forall a. ToJSON a => a -> [Text] -> [Example]
examples (Double -> NumeralValue
NumeralValue Double
0.77)
             [ Text
"0,77"
             , Text
",77"
             , Text
"sıfır virgül yetmişyedi"
             , Text
"sıfır virgül yetmiş yedi"
             ]
  , 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
"100b"
             ]
  , NumeralValue -> [Text] -> [Example]
forall a. ToJSON a => a -> [Text] -> [Example]
examples (Double -> NumeralValue
NumeralValue Double
3000000)
             [ Text
"3M"
             , Text
"3000K"
             , 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"
             , Text
"1,2M"
             , Text
"1200K"
             , Text
",0012G"
             , Text
"1200B"
             ]
  , NumeralValue -> [Text] -> [Example]
forall a. ToJSON a => a -> [Text] -> [Example]
examples (Double -> NumeralValue
NumeralValue (-Double
1200000))
             [ Text
"- 1.200.000"
             , Text
"-1200000"
             , Text
"eksi 1.200.000"
             , Text
"negatif 1200000"
             , Text
"-1,2M"
             , Text
"-1200K"
             , Text
"-,0012G"
             , Text
"-1200B"
             ]
  , NumeralValue -> [Text] -> [Example]
forall a. ToJSON a => a -> [Text] -> [Example]
examples (Double -> NumeralValue
NumeralValue Double
5000)
             [ Text
"5 bin"
             , Text
"beş bin"
             ]
  , NumeralValue -> [Text] -> [Example]
forall a. ToJSON a => a -> [Text] -> [Example]
examples (Double -> NumeralValue
NumeralValue Double
50)
             [ Text
"5 deste"
             , Text
"beş deste"
             ]
  , NumeralValue -> [Text] -> [Example]
forall a. ToJSON a => a -> [Text] -> [Example]
examples (Double -> NumeralValue
NumeralValue Double
200000)
             [ Text
"iki yüz bin"
             , Text
"ikiyüzbin"
             ]
  , NumeralValue -> [Text] -> [Example]
forall a. ToJSON a => a -> [Text] -> [Example]
examples (Double -> NumeralValue
NumeralValue Double
21011)
             [ Text
"yirmi bir bin on bir"
             , Text
"yirmibir bin onbir"
             ]
  , NumeralValue -> [Text] -> [Example]
forall a. ToJSON a => a -> [Text] -> [Example]
examples (Double -> NumeralValue
NumeralValue Double
721012)
             [ Text
"yedi yüz yirmibir bin on iki"
             , Text
"yedi yüz yirmi bir bin on iki"
             , Text
"yediyüz yirmibir bin oniki"
             ]
  , NumeralValue -> [Text] -> [Example]
forall a. ToJSON a => a -> [Text] -> [Example]
examples (Double -> NumeralValue
NumeralValue Double
300341)
             [ Text
"üçyüzbin üçyüz kırkbir"
             , Text
"üç yüz bin üç yüz kırk bir"
             ]
  , NumeralValue -> [Text] -> [Example]
forall a. ToJSON a => a -> [Text] -> [Example]
examples (Double -> NumeralValue
NumeralValue Double
40348)
             [ Text
"kırkbin üçyüz kırksekiz"
             , Text
"kırk bin üç yüz kırk sekiz"
             ]
  , NumeralValue -> [Text] -> [Example]
forall a. ToJSON a => a -> [Text] -> [Example]
examples (Double -> NumeralValue
NumeralValue Double
31256721)
             [ Text
"otuz bir milyon iki yüz elli altı bin yedi yüz yirmi bir"
             ]
  , NumeralValue -> [Text] -> [Example]
forall a. ToJSON a => a -> [Text] -> [Example]
examples (Double -> NumeralValue
NumeralValue Double
107)
             [ Text
"107"
             , Text
"yüz yedi"
             ]
  , NumeralValue -> [Text] -> [Example]
forall a. ToJSON a => a -> [Text] -> [Example]
examples (Double -> NumeralValue
NumeralValue Double
5.5)
             [ Text
"beş buçuk"
             , Text
"beşbuçuk"
             , Text
"5 buçuk"
             , Text
"5,5"
             ]
  , NumeralValue -> [Text] -> [Example]
forall a. ToJSON a => a -> [Text] -> [Example]
examples (Double -> NumeralValue
NumeralValue Double
3500000)
             [ Text
"3,5 milyon"
             , Text
"3500000"
             , Text
"üç buçuk milyon"
             , Text
"üçbuçuk milyon"
             , Text
"3,5M"
             ]
  , NumeralValue -> [Text] -> [Example]
forall a. ToJSON a => a -> [Text] -> [Example]
examples (Double -> NumeralValue
NumeralValue Double
0.5)
             [ Text
"yarım"
             , Text
"0,5"
             ]
  , NumeralValue -> [Text] -> [Example]
forall a. ToJSON a => a -> [Text] -> [Example]
examples (Double -> NumeralValue
NumeralValue Double
2500)
             [ Text
"2,5 bin"
             , Text
"2500"
             , Text
"iki bin beş yüz"
             , Text
"ikibin beşyüz"
             ]
  , NumeralValue -> [Text] -> [Example]
forall a. ToJSON a => a -> [Text] -> [Example]
examples (Double -> NumeralValue
NumeralValue Double
2200000)
             [ Text
"2,2 milyon"
             , Text
"iki nokta iki milyon"
             , Text
"iki virgül iki milyon"
             ]
  , NumeralValue -> [Text] -> [Example]
forall a. ToJSON a => a -> [Text] -> [Example]
examples (Double -> NumeralValue
NumeralValue Double
72.5)
             [ Text
"yetmişikibuçuk"
             , Text
"yetmişiki buçuk"
             , Text
"yetmiş iki buçuk"
             , Text
"72,5"
             ]
  ]