-- 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 GADTs #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}

module Duckling.Distance.EN.Rules
  ( rules ) where


import Data.String
import Data.Text (Text)
import Prelude

import Duckling.Dimensions.Types
import Duckling.Distance.Helpers
import Duckling.Distance.Types (DistanceData(..))
import Duckling.Numeral.Helpers
import Duckling.Numeral.Types (NumeralData (..))
import Duckling.Types
import qualified Duckling.Distance.Types as TDist
import qualified Duckling.Numeral.Types as TNumeral


distances :: [(Text, String, TDist.Unit)]
distances :: [(Text, String, Unit)]
distances = [ -- Imperial
              (Text
"miles", String
"mi(le(s)?)?", Unit
TDist.Mile)
            , (Text
"yard", String
"y(ar)?ds?", Unit
TDist.Yard)
            , (Text
"feet", String
"('|f(oo|ee)?ts?)", Unit
TDist.Foot)
            , (Text
"inch", String
"(\"|''|in(ch(es)?)?)", Unit
TDist.Inch)
              -- Metric
            , (Text
"km", String
"k(ilo)?m?(et(er|re))?s?", Unit
TDist.Kilometre)
            , (Text
"meters", String
"met(er|re)s?", Unit
TDist.Metre)
            , (Text
"centimeters", String
"cm|centimet(er|re)s?", Unit
TDist.Centimetre)
            , (Text
"millimeters", String
"mm|millimet(er|re)s?", Unit
TDist.Millimetre)
              -- Ambiguous
            , (Text
"m (miles or meters)", String
"m", Unit
TDist.M)
            ]

rulePrecision :: Rule
rulePrecision :: Rule
rulePrecision = Rule :: Text -> Pattern -> Production -> Rule
Rule
  { name :: Text
name = Text
"about|exactly <dist>"
  , pattern :: Pattern
pattern =
    [ String -> PatternItem
regex String
"exactly|precisely|about|approx(\\.|imately)?|close to| near( to)?|around|almost"
    , Dimension DistanceData -> PatternItem
forall a. Typeable a => Dimension a -> PatternItem
dimension Dimension DistanceData
Distance
    ]
  , prod :: Production
prod = \case
      (Token
_:Token
token:[Token]
_) -> Token -> Maybe Token
forall a. a -> Maybe a
Just Token
token
      [Token]
_ -> Maybe Token
forall a. Maybe a
Nothing
  }

ruleDistances :: [Rule]
ruleDistances :: [Rule]
ruleDistances = ((Text, String, Unit) -> Rule) -> [(Text, String, Unit)] -> [Rule]
forall a b. (a -> b) -> [a] -> [b]
map (Text, String, Unit) -> Rule
go [(Text, String, Unit)]
distances
  where
    go :: (Text, String, TDist.Unit) -> Rule
    go :: (Text, String, Unit) -> Rule
go (Text
name, String
regexPattern, Unit
u) = Rule :: Text -> Pattern -> Production -> Rule
Rule
      { name :: Text
name = Text
name
      , pattern :: Pattern
pattern = [ Dimension DistanceData -> PatternItem
forall a. Typeable a => Dimension a -> PatternItem
dimension Dimension DistanceData
Distance, String -> PatternItem
regex String
regexPattern ]
      , prod :: Production
prod = \case
          (Token Dimension a
Distance a
dd:[Token]
_) -> Token -> Maybe Token
forall a. a -> Maybe a
Just (Token -> Maybe Token)
-> (DistanceData -> Token) -> DistanceData -> Maybe Token
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Dimension DistanceData -> DistanceData -> Token
forall a.
(Resolve a, Eq a, Hashable a, Show a, NFData a) =>
Dimension a -> a -> Token
Token Dimension DistanceData
Distance (DistanceData -> Maybe Token) -> DistanceData -> Maybe Token
forall a b. (a -> b) -> a -> b
$ Unit -> DistanceData -> DistanceData
withUnit Unit
u a
DistanceData
dd
          [Token]
_ -> Maybe Token
forall a. Maybe a
Nothing
      }

