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

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

import Data.HashMap.Strict (HashMap)
import Data.String
import Data.Text (Text)
import Prelude
import qualified Data.HashMap.Strict as HashMap
import qualified Data.Text as Text

import Duckling.Dimensions.Types
import Duckling.Numeral.Helpers
import Duckling.Quantity.Helpers
import Duckling.Regex.Types (GroupMatch(..))
import Duckling.Types
import Duckling.Numeral.Types (NumeralData(..))
import Duckling.Quantity.Types (QuantityData(..))
import qualified Duckling.Numeral.Types as TNumeral
import qualified Duckling.Quantity.Types as TQuantity

quantities :: [(Text, String, TQuantity.Unit)]
quantities :: [(Text, String, Unit)]
quantities =
  [ (Text
"<quantity> cups", String
"(cups?)", Unit
TQuantity.Cup)
  , (Text
"<quantity> grams", String
"(((m(illi)?[.]?)|(k(ilo)?)[.]?)?g(ram)?s?[.]?)[.]?", Unit
TQuantity.Gram)
  , (Text
"<quantity> lb", String
"((lb|pound)s?)", Unit
TQuantity.Pound)
  , (Text
"<quantity> oz", String
"((ounces?)|oz)", Unit
TQuantity.Ounce)
  ]

opsMap :: HashMap Text (Double -> Double)
opsMap :: HashMap Text (Double -> Double)
opsMap = [(Text, Double -> Double)] -> HashMap Text (Double -> Double)
forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
HashMap.fromList
  [ ( Text
"milligram" , (Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
1000))
  , ( Text
"milligrams", (Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
1000))
  , ( Text
"mg"        , (Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
1000))
  , ( Text
"mgs"       , (Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
1000))
  , ( Text
"m.g"       , (Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
1000))
  , ( Text
"m.gs"      , (Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
1000))
  , ( Text
"m.g."      , (Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
1000))
  , ( Text
"m.g.s"     , (Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
1000))
  , ( Text
"kilogram"  , (Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
1000))
  , ( Text
"kilograms" , (Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
1000))
  , ( Text
"kg"        , (Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
1000))
  , ( Text
"kgs"       , (Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
1000))
  , ( Text
"k.g"       , (Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
1000))
  , ( Text
"k.gs"      , (Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
1000))
  , ( Text
"k.g."      , (Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
1000))
  , ( Text
"k.g.s"     , (Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
1000))
  ]

ruleNumeralQuantities :: [Rule]
ruleNumeralQuantities :: [Rule]
ruleNumeralQuantities = ((Text, String, Unit) -> Rule) -> [(Text, String, Unit)] -> [Rule]
forall a b. (a -> b) -> [a] -> [b]
map (Text, String, Unit) -> Rule
go [(Text, String, Unit)]
quantities
  where
    go :: (Text, String, TQuantity.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 = [Predicate -> PatternItem
Predicate Predicate
isPositive, String -> PatternItem
regex String
regexPattern]
      , prod :: Production
prod = \case
        (Token Dimension a
Numeral a
nd:
         Token Dimension a
RegexMatch (GroupMatch (match:_)):
         [Token]
_) -> Token -> Maybe Token
forall a. a -> Maybe a
Just (Token -> Maybe Token)
-> (QuantityData -> Token) -> QuantityData -> Maybe Token
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Dimension QuantityData -> QuantityData -> Token
forall a.
(Resolve a, Eq a, Hashable a, Show a, NFData a) =>
Dimension a -> a -> Token
Token Dimension QuantityData
Quantity (QuantityData -> Maybe Token) -> QuantityData -> Maybe Token
forall a b. (a -> b) -> a -> b
$ Unit -> Double -> QuantityData
quantity Unit
u Double
value
          where value :: Double
value = HashMap Text (Double -> Double) -> Text -> Double -> Double
getValue HashMap Text (Double -> Double)
opsMap Text
match (Double -> Double) -> Double -> Double
forall a b. (a -> b) -> a -> b
$ NumeralData -> Double
TNumeral.value a
NumeralData
nd
        [Token]
_ -> Maybe Token
forall a. Maybe a
Nothing
      }

