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

module Duckling.Numeral.EL.Rules
  ( rules
  ) where

import Data.HashMap.Strict (HashMap)
import Data.List (intercalate)
import Data.Maybe
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.Numeral.Types (NumeralData (..))
import Duckling.Regex.Types
import Duckling.Types
import qualified Duckling.Numeral.Types as TNumeral

oneOrTwoDigitsMap :: HashMap Text Integer
oneOrTwoDigitsMap :: HashMap Text Integer
oneOrTwoDigitsMap = [(Text, Integer)] -> HashMap Text Integer
forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
HashMap.fromList
  [ ( Text
"μηδέν"       , Integer
0  )
  , ( Text
"ένα"         , Integer
1  )
  , ( Text
"ένας"        , Integer
1  )
  , ( Text
"ενός"        , Integer
1  )
  , ( Text
"μία"         , Integer
1  )
  , ( Text
"μια"         , Integer
1  )
  , ( Text
"δύο"         , Integer
2  )
  , ( Text
"δυο"         , Integer
2  )
  , ( Text
"τρία"        , Integer
3  )
  , ( Text
"τρεις"       , Integer
3  )
  , ( Text
"τέσσερα"     , Integer
4  )
  , ( Text
"τέσσερις"    , Integer
4  )
  , ( Text
"πέντε"       , Integer
5  )
  , ( Text
"έξι"         , Integer
6  )
  , ( Text
"επτά"        , Integer
7  )
  , ( Text
"εφτά"        , Integer
7  )
  , ( Text
"οκτώ"        , Integer
8  )
  , ( Text
"οχτώ"        , Integer
8  )
  , ( Text
"εννιά"       , Integer
9  )
  , ( Text
"εννέα"       , Integer
9  )
  , ( Text
"δέκα"        , Integer
10 )
  , ( Text
"δεκαριά"     , Integer
10 )
  , ( Text
"έντεκα"      , Integer
11 )
  , ( Text
"ένδεκα"      , Integer
11 )
  , ( Text
"δώδεκα"      , Integer
12 )
  , ( Text
"ντουζίνα"    , Integer
12 )
  , ( Text
"ντουζίνες"   , Integer
12 )
  , ( Text
"δεκατρία"    , Integer
13 )
  , ( Text
"δεκατέσσερα" , Integer
14 )
  , ( Text
"δεκαπέντε"   , Integer
15 )
  , ( Text
"δεκαέξι"     , Integer
16 )
  , ( Text
"δεκαεπτά"    , Integer
17 )
  , ( Text
"δεκαοκτώ"    , Integer
18 )
  , ( Text
"δεκαεννέα"   , Integer
19 )
  , ( Text
"δεκαεννιά"   , Integer
19 )
  , ( Text
"είκοσι"      , Integer
20 )
  , ( Text
"τριάντα"     , Integer
30 )
  , ( Text
"σαράντα"     , Integer
40 )
  , ( Text
"πενήντα"     , Integer
50 )
  , ( Text
"εξήντα"      , Integer
60 )
  , ( Text
"εβδομήντα"   , Integer
70 )
  , ( Text
"ογδόντα"     , Integer
80 )
  , ( Text
"ενενήντα"    , Integer
90 )
  ]

hundredsMap :: HashMap Text Integer
hundredsMap :: HashMap Text Integer
hundredsMap = [(Text, Integer)] -> HashMap Text Integer
forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
HashMap.fromList
  [ ( Text
"δι"   , Integer
200 )
  , ( Text
"τρι"  , Integer
300 )
  , ( Text
"τετρ" , Integer
400 )
  , ( Text
"πεντ" , Integer
500 )
  , ( Text
"εξ"   , Integer
600 )
  , ( Text
"επτ"  , Integer
700 )
  , ( Text
"εφτ"  , Integer
700 )
  , ( Text
"οκτ"  , Integer
800 )
  , ( Text
"οχτ"  , Integer
800 )
  , ( Text
"εννι" , Integer
900 )
  ]

ruleNumeral :: Rule
ruleNumeral :: Rule
ruleNumeral = Rule :: Text -> Pattern -> Production -> Rule
Rule
  { name :: Text
name = Text
"number (0..19, 20, 30..90)"
  , pattern :: Pattern
pattern = [ String -> PatternItem
regex String
regexString ]
  , prod :: Production
prod = \[Token]
tokens -> case [Token]
tokens of
      (Token Dimension a
RegexMatch (GroupMatch (match:_)):[Token]
_) ->
        Text -> HashMap Text Integer -> Maybe Integer
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HashMap.lookup (Text -> Text
Text.toLower Text
match) HashMap Text Integer
oneOrTwoDigitsMap Maybe Integer -> (Integer -> Maybe Token) -> Maybe Token
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Integer -> Maybe Token
integer
      [Token]
_ -> Maybe Token
forall a. Maybe a
Nothing
  }
  where
    regexString :: String