ruleIntervalBetweenNumeral :: Rule
ruleIntervalBetweenNumeral :: Rule
ruleIntervalBetweenNumeral = Rule :: Text -> Pattern -> Production -> Rule
Rule
  { name :: Text
name = Text
"between|from <numeral> to|and <dist>"
  , pattern :: Pattern
pattern =
    [ String -> PatternItem
regex String
"between|from"
    , Predicate -> PatternItem
Predicate Predicate
isPositive
    , String -> PatternItem
regex String
"to|and"
    , Predicate -> PatternItem
Predicate Predicate
isSimpleDistance
    ]
  , prod :: Production
prod = \case
      (Token
_:
       Token Dimension a
Numeral NumeralData{TNumeral.value = from}:
       Token
_:
       Token Dimension a
Distance DistanceData{TDist.value=Just to, TDist.unit=Just u}:
       [Token]
_) | Double
from Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
< Double
to ->
        Token -> Maybe Token
forall a. a -> Maybe a
Just (Token -> Maybe Token)
-> (DistanceData -> Token) -> DistanceData -> Maybe Token
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Dimension DistanceData -> DistanceData -> Token
forall a.
(Resolve a, Eq a, Hashable a, Show a, NFData a) =>
Dimension a -> a -> Token
Token Dimension DistanceData
Distance (DistanceData -> Token)
-> (DistanceData -> DistanceData) -> DistanceData -> Token
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Double, Double) -> DistanceData -> DistanceData
withInterval (Double
from, Double
to) (DistanceData -> Maybe Token) -> DistanceData -> Maybe Token
forall a b. (a -> b) -> a -> b
$ Unit -> DistanceData
unitOnly Unit
u
      [Token]
_ -> Maybe Token
forall a. Maybe a
Nothing
  }

ruleIntervalBetween :: Rule
ruleIntervalBetween :: Rule
ruleIntervalBetween = Rule :: Text -> Pattern -> Production -> Rule
Rule
  { name :: Text
name = Text
"between|from <dist> to|and <dist>"
  , pattern :: Pattern
pattern =
    [ String -> PatternItem
regex String
"between|from"
    , Predicate -> PatternItem
Predicate Predicate
isSimpleDistance
    , String -> PatternItem
regex String
"to|and"
    , Predicate -> PatternItem
Predicate Predicate
isSimpleDistance
    ]
  , prod :: Production
prod = \case
      (Token
_:
       Token Dimension a
Distance DistanceData{TDist.value=Just from, TDist.unit=Just u1}:
       Token
_:
       Token Dimension a
Distance DistanceData{TDist.value=Just to, TDist.unit=Just u2}:
       [Token]
_) | Double
from Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
< Double
to Bool -> Bool -> Bool
&& Unit
u1 Unit -> Unit -> Bool
forall a. Eq a => a -> a -> Bool
== Unit
u2 ->
        Token -> Maybe Token
forall a. a -> Maybe a
Just (Token -> Maybe Token)
-> (DistanceData -> Token) -> DistanceData -> Maybe Token
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Dimension DistanceData -> DistanceData -> Token
forall a.
(Resolve a, Eq a, Hashable a, Show a, NFData a) =>
Dimension a -> a -> Token
Token Dimension DistanceData
Distance (DistanceData -> Token)
-> (DistanceData -> DistanceData) -> DistanceData -> Token
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Double, Double) -> DistanceData -> DistanceData
withInterval (Double
from, Double
to) (DistanceData -> Maybe Token) -> DistanceData -> Maybe Token
forall a b. (a -> b) -> a -> b
$ Unit -> DistanceData
unitOnly Unit
u1
      [Token]
_ -> Maybe Token
forall a. Maybe a
Nothing
  }

ruleIntervalNumeralDash :: Rule
ruleIntervalNumeralDash :: Rule
ruleIntervalNumeralDash = Rule :: Text -> Pattern -> Production -> Rule
Rule
  { name :: Text
name = Text
"<numeral> - <dist>"
  , pattern :: Pattern
pattern =
    [ Predicate -> PatternItem
Predicate Predicate
isPositive
    , String -> PatternItem
regex String
"-"
    , Predicate -> PatternItem
Predicate Predicate
isSimpleDistance
    ]
  , prod :: Production
prod = \case
      (Token Dimension a
Numeral NumeralData{TNumeral.value = from}:
       Token
_:
       Token Dimension a
Distance DistanceData{TDist.value=Just to, TDist.unit=Just u}:
       [Token]
_) | Double
from Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
< Double
to ->
         Token -> Maybe Token
forall a. a -> Maybe a
Just (Token -> Maybe Token)
-> (DistanceData -> Token) -> DistanceData -> Maybe Token
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Dimension DistanceData -> DistanceData -> Token
forall a.
(Resolve a, Eq a, Hashable a, Show a, NFData a) =>
Dimension a -> a -> Token
Token Dimension DistanceData
Distance (DistanceData -> Token)
-> (DistanceData -> DistanceData) -> DistanceData -> Token
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Double, Double) -> DistanceData -> DistanceData
withInterval (Double
from, Double
to) (DistanceData -> Maybe Token) -> DistanceData -> Maybe Token
forall a b. (a -> b) -> a -> b
$ Unit -> DistanceData
unitOnly Unit
u
      [Token]