ruleAQuantity :: [Rule]
ruleAQuantity :: [Rule]
ruleAQuantity = ((Text, String, Unit) -> Rule) -> [(Text, String, Unit)] -> [Rule]
forall a b. (a -> b) -> [a] -> [b]
map (Text, String, Unit) -> Rule
go [(Text, String, Unit)]
quantities
  where
    go :: (Text, String, TQuantity.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 = [ String -> PatternItem
regex (String
"an? " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
regexPattern) ]
      , prod :: Production
prod = \case
        (Token Dimension a
RegexMatch (GroupMatch (match:_)):
         [Token]
_) -> Token -> Maybe Token
forall a. a -> Maybe a
Just (Token -> Maybe Token)
-> (QuantityData -> Token) -> QuantityData -> Maybe Token
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Dimension QuantityData -> QuantityData -> Token
forall a.
(Resolve a, Eq a, Hashable a, Show a, NFData a) =>
Dimension a -> a -> Token
Token Dimension QuantityData
Quantity (QuantityData -> Maybe Token) -> QuantityData -> Maybe Token
forall a b. (a -> b) -> a -> b
$ Unit -> Double -> QuantityData
quantity Unit
u (Double -> QuantityData) -> Double -> QuantityData
forall a b. (a -> b) -> a -> b
$ HashMap Text (Double -> Double) -> Text -> Double -> Double
getValue HashMap Text (Double -> Double)
opsMap Text
match Double
1
        [Token]
_ -> Maybe Token
forall a. Maybe a
Nothing
      }

ruleQuantityOfProduct :: Rule
ruleQuantityOfProduct :: Rule
ruleQuantityOfProduct = Rule :: Text -> Pattern -> Production -> Rule
Rule
  { name :: Text
name = Text
"<quantity> of product"
  , pattern :: Pattern
pattern =
    [ Dimension QuantityData -> PatternItem
forall a. Typeable a => Dimension a -> PatternItem
dimension Dimension QuantityData
Quantity
    , String -> PatternItem
regex String
"of (\\w+)"
    ]
  , prod :: Production
prod = \case
    (Token Dimension a
Quantity a
qd:Token Dimension a
RegexMatch (GroupMatch (product:_)):[Token]
_) ->
      Token -> Maybe Token
forall a. a -> Maybe a
Just (Token -> Maybe Token)
-> (QuantityData -> Token) -> QuantityData -> Maybe Token
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Dimension QuantityData -> QuantityData -> Token
forall a.
(Resolve a, Eq a, Hashable a, Show a, NFData a) =>
Dimension a -> a -> Token
Token Dimension QuantityData
Quantity (QuantityData -> Maybe Token) -> QuantityData -> Maybe Token
forall a b. (a -> b) -> a -> b
$ Text -> QuantityData -> QuantityData
withProduct (Text -> Text
Text.toLower Text
product) a
QuantityData
qd
    [Token]
_ -> Maybe Token
forall a. Maybe a
Nothing
  }

rulePrecision :: Rule
rulePrecision :: Rule
rulePrecision = Rule :: Text -> Pattern -> Production -> Rule
Rule
    { name :: Text
name = Text
"about|exactly <quantity>"
    , pattern :: Pattern
pattern =
      [ String -> PatternItem
regex String
"\\~|exactly|precisely|about|approx(\\.|imately)?|close to|near( to)?|around|almost"
      , Dimension QuantityData -> PatternItem
forall a. Typeable a => Dimension a -> PatternItem
dimension Dimension QuantityData
Quantity
      ]
      , 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
  }

