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

import Data.String
import Prelude

import Duckling.Distance.Types
import Duckling.Testing.Types

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

allExamples :: [Example]
allExamples :: [Example]
allExamples = [[Example]] -> [Example]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
  [ DistanceValue -> [Text] -> [Example]
forall a. ToJSON a => a -> [Text] -> [Example]
examples (Unit -> Double -> DistanceValue
simple Unit
Kilometre Double
3)
             [ Text
"3 kilometers"
             , Text
"3 km"
             , Text
"3km"
             , Text
"3k"
             , Text
"3.0 km"
             ]
  , DistanceValue -> [Text] -> [Example]
forall a. ToJSON a => a -> [Text] -> [Example]
examples (Unit -> Double -> DistanceValue
simple Unit
Mile Double
8)
             [ Text
"8 miles"
             , Text
"eight mile"
             , Text
"8 mi"
             ]
  , DistanceValue -> [Text] -> [Example]
forall a. ToJSON a => a -> [Text] -> [Example]
examples (Unit -> Double -> DistanceValue
simple Unit
M Double
9)
             [ Text
"9m"
             ]
  , DistanceValue -> [Text] -> [Example]
forall a. ToJSON a => a -> [Text] -> [Example]
examples (Unit -> Double -> DistanceValue
simple Unit
Centimetre Double
2)
             [ Text
"2cm"
             , Text
"2 centimeters"
             ]
  , DistanceValue -> [Text] -> [Example]
forall a. ToJSON a => a -> [Text] -> [Example]
examples (Unit -> Double -> DistanceValue
simple Unit
Inch Double
5)
             [ Text
"5 in"
             , Text
"5''"
             , Text
"five inches"
             , Text
"5\""
             ]
  , DistanceValue -> [Text] -> [Example]
forall a. ToJSON a => a -> [Text] -> [Example]
examples (Unit -> Double -> DistanceValue
simple Unit
Metre Double
1.87)
             [ Text
"1.87 meters"
             ]
  -- Composite values:
  , DistanceValue -> [Text] -> [Example]
forall a. ToJSON a => a -> [Text] -> [Example]
examples (Unit -> Double -> DistanceValue
simple Unit
Inch Double
94)
             [ Text
"7 feet and 10 inches"
             , Text
"7 feet, 10 inches"
             , Text
"7 feet 10 inches"
             ]
  , DistanceValue -> [Text] -> [Example]
forall a. ToJSON a => a -> [Text] -> [Example]
examples (Unit -> Double -> DistanceValue
simple Unit
Metre Double
2001)
             [ Text
"2 km and 1 meter"
             , Text
"2 kilometer, 1 metre"
             , Text
"2 kilometer 1 metre"
             ]
  , DistanceValue -> [Text] -> [Example]
forall a. ToJSON a => a -> [Text] -> [Example]
examples (Unit -> Double -> DistanceValue
simple Unit
Inch Double
166)
             [ Text
"2 yards 7 ft 10 inches"
             , Text
"2 yds, 7 feet and 10 inches"
             , Text
"2 yards, 7 feet, 10 in"
             ]
  , DistanceValue -> [Text] -> [Example]
forall a. ToJSON a => a -> [Text] -> [Example]
examples (Unit -> Double -> DistanceValue
simple Unit
Foot Double
13)
             [ Text
"2 yards and 7 feet"
             , Text
"2 yards, 7 feet"
             , Text
"2 yd 7'"
             ]
  , DistanceValue -> [Text] -> [Example]
forall a. ToJSON a => a -> [Text] -> [Example]
examples (Unit -> Double -> DistanceValue
simple Unit
Centimetre Double
1000806)
             [ Text
"10 kms 8 metres 6 cm"
             , Text
"10 kms, 8 meters, 6 cm"
             , Text
"10 kms, 8 meters and 6 centimeters"
--             , "10 kms, 8 meters, and 6 cm" -- Oxford comma not supported
             ]
  , DistanceValue -> [Text] -> [Example]
forall a. ToJSON a => a -> [Text] -> [Example]
examples (Unit -> Double -> DistanceValue
simple Unit
Metre Double
1.3048)
             [ Text
"1 meter and 1 foot"
             ]
  , DistanceValue -> [Text] -> [Example]
forall a. ToJSON a => a -> [Text] -> [Example]
examples (Unit -> Double -> DistanceValue
simple Unit
Kilometre Double
2.609344)
             [ Text
"1 kilometer and 1 mile"
             ]
  , DistanceValue -> [Text] -> [Example]
forall a. ToJSON a => a -> [Text] -> [Example]
examples (Unit -> Double -> DistanceValue
simple Unit
M Double
3)
             -- The original, ambiguous "m" unit is preserved
             [ Text
"3m"
             ]
  , DistanceValue -> [Text] -> [Example]
forall a. ToJSON a => a -> [Text] -> [Example]
examples (Unit -> Double -> DistanceValue
simple Unit
Centimetre Double
305)
             -- The ambiguous "m" unit is inferred as "meteres"
             [ Text
"3m and 5cm"
             ]
  , DistanceValue -> [Text] -> [Example]
forall a. ToJSON a => a -> [Text] -> [Example]
examples (Unit -> Double -> DistanceValue
simple Unit
Foot Double
5281)
             -- The ambiguous "m" unit is inferred as "miles"
             [ Text
"1m and 1ft"
             ]
  -- Ranges:
  , DistanceValue -> [Text] -> [Example]
forall a. ToJSON a => a -> [Text] -> [Example]
examples (Unit -> (Double, Double) -> DistanceValue
between Unit
Kilometre (Double
3, Double
5))
             [ Text
"between 3 and 5 kilometers"
             , Text
"from 3km to 5km"
             , Text
"around 3-5 kilometers"
             , Text
"about 3km-5km"
             , Text
"3-5 kilometers"
             ]
  , DistanceValue -> [Text] -> [Example]
forall a. ToJSON a => a -> [Text] -> [Example]
examples (Unit -> Double -> DistanceValue
under Unit
Mile Double
3.5)
             [ Text
"under 3.5 miles"
             , Text
"less than 3.5mi"
             , Text
"lower than three point five miles"
             ]
  , DistanceValue -> [Text] -> [Example]
forall a. ToJSON a => a -> [Text] -> [Example]
examples (Unit -> Double -> DistanceValue
above Unit
Inch Double
5)
             [ Text
"more than five inches"
             , Text
"at least 5''"
             , Text
"over 5\""
             , Text
"above 5 in"
             ]
  , DistanceValue -> [Text] -> [Example]
forall a. ToJSON a => a -> [Text] -> [Example]
examples (Unit -> (Double, Double) -> DistanceValue
between Unit
Millimetre (Double
5, Double
6))
             [ Text
"between 5 and six millimeters"
             , Text
"between 5 and six millimetres"
             , Text
"5-6 mm"
             ]
  ]