-- 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. An additional grant
-- of patent rights can be found in the PATENTS file in the same directory.


{-# LANGUAGE GADTs #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE NoRebindableSyntax #-}

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

import Control.Monad (join)
import Data.HashMap.Strict (HashMap)
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

zeroNineteenMap :: HashMap Text Integer
zeroNineteenMap :: HashMap Text Integer
zeroNineteenMap = [(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
2)
  , (Text
"سه", Integer
3)
  , (Text
"چهار", Integer
4)
  , (Text
"پنج", Integer
5)
  , (Text
"شش", Integer
6)
  , (Text
"شیش", Integer
6)
  , (Text
"هفت", Integer
7)
  , (Text
"هشت", Integer
8)
  , (Text
"نه", Integer
9)
  , (Text
"ده", Integer
10)
  , (Text
"یازده", Integer
11)
  , (Text
"دوازده", Integer
12)
  , (Text
"سیزده", Integer
13)
  , (Text
"چهارده", Integer
14)
  , (Text
"پانزده", Integer
15)
  , (Text
"پونزده", Integer
15)
  , (Text
"شانزده", Integer
16)
  , (Text
"شونزده", Integer
16)
  , (Text
"هفده", Integer
17)
  , (Text
"هیفده", Integer
17)
  , (Text
"هجده", Integer
18)
  , (Text
"هیجده", Integer
18)
  , (Text
"نوزده", Integer
19)
  ]

ruleToNineteen :: Rule
ruleToNineteen :: Rule
ruleToNineteen = Rule :: Text -> Pattern -> Production -> Rule
Rule
  { name :: Text
name = Text
"integer (0..19)"
  , pattern :: Pattern
pattern =
    [ String -> PatternItem
regex String
"(صفر|یک|سه|چهارده|چهار|پنج|شی?ش|هفت|هشت|نه|یازده|دوازده|سیزده|پ(ا|و)نزده|ش(ا|و)نزده|هی?فده|هی?جده|نوزده|ده|دو)"
    ]
  , prod :: Production
prod = \[Token]
tokens -> case [Token]
tokens of
      (Token Dimension a
RegexMatch (GroupMatch (match:_)):[Token]
_) ->
        let x :: Text
x = Text -> Text
Text.toLower Text
match in
        (Text -> HashMap Text Integer -> Maybe Integer
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HashMap.lookup Text
x HashMap Text Integer
zeroNineteenMap 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
  }

tensMap :: HashMap Text Integer
tensMap :: HashMap Text Integer
tensMap = [(Text, Integer)] -> HashMap Text Integer
forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
HashMap.fromList
  [ ( Text
"بیست"  , Integer
20 )
  , ( Text
"سی"  , Integer
30 )
  , ( Text
"چهل"  , Integer
40 )
  , ( Text
"پنجاه"   , Integer
50 )
  , ( Text
"شصت"   , Integer
60 )
  , ( Text
"هفتاد" , Integer
70 )
  , ( Text
"هشتاد"  , Integer
80 )
  , ( Text
"نود"  , Integer
90 )
  , ( Text
"صد"  , Integer
100 )
  , ( Text
"دویست"  , Integer
200 )
  , ( Text
"سیصد"  , Integer
300 )
  , ( Text
"سی صد"  , Integer
300 )
  , ( Text
"چهارصد"  , Integer
400 )
  , ( Text
"چهار صد"  , Integer
400 )
  , ( Text
"پانصد"  , Integer
500 )
  , ( Text
"پونصد"  , Integer
500 )
  , ( Text
"شیشصد"  , Integer
600 )
  , ( Text
"شیش صد"  , Integer
600 )
  , ( Text
"ششصد"  , Integer
600 )
  , ( Text
"شش صد"  , Integer
600 )
  , ( Text
"هفتصد"  , Integer
700 )
  , ( Text
"هفت صد"  , Integer
700 )
  , ( Text
"هشتصد"  , Integer
800 )
  , ( Text
"هشت صد"  , Integer
800 )
  , ( Text
"نهصد"  , Integer
900 )
  , ( Text
"نه صد"  , Integer
900 )
  ]

ruleTens :: Rule
ruleTens :: Rule
ruleTens = Rule :: Text -> Pattern -> Production -> Rule
Rule
  { name :: Text
name = Text
"integer (20..90)"
  , 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
tensMap 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
  }

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
2 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
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
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
  }

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]
    , String -> PatternItem