ruleIntervalBetweenNumeral :: Rule
ruleIntervalBetweenNumeral :: Rule
ruleIntervalBetweenNumeral = Rule :: Text -> Pattern -> Production -> Rule
Rule
    { name :: Text
name = Text
"between|from <numeral> and|to <quantity>"
    , pattern :: Pattern
pattern =
      [ String -> PatternItem
regex String
"between|from"
      , Predicate -> PatternItem
Predicate Predicate
isPositive
      , String -> PatternItem
regex String
"to|and"
      , Predicate -> PatternItem
Predicate Predicate
isSimpleQuantity
      ]
    , prod :: Production
prod = \case
        (Token
_:
         Token Dimension a
Numeral NumeralData{TNumeral.value = from}:
         Token
_:
         Token Dimension a
Quantity QuantityData{TQuantity.value = Just to
                                    , TQuantity.unit = Just u
                                    , TQuantity.aproduct = Nothing}:
         [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)
-> (QuantityData -> Token) -> QuantityData -> Maybe Token
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Dimension QuantityData -> QuantityData -> Token
forall a.
(Resolve a, Eq a, Hashable a, Show a, NFData a) =>
Dimension a -> a -> Token
Token Dimension QuantityData
Quantity (QuantityData -> Token)
-> (QuantityData -> QuantityData) -> QuantityData -> Token
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Double, Double) -> QuantityData -> QuantityData
withInterval (Double
from, Double
to) (QuantityData -> Maybe Token) -> QuantityData -> Maybe Token
forall a b. (a -> b) -> a -> b
$ Unit -> QuantityData
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 <quantity> to|and <quantity>"
    , pattern :: Pattern
pattern =
      [ String -> PatternItem
regex String
"between|from"
      , Predicate -> PatternItem
Predicate Predicate
isSimpleQuantity
      , String -> PatternItem
regex String
"and|to"
      , Predicate -> PatternItem
Predicate Predicate
isSimpleQuantity
      ]
    , prod :: Production
prod = \case
        (Token
_:
         Token Dimension a
Quantity QuantityData{TQuantity.value = Just from
                                    , TQuantity.unit = Just u1
                                    , TQuantity.aproduct = Nothing}:
         Token
_:
         Token Dimension a
Quantity QuantityData{TQuantity.value = Just to
                                    , TQuantity.unit = Just u2
                                    , TQuantity.aproduct = Nothing}:
         [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)
-> (QuantityData -> Token) -> QuantityData -> Maybe Token
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Dimension QuantityData -> QuantityData -> Token
forall a.
(Resolve a, Eq a, Hashable a, Show a, NFData a) =>
Dimension a -> a -> Token
Token Dimension QuantityData
Quantity (QuantityData -> Token)
-> (QuantityData -> QuantityData) -> QuantityData -> Token
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Double, Double) -> QuantityData -> QuantityData
withInterval (Double
from, Double
to) (QuantityData -> Maybe Token) -> QuantityData -> Maybe Token
forall a b. (a -> b) -> a -> b
$ Unit -> QuantityData
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> - <quantity>"
    , pattern :: Pattern
pattern =
      [ Predicate -> PatternItem
Predicate Predicate
isPositive
      , String -> PatternItem
regex String
"\\-"
      , Predicate -> PatternItem
Predicate Predicate
isSimpleQuantity
      ]
    , prod :: Production
prod = \case
        (Token Dimension a
Numeral NumeralData{TNumeral.value = from}:
         Token
_:
         Token Dimension a
Quantity QuantityData{TQuantity.value = Just to
                                    , TQuantity.unit = Just u
                                    , TQuantity.aproduct = Nothing}:
         [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)
-> (QuantityData -> Token) -> QuantityData -> Maybe Token
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Dimension QuantityData -> QuantityData -> Token
forall a.
(Resolve a, Eq a, Hashable a, Show a, NFData a) =>
Dimension a -> a -> Token
Token Dimension QuantityData
Quantity (QuantityData -> Token)
-> (QuantityData -> QuantityData) -> QuantityData -> Token
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Double, Double) -> QuantityData -> QuantityData
withInterval (Double
from, Double
to) (QuantityData -> Maybe Token) -> QuantityData -> Maybe Token
forall a b. (a -> b) -> a -> b
$ Unit -> QuantityData
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
"<quantity> - <quantity>"
    , pattern :: Pattern
pattern =
      [ Predicate -> PatternItem
Predicate Predicate
isSimpleQuantity
      , String -> PatternItem
regex String
"\\-"
      , Predicate -> PatternItem
Predicate Predicate
isSimpleQuantity
      ]
    , prod :: Production
prod = \case
        (Token Dimension a
Quantity QuantityData{TQuantity.value = Just from
                                    , TQuantity.unit = Just u1
                                    , TQuantity.aproduct = Nothing}:
         Token
_:
         Token Dimension a
Quantity QuantityData{TQuantity.value = Just to
                                    , TQuantity.unit = Just u2
                                    , TQuantity.aproduct = Nothing}:
         [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)
-> (QuantityData -> Token) -> QuantityData -> Maybe Token
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Dimension QuantityData -> QuantityData -> Token
forall a.
(Resolve a, Eq a, Hashable a, Show a, NFData a) =>
Dimension a -> a -> Token
Token Dimension QuantityData
Quantity (QuantityData -> Token)
-> (QuantityData -> QuantityData) -> QuantityData -> Token
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Double, Double) -> QuantityData -> QuantityData
withInterval (Double
from, Double
to) (QuantityData -> Maybe Token) -> QuantityData -> Maybe Token
forall a b. (a -> b) -> a -> b
$ Unit -> QuantityData
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/below/less/lower/at most/no more than <dist>"
    , pattern :: Pattern
pattern =
      [ String -> PatternItem
regex String
"under|below|at most|(less|lower|not? more) than"
      , Predicate -> PatternItem
Predicate Predicate
isSimpleQuantity
      ]
    , prod :: Production
prod = \case
        (Token
_:
         Token Dimension a
Quantity QuantityData{TQuantity.value = Just to
                                    , TQuantity.unit = Just u
                                    , TQuantity.aproduct = Nothing}:
         [Token]
_) -> Token -> Maybe Token
forall a. a -> Maybe a
Just (Token -> Maybe Token)
-> (QuantityData -> Token) -> QuantityData -> Maybe Token
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Dimension QuantityData -> QuantityData -> Token
forall a.
(Resolve a, Eq a, Hashable a, Show a, NFData a) =>
Dimension a -> a -> Token
Token Dimension QuantityData
Quantity (QuantityData -> Token)
-> (QuantityData -> QuantityData) -> QuantityData -> Token
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Double -> QuantityData -> QuantityData
withMax Double
to (QuantityData -> Maybe Token) -> QuantityData -> Maybe Token
forall a b. (a -> b) -> a -> b
$ Unit -> QuantityData
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/exceeding/beyond/at least/more than <quantity>"
  , pattern :: Pattern
pattern =
      [ String -> PatternItem
regex String
"over|above|exceeding|beyond|at least|(more|larger|bigger|heavier) than"
      , Predicate -> PatternItem
Predicate Predicate
isSimpleQuantity
      ]
    , prod :: Production
prod = \case
        (Token
_:
         Token Dimension a
Quantity QuantityData{TQuantity.value = Just from
                                    , TQuantity.unit = Just u
                                    , TQuantity.aproduct = Nothing}:
         [Token]
_) -> Token -> Maybe Token
forall a. a -> Maybe a
Just (Token -> Maybe Token)
-> (QuantityData -> Token) -> QuantityData -> Maybe Token
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Dimension QuantityData -> QuantityData -> Token
forall a.
(Resolve a, Eq a, Hashable a, Show a, NFData a) =>
Dimension a -> a -> Token
Token Dimension QuantityData
Quantity (QuantityData -> Token)
-> (QuantityData -> QuantityData) -> QuantityData -> Token
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Double -> QuantityData -> QuantityData
withMin Double
from (QuantityData -> Maybe Token) -> QuantityData -> Maybe Token
forall a b. (a -> b) -> a -> b
$ Unit -> QuantityData
unitOnly Unit
u
        [Token]
_ -> Maybe Token
forall a. Maybe a
Nothing
    }