regexString = String
"(" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
"|"
      [ String
"μηδέν|[εέ]ν[αοό]ς?|μ[ιί]ας?"                                -- [0..1]
      , String
"δ[υύ]ο|τρ(ία|εις)|τέσσερ(α|ις)|πέντε"                       -- [2..5]
      , String
"έξι|ε[πφ]τά|ο[κχ]τώ|ενν(ιά|έα)|δέκα|δεκαριά"                -- [6..10]
      , String
"έν[τδ]εκα|δώδεκα|ντουζίν(α|ες)"                             -- [11..12]
      , String
"δεκα(τρία|τέσσερα|πέντε|έξι|ε[πφ]τά|ο[χκ]τώ|ενν(έα|ιά))"    -- [13..19]
      , String
"είκοσι|(τριά|σαρά|πενή|εξή|εβδομή|ογδό|ενενή)ντα"           -- [2..9]0
      ] String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
")"

ruleFew :: Rule
ruleFew :: Rule
ruleFew = Rule :: Text -> Pattern -> Production -> Rule
Rule
  { name :: Text
name = Text
"few"
  , pattern :: Pattern
pattern =
    [ String -> PatternItem
regex String
"μερικ(ά|ές|οί)"
    ]
  , prod :: Production
prod = \[Token]
_ -> Integer -> Maybe Token
integer Integer
3
  }

ruleCompositeTens :: Rule
ruleCompositeTens :: Rule
ruleCompositeTens = Rule :: Text -> Pattern -> Production -> Rule
Rule
  { name :: Text
name = Text
"integer 21..99"
  , pattern :: Pattern
pattern =
      [ [Double] -> PatternItem
oneOf [Double
20,Double
30..Double
90]
      , Double -> Double -> PatternItem
numberBetween Double
1 Double
10
      ]
  , prod :: Production
prod = \[Token]
tokens -> case [Token]
tokens of
      (Token Dimension a
Numeral NumeralData{TNumeral.value = tens} :
       Token Dimension a
Numeral NumeralData{TNumeral.value = units} :
       [Token]
_) -> Double -> Maybe Token
double (Double
tens Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
units)
      [Token]
_ -> Maybe Token
forall a. Maybe a
Nothing
  }

ruleHundred :: Rule
ruleHundred :: Rule
ruleHundred = Rule :: Text -> Pattern -> Production -> Rule
Rule
  { name :: Text
name = Text
"number (100)"
  , pattern :: Pattern
pattern = [ String -> PatternItem
regex String
"(εκατόν?)" ]
  , prod :: Production
prod = \[Token]
tokens -> case [Token]
tokens of
      (Token Dimension a
RegexMatch (GroupMatch _):[Token]
_) -> Integer -> Maybe Token
integer Integer
100 Maybe Token -> (Token -> Maybe Token) -> Maybe Token
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Int -> Token -> Maybe Token
withGrain Int
2
      [Token]
_ -> Maybe Token
forall a. Maybe a
Nothing
  }

ruleHundreds :: Rule
ruleHundreds :: Rule
ruleHundreds = Rule :: Text -> Pattern -> Production -> Rule
Rule
  { name :: Text
name = Text
"number (200..900)"
  , pattern :: Pattern
pattern =
      [ String -> PatternItem
regex String
"(δι|τρι|τετρ|πεντ|εξ|ε(π|φ)τ|ο(χ|κ)τ|εννι)ακόσι(α|ες|οι)"
      ]
  , prod :: Production
prod = \[Token]
tokens -> case [Token]
tokens of
      (Token Dimension a
RegexMatch (GroupMatch (match:_)):[Token]
_) ->
        Text -> HashMap Text Integer -> Maybe Integer
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HashMap.lookup (Text -> Text
Text.toLower Text
match) HashMap Text Integer
hundredsMap Maybe Integer -> (Integer -> Maybe Token) -> Maybe Token
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=
        Integer -> Maybe Token
integer Maybe Token -> (Token -> Maybe Token) -> Maybe Token
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Int -> Token -> Maybe Token
withGrain Int
2
      [Token]
_ -> Maybe Token
forall a. Maybe a
Nothing
  }