_ -> Maybe Token
forall a. Maybe a
Nothing
  }

ruleIntervalDash :: Rule
ruleIntervalDash :: Rule
ruleIntervalDash = Rule :: Text -> Pattern -> Production -> Rule
Rule
  { name :: Text
name = Text
"<dist> - <dist>"
  , pattern :: Pattern
pattern =
    [ Predicate -> PatternItem
Predicate Predicate
isSimpleDistance
    , String -> PatternItem
regex String
"-"
    , Predicate -> PatternItem
Predicate Predicate
isSimpleDistance
    ]
  , prod :: Production
prod = \case
      (Token Dimension a
Distance DistanceData{TDist.value=Just from, TDist.unit=Just u1}:
       Token
_:
       Token Dimension a
Distance DistanceData{TDist.value=Just to, TDist.unit=Just u2}:
       [Token]
_) | Double
from Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
< Double
to Bool -> Bool -> Bool
&& Unit
u1 Unit -> Unit -> Bool
forall a. Eq a => a -> a -> Bool
== Unit
u2 ->
        Token -> Maybe Token
forall a. a -> Maybe a
Just (Token -> Maybe Token)
-> (DistanceData -> Token) -> DistanceData -> Maybe Token
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Dimension DistanceData -> DistanceData -> Token
forall a.
(Resolve a, Eq a, Hashable a, Show a, NFData a) =>
Dimension a -> a -> Token
Token Dimension DistanceData
Distance (DistanceData -> Token)
-> (DistanceData -> DistanceData) -> DistanceData -> Token
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Double, Double) -> DistanceData -> DistanceData
withInterval (Double
from, Double
to) (DistanceData -> Maybe Token) -> DistanceData -> Maybe Token
forall a b. (a -> b) -> a -> b
$ Unit -> DistanceData
unitOnly Unit
u1
      [Token]
_ -> Maybe Token
forall a. Maybe a
Nothing
  }

ruleIntervalMax :: Rule
ruleIntervalMax :: Rule
ruleIntervalMax = Rule :: Text -> Pattern -> Production -> Rule
Rule
  { name :: Text
name = Text
"under/less/lower/no more than <dist>"
  , pattern :: Pattern
pattern =
    [ String -> PatternItem
regex String
"under|(less|lower|not? more) than"
    , Predicate -> PatternItem
Predicate Predicate
isSimpleDistance
    ]
  , prod :: Production
prod = \case
      (Token
_:
       Token Dimension a
Distance DistanceData{TDist.value=Just to, TDist.unit=Just u}:
       [Token]
_) -> Token -> Maybe Token
forall a. a -> Maybe a
Just (Token -> Maybe Token)
-> (DistanceData -> Token) -> DistanceData -> Maybe Token
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Dimension DistanceData -> DistanceData -> Token
forall a.
(Resolve a, Eq a, Hashable a, Show a, NFData a) =>
Dimension a -> a -> Token
Token Dimension DistanceData
Distance (DistanceData -> Token)
-> (DistanceData -> DistanceData) -> DistanceData -> Token
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Double -> DistanceData -> DistanceData
withMax Double
to (DistanceData -> Maybe Token) -> DistanceData -> Maybe Token
forall a b. (a -> b) -> a -> b
$ Unit -> DistanceData
unitOnly Unit
u
      [Token]
_ -> Maybe Token
forall a. Maybe a
Nothing
  }

ruleIntervalMin :: Rule
ruleIntervalMin :: Rule
ruleIntervalMin = Rule :: Text -> Pattern -> Production -> Rule
Rule
  { name :: Text
name = Text
"over/above/at least/more than <dist>"
  , pattern :: Pattern
pattern =
    [ String -> PatternItem
regex String
"over|above|at least|more than"
    , Predicate -> PatternItem
Predicate Predicate
isSimpleDistance
    ]
  , prod :: Production
prod = \case
      (Token
_:
       Token Dimension a
Distance DistanceData{TDist.value=Just to, TDist.unit=Just u}:
       [Token]
_) -> Token -> Maybe Token
forall a. a -> Maybe a
Just (Token -> Maybe Token)
-> (DistanceData -> Token) -> DistanceData -> Maybe Token
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Dimension DistanceData -> DistanceData -> Token
forall a.
(Resolve a, Eq a, Hashable a, Show a, NFData a) =>
Dimension a -> a -> Token
Token Dimension DistanceData
Distance (DistanceData -> Token)
-> (DistanceData -> DistanceData) -> DistanceData -> Token
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Double -> DistanceData -> DistanceData
withMin Double
to (DistanceData -> Maybe Token) -> DistanceData -> Maybe Token
forall a b. (a -> b) -> a -> b
$ Unit -> DistanceData
unitOnly Unit
u
      [Token]
_ -> Maybe Token
forall a. Maybe a
Nothing
  }