ruleQuantityLatent :: Rule
ruleQuantityLatent :: Rule
ruleQuantityLatent = Rule :: Text -> Pattern -> Production -> Rule
Rule
  { name :: Text
name = Text
"<quantity> (latent)"
  , pattern :: Pattern
pattern =
    [ Predicate -> PatternItem
Predicate Predicate
isPositive
    ]
  , prod :: Production
prod = \case
      (Token Dimension a
Numeral NumeralData{TNumeral.value = v}: [Token]
_) ->
        Token -> Maybe Token
forall a. a -> Maybe a
Just (Token -> Maybe Token) -> Token -> Maybe Token
forall a b. (a -> b) -> a -> b
$ (Dimension QuantityData -> QuantityData -> Token
forall a.
(Resolve a, Eq a, Hashable a, Show a, NFData a) =>
Dimension a -> a -> Token
Token Dimension QuantityData
Quantity (QuantityData -> Token)
-> (QuantityData -> QuantityData) -> QuantityData -> Token
forall b c a. (b -> c) -> (a -> b) -> a -> c
. QuantityData -> QuantityData
mkLatent) (QuantityData -> Token) -> QuantityData -> Token
forall a b. (a -> b) -> a -> b
$ Double -> QuantityData
valueOnly Double
v
      [Token]
_ -> Maybe Token
forall a. Maybe a
Nothing
  }


rules :: [Rule]
rules :: [Rule]
rules =
  [ Rule
ruleQuantityOfProduct
  , Rule
ruleIntervalMin
  , Rule
ruleIntervalMax
  , Rule
ruleIntervalBetweenNumeral
  , Rule
ruleIntervalBetween
  , Rule
ruleIntervalNumeralDash
  , Rule
ruleIntervalDash
  , Rule
rulePrecision
  , Rule
ruleQuantityLatent
  ]
  [Rule] -> [Rule] -> [Rule]
forall a. [a] -> [a] -> [a]
++ [Rule]
ruleNumeralQuantities
  [Rule] -> [Rule] -> [Rule]
forall a. [a] -> [a] -> [a]
++ [Rule]
ruleAQuantity