rulePowersOfTen :: Rule
rulePowersOfTen :: Rule
rulePowersOfTen = Rule :: Text -> Pattern -> Production -> Rule
Rule
  { name :: Text
name = Text
"powers of tens"
  , pattern :: Pattern
pattern =
    [ String -> PatternItem
regex String
"(χίλι(α|οι|ες)|χιλιάδες|εκατομμύρι(ο|α)|δις|δισεκατομμύριο)"
    ]
  , prod :: Production
prod = \[Token]
tokens -> case [Token]
tokens of
      (Token Dimension a
RegexMatch (GroupMatch (match:_)):[Token]
_) -> case Text -> Text
Text.toLower Text
match of
        Text
"χίλια"          -> Double -> Maybe Token
double Double
1e3 Maybe Token -> (Token -> Maybe Token) -> Maybe Token
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Int -> Token -> Maybe Token
withGrain Int
3 Maybe Token -> (Token -> Maybe Token) -> Maybe Token
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Token -> Maybe Token
withMultipliable
        Text
"χιλιάδες"       -> Double -> Maybe Token
double Double
1e3 Maybe Token -> (Token -> Maybe Token) -> Maybe Token
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Int -> Token -> Maybe Token
withGrain Int
3 Maybe Token -> (Token -> Maybe Token) -> Maybe Token
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Token -> Maybe Token
withMultipliable
        Text
"εκατομμύριο"    -> Double -> Maybe Token
double Double
1e6 Maybe Token -> (Token -> Maybe Token) -> Maybe Token
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Int -> Token -> Maybe Token
withGrain Int
6 Maybe Token -> (Token -> Maybe Token) -> Maybe Token
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Token -> Maybe Token
withMultipliable
        Text
"εκατομμύρια"    -> Double -> Maybe Token
double Double
1e6 Maybe Token -> (Token -> Maybe Token) -> Maybe Token
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Int -> Token -> Maybe Token
withGrain Int
6 Maybe Token -> (Token -> Maybe Token) -> Maybe Token
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Token -> Maybe Token
withMultipliable
        Text
"δις"            -> Double -> Maybe Token
double Double
1e9 Maybe Token -> (Token -> Maybe Token) -> Maybe Token
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Int -> Token -> Maybe Token
withGrain Int
9 Maybe Token -> (Token -> Maybe Token) -> Maybe Token
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Token -> Maybe Token
withMultipliable
        Text
"δισεκατομμύριο" -> Double -> Maybe Token
double Double
1e9 Maybe Token -> (Token -> Maybe Token) -> Maybe Token
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Int -> Token -> Maybe Token
withGrain Int
9 Maybe Token -> (Token -> Maybe Token) -> Maybe Token
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Token -> Maybe Token
withMultipliable
        Text
"δισεκατομμύρια" -> Double -> Maybe Token
double Double
1e9 Maybe Token -> (Token -> Maybe Token) -> Maybe Token
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Int -> Token -> Maybe Token
withGrain Int
9 Maybe Token -> (Token -> Maybe Token) -> Maybe Token
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Token -> Maybe Token
withMultipliable
        Text
_                -> Maybe Token
forall a. Maybe a
Nothing
      [Token]
_ -> Maybe Token
forall a. Maybe a
Nothing
  }

ruleNegative :: Rule
ruleNegative :: Rule
ruleNegative = Rule :: Text -> Pattern -> Production -> Rule
Rule
  { name :: Text
name = Text
"negative numbers"
  , pattern :: Pattern
pattern =
    [ String -> PatternItem
regex String
"-|μείον"
    , Predicate -> PatternItem
Predicate Predicate
isPositive
    ]
  , prod :: Production
prod = \[Token]
tokens -> case [Token]
tokens of
      (Token
_:Token Dimension a
Numeral a
nd:[Token]
_) -> Double -> Maybe Token
double (NumeralData -> Double
TNumeral.value a
NumeralData
nd Double -> Double -> Double
forall a. Num a => a -> a -> a
* (-Double
1))
      [Token]
_ -> Maybe Token
forall a. Maybe a
Nothing
  }

ruleSum :: Rule
ruleSum :: Rule
ruleSum = Rule :: Text -> Pattern -> Production -> Rule
Rule
  { name :: Text
name = Text
"intersect 2 numbers"
  , pattern :: Pattern
pattern =
    [ Predicate -> PatternItem
Predicate Predicate
hasGrain
    , Predicate -> PatternItem
Predicate (Predicate -> PatternItem) -> Predicate -> PatternItem
forall a b. (a -> b) -> a -> b
$ [Bool] -> Bool
forall (t :: * -> *). Foldable t => t Bool -> Bool
and ([Bool] -> Bool) -> (Token -> [Bool]) -> Predicate
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Predicate] -> Token -> [Bool]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence [Bool -> Bool
not (Bool -> Bool) -> Predicate -> Predicate
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Predicate
isMultipliable, Predicate
isPositive]
    ]
  , prod :: Production
prod = \[Token]
tokens -> case [Token]
tokens of
      (Token Dimension a
Numeral NumeralData{TNumeral.value = val1, TNumeral.grain = Just g}:
       Token Dimension a
Numeral NumeralData{TNumeral.value = val2}:
       [Token]
_) | (Double
10 Double -> Double -> Double
forall a. Floating a => a -> a -> a
** Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
g) Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
> Double
val2 -> Double -> Maybe Token
double (Double -> Maybe Token) -> Double -> Maybe Token
forall a b. (a -> b) -> a -> b
$ Double
val1 Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
val2
      [Token]
