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

import Data.String
import Prelude

import Duckling.Locale
import Duckling.Quantity.Types
import Duckling.Resolve
import Duckling.Testing.Types

context :: Context
context :: Context
context = Context
testContext {locale :: Locale
locale = Lang -> Maybe Region -> Locale
makeLocale Lang
NL Maybe Region
forall a. Maybe a
Nothing}

corpus :: Corpus
corpus :: Corpus
corpus = (Context
context, Options
testOptions, [Example]
allExamples)

allExamples :: [Example]
allExamples :: [Example]
allExamples = [[Example]] -> [Example]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
  [ QuantityValue -> [Text] -> [Example]
forall a. ToJSON a => a -> [Text] -> [Example]
examples (Unit -> Double -> Maybe Text -> QuantityValue
simple Unit
Gram Double
2 Maybe Text
forall a. Maybe a
Nothing)
             [ Text
"2 gram"
             , Text
"0,002 kg"
             , Text
"0,002 kilo"
             , Text
"2/1000 kilogram"
             , Text
"2000 milligram"
             ]
  , QuantityValue -> [Text] -> [Example]
forall a. ToJSON a => a -> [Text] -> [Example]
examples (Unit -> Double -> Maybe Text -> QuantityValue
simple Unit
Gram Double
1000 Maybe Text
forall a. Maybe a
Nothing)
             [ Text
"1 kg"
             , Text
"1,0 kg"
             , Text
"1 kilogram"
             , Text
"1 kilo"
             , Text
"1000 gram"
             , Text
"1000 g"
             , Text
"1000 gr"
             , Text
"duizend gram"
             , Text
"duizend gr"
             , Text
"2,0 pond"
             , Text
"10 ons"
             , Text
"1000000 mg"
             , Text
"1000000 milligram"
             ]
  , QuantityValue -> [Text] -> [Example]
forall a. ToJSON a => a -> [Text] -> [Example]
examples (Unit -> Double -> Maybe Text -> QuantityValue
simple Unit
Cup Double
1 (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"suiker"))
             [ Text
"1 kopje suiker"
             ]
  , QuantityValue -> [Text] -> [Example]
forall a. ToJSON a => a -> [Text] -> [Example]
examples (Unit -> Double -> Maybe Text -> QuantityValue
simple Unit
Cup Double
3 (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"suiker"))
             [ Text
"3 kopjes suiker"
             ]
  , QuantityValue -> [Text] -> [Example]
forall a. ToJSON a => a -> [Text] -> [Example]
examples (Unit -> Double -> Maybe Text -> QuantityValue
simple Unit
Cup Double
0.75 Maybe Text
forall a. Maybe a
Nothing)
             [ Text
"3/4 kopje"
             , Text
"0,75 kopje"
             , Text
",75 kopje"
             ]
  , QuantityValue -> [Text] -> [Example]
forall a. ToJSON a => a -> [Text] -> [Example]
examples (Unit -> Double -> Maybe Text -> QuantityValue
simple Unit
Gram Double
500 (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"aardbeien"))
             [ Text
"500 gram aardbeien"
             , Text
"500g aardbeien"
             , Text
"0,5 kilogram aardbeien"
             , Text
"0,5 kg aardbeien"
             , Text
"5 ons aardbeien"
             , Text
"1 pond aardbeien"
             , Text
"500000mg aardbeien"
             ]
  , QuantityValue -> [Text] -> [Example]
forall a. ToJSON a => a -> [Text] -> [Example]
examples (Unit -> (Double, Double) -> Maybe Text -> QuantityValue
between Unit
Gram (Double
100,Double
1000) (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"aardbeien"))
              [ Text
"100-1000 gram aardbeien"
              , Text
"tussen 100 en 1000 gram aardbeien"
              , Text
"van 100 tot 1000 g aardbeien"
              , Text
"tussen 1 ons en 10 ons aardbeien"
              , Text
"100 - 1000 g aardbeien"
              ]
  , QuantityValue -> [Text] -> [Example]
forall a. ToJSON a => a -> [Text] -> [Example]
examples (Unit -> (Double, Double) -> Maybe Text -> QuantityValue
between Unit
Gram (Double
2,Double
7) Maybe Text
forall a. Maybe a
Nothing)
              [ Text
"~2-7 gram"
              , Text
"van 2 tot 7 g"
              , Text
"tussen 2,0 g en ongeveer 7,0 g"
              , Text
"tussen 0,002 kg en ongeveer 0,007 kg"
              , Text
"2 - ~7 gram"
              ]
  ]