-- | NOTE: Oxford comma is not supported.
ruleCompositeDistanceCommasAnd :: Rule
ruleCompositeDistanceCommasAnd :: Rule
ruleCompositeDistanceCommasAnd = Rule :: Text -> Pattern -> Production -> Rule
Rule
  { name :: Text
name = Text
"composite <distance> (with ,/and)"
  , pattern :: Pattern
pattern =
    [ Predicate -> PatternItem
Predicate Predicate
isSimpleDistance
    , String -> PatternItem
regex String
",|and"
    , Predicate -> PatternItem
Predicate Predicate
isSimpleDistance
    ]
  , prod :: Production
prod = \case
      (Token Dimension a
Distance DistanceData{TDist.value=Just v1, TDist.unit=Just u1}:
       Token
_:
       Token Dimension a
Distance DistanceData{TDist.value=Just v2, TDist.unit=Just u2}:
       [Token]
_) | Unit
u1 Unit -> Unit -> Bool
forall a. Eq a => a -> a -> Bool
/= Unit
u2 Bool -> Bool -> Bool
&& Double
v1 Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
> Double
0 Bool -> Bool -> Bool
&& Double
v2 Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
> Double
0 -> Dimension DistanceData -> DistanceData -> Token
forall a.
(Resolve a, Eq a, Hashable a, Show a, NFData a) =>
Dimension a -> a -> Token
Token Dimension DistanceData
Distance (DistanceData -> Token) -> Maybe DistanceData -> Maybe Token
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
                                              Double -> Unit -> Double -> Unit -> Maybe DistanceData
distanceSum Double
v1 Unit
u1 Double
v2 Unit
u2
      [Token]
_ -> Maybe Token
forall a. Maybe a
Nothing
  }

ruleCompositeDistance :: Rule
ruleCompositeDistance :: Rule
ruleCompositeDistance = Rule :: Text -> Pattern -> Production -> Rule
Rule
  { name :: Text
name = Text
"composite <distance>"
  , pattern :: Pattern
pattern =
    [ Predicate -> PatternItem
Predicate Predicate
isSimpleDistance
    , Predicate -> PatternItem
Predicate Predicate
isSimpleDistance
    ]
  , prod :: Production
prod = \case
      (Token Dimension a
Distance DistanceData{TDist.value=Just v1, TDist.unit=Just u1}:
       Token Dimension a
Distance DistanceData{TDist.value=Just v2, TDist.unit=Just u2}:
       [Token]
_) | Unit
u1 Unit -> Unit -> Bool
forall a. Eq a => a -> a -> Bool
/= Unit
u2 Bool -> Bool -> Bool
&& Double
v1 Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
> Double
0 Bool -> Bool -> Bool
&& Double
v2 Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
> Double
0 -> Dimension DistanceData -> DistanceData -> Token
forall a.
(Resolve a, Eq a, Hashable a, Show a, NFData a) =>
Dimension a -> a -> Token
Token Dimension DistanceData
Distance (DistanceData -> Token) -> Maybe DistanceData -> Maybe Token
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
                                              Double -> Unit -> Double -> Unit -> Maybe DistanceData
distanceSum Double
v1 Unit
u1 Double
v2 Unit
u2
      [Token]
_ -> Maybe Token
forall a. Maybe a
Nothing
  }

rules :: [Rule]
rules :: [Rule]
rules =
  [ Rule
ruleIntervalBetweenNumeral
  , Rule
ruleIntervalBetween
  , Rule
ruleIntervalMax
  , Rule
ruleIntervalMin
  , Rule
ruleIntervalNumeralDash
  , Rule
ruleIntervalDash
  , Rule
rulePrecision
  , Rule
ruleCompositeDistanceCommasAnd
  , Rule
ruleCompositeDistance
  ] [Rule] -> [Rule] -> [Rule]
forall a. [a] -> [a] -> [a]
++ [Rule]
ruleDistances