_ -> Maybe Token
forall a. Maybe a
Nothing
  }

ruleMultiply :: Rule
ruleMultiply :: Rule
ruleMultiply = Rule :: Text -> Pattern -> Production -> Rule
Rule
  { name :: Text
name = Text
"compose by multiplication"
  , pattern :: Pattern
pattern =
    [ Dimension NumeralData -> PatternItem
forall a. Typeable a => Dimension a -> PatternItem
dimension Dimension NumeralData
Numeral
    , Predicate -> PatternItem
Predicate Predicate
isMultipliable
    ]
  , prod :: Production
prod = \[Token]
tokens -> case [Token]
tokens of
      (Token
token1:Token
token2:[Token]
_) -> Token -> Token -> Maybe Token
multiply Token
token1 Token
token2
      [Token]
_ -> Maybe Token
forall a. Maybe a
Nothing
  }

ruleDecimals :: Rule
ruleDecimals :: Rule
ruleDecimals = Rule :: Text -> Pattern -> Production -> Rule
Rule
  { name :: Text
name = Text
"decimal number"
  , pattern :: Pattern
pattern =
    [ String -> PatternItem
regex String
"(\\d+,\\d+)"
    ]
  , prod :: Production
prod = \[Token]
tokens -> case [Token]
tokens of
      (Token Dimension a
RegexMatch (GroupMatch (match:_)):[Token]
_) ->
        Bool -> Text -> Maybe Token
parseDecimal Bool
True (Text -> Text -> Text -> Text
Text.replace Text
"," Text
"." Text
match)
      [Token]
_ -> Maybe Token
forall a. Maybe a
Nothing
  }

ruleCommaSpelledOut :: Rule
ruleCommaSpelledOut :: Rule
ruleCommaSpelledOut = Rule :: Text -> Pattern -> Production -> Rule
Rule
  { name :: Text
name = Text
"one point two"
  , pattern :: Pattern
pattern =
    [ Dimension NumeralData -> PatternItem
forall a. Typeable a => Dimension a -> PatternItem
dimension Dimension NumeralData
Numeral
    , String -> PatternItem
regex String
"κόμμα"
    , Predicate -> PatternItem
Predicate (Predicate -> PatternItem) -> Predicate -> PatternItem
forall a b. (a -> b) -> a -> b
$ Bool -> Bool
not (Bool -> Bool) -> Predicate -> Predicate
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Predicate
hasGrain
    ]
  , prod :: Production
prod = \[Token]
tokens -> case [Token]
tokens of
      (Token Dimension a
Numeral a
nd1:Token
_:Token Dimension a
Numeral a
nd2:[Token]
_) ->
        Double -> Maybe Token
double (Double -> Maybe Token) -> Double -> Maybe Token
forall a b. (a -> b) -> a -> b
$ NumeralData -> Double
TNumeral.value a
NumeralData
nd1 Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double -> Double
decimalsToDouble (NumeralData -> Double
TNumeral.value a
NumeralData
nd2)
      [Token]
_ -> Maybe Token
forall a. Maybe a
Nothing
  }

ruleDots :: Rule
ruleDots :: Rule
ruleDots = Rule :: Text -> Pattern -> Production -> Rule
Rule
  { name :: Text
name = Text
"dot-separated numbers"
  , pattern :: Pattern
pattern =
    [ String -> PatternItem
regex String
"(\\d+(\\.\\d\\d\\d)+(,\\d+)?)"
    ]
  , prod :: Production
prod = \[Token]
tokens -> case [Token]
tokens of
      (Token Dimension a
RegexMatch (GroupMatch (match:_)):[Token]
_) ->
        Text -> Maybe Double
parseDouble (
          Text -> Text -> Text -> Text
Text.replace Text
"," Text
"." (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ Text -> Text -> Text -> Text
Text.replace Text
"." Text
Text.empty Text
match
        ) Maybe Double -> (Double -> Maybe Token) -> Maybe Token
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Double -> Maybe Token
double
      [Token]
_ -> Maybe Token
forall a. Maybe a
Nothing
  }

rules :: [Rule]
rules :: [Rule]
rules =
  [ Rule
ruleFew
  , Rule
ruleNumeral
  , Rule
ruleCompositeTens
  , Rule
rulePowersOfTen
  , Rule
ruleNegative
  , Rule
ruleHundred
  , Rule
ruleHundreds
  , Rule
ruleSum
  , Rule
ruleMultiply
  , Rule
ruleDecimals
  , Rule
ruleCommaSpelledOut
  , Rule
ruleDots
  ]