regex String
"و"
    , 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
_:
       Token Dimension a
Numeral NumeralData{TNumeral.value = units}:
       [Token]
_) -> Double -> Maybe Token
double (Double -> Maybe Token) -> Double -> Maybe Token
forall a b. (a -> b) -> a -> b
$ Double
tens Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
units
      [Token]
_ -> Maybe Token
forall a. Maybe a
Nothing
  }

ruleCompositeHundred :: Rule
ruleCompositeHundred :: Rule
ruleCompositeHundred = Rule :: Text -> Pattern -> Production -> Rule
Rule
  { name :: Text
name = Text
"integer 21..99"
  , pattern :: Pattern
pattern =
    [ [Double] -> PatternItem
oneOf [Double
100,Double
200..Double
900]
    , String -> PatternItem
regex String
"و"
    , Double -> Double -> PatternItem
numberBetween Double
1 Double
100
    ]
  , prod :: Production
prod = \[Token]
tokens -> case [Token]
tokens of
      (Token Dimension a
Numeral NumeralData{TNumeral.value = tens}:
       Token
_:
       Token Dimension a
Numeral NumeralData{TNumeral.value = units}:
       [Token]
_) -> Double -> Maybe Token
double (Double -> Maybe Token) -> Double -> Maybe Token
forall a b. (a -> b) -> a -> b
$ Double
tens Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
units
      [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 -> 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 [Predicate
hasGrain, Predicate
isPositive]
    , 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
  }

ruleSumAnd :: Rule
ruleSumAnd :: Rule
ruleSumAnd = Rule :: Text -> Pattern -> Production -> Rule
Rule
  { name :: Text
name = Text
"intersect 2 numbers (with and)"
  , pattern :: Pattern
pattern =
    [ 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 [Predicate
hasGrain, Predicate
isPositive]
    , String -> PatternItem
regex String
"و"
    , 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
_:
       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
  }

numeralToStringMap :: HashMap Char String
numeralToStringMap :: HashMap Char String
numeralToStringMap =
  [(Char, String)] -> HashMap Char String
forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
HashMap.fromList
    [ (Char
'۰', String
"0")
    , (Char
'۱', String
"1")
    , (Char
'۲', String
"2")
    , (Char
'۳', String
"3")
    , (Char
'۴', String
"4")
    , (Char
'۵', String
"5")
    , (Char
'۶', String
"6")
    , (Char
'۷', String
"7")
    , (Char
'۸', String
"8")
    , (Char
'۹', String
"9")
    ]

parseIntAsText :: Text -> Text
parseIntAsText :: Text -> Text
parseIntAsText =
  String -> Text
Text.pack
    (String -> Text) -> (Text -> String) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> String
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join
    ([String] -> String) -> (Text -> [String]) -> Text -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Maybe String) -> String -> [String]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (Char -> HashMap Char String -> Maybe String
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
`HashMap.lookup` HashMap Char String
numeralToStringMap)
    (String -> [String]) -> (Text -> String) -> Text -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
Text.unpack

parseIntegerFromText :: Text -> Maybe Integer
parseIntegerFromText :: Text -> Maybe Integer
parseIntegerFromText = Text -> Maybe Integer
parseInteger (Text -> Maybe Integer) -> (Text -> Text) -> Text -> Maybe Integer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
parseIntAsText

ruleIntegerNumeric :: Rule
ruleIntegerNumeric :: Rule
ruleIntegerNumeric = Rule :: Text -> Pattern -> Production -> Rule
Rule
  { name :: Text
name = Text
"Persian integer numeric"
  , pattern :: Pattern
pattern =
    [ String -> PatternItem
regex String
"([۰-۹]{1,18})"
    ]
  , prod :: Production
prod = \[Token]
tokens -> case [Token]
tokens of
      (Token Dimension a
RegexMatch (GroupMatch (match:_)):[Token]
_) ->
        Text -> Maybe Integer
parseIntegerFromText Text
match 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
  }

rules :: [Rule]
rules :: [Rule]
rules =
  [ Rule
ruleIntegerNumeric
  , Rule
ruleToNineteen
  , Rule
ruleTens
  , Rule
rulePowersOfTen
  , Rule
ruleCompositeTens
  , Rule
ruleCompositeHundred
  , Rule
ruleSum
  , Rule
ruleSumAnd
  , Rule
ruleMultiply
  ]