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

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

import Data.Maybe
import Data.String
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

powersOfTenMap :: HashMap.HashMap Text.Text (Double, Int)
powersOfTenMap :: HashMap Text (Double, Int)
powersOfTenMap = [(Text, (Double, Int))] -> HashMap Text (Double, Int)
forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
HashMap.fromList
  [ ( Text
"chục",  (Double
1e1, Int
1) )
  , ( Text
"trăm",  (Double
1e2, Int
2) )
  , ( Text
"nghìn", (Double
1e3, Int
3) )
  , ( Text
"ngàn",  (Double
1e3, Int
3) )
  , ( Text
"triệu", (Double
1e6, Int
6) )
  , ( Text
"tỷ",    (Double
1e9, Int
9) )
  , ( Text
"tỉ",    (Double
1e9, Int
9) )
  ]

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
"(chục|trăm|nghìn|ngàn|triệu|t(ỷ|ỉ))"
    ]
  , prod :: Production
prod = \[Token]
tokens -> case [Token]
tokens of
      (Token Dimension a
RegexMatch (GroupMatch (match:_)):[Token]
_) -> do
        (Double
value, Int
grain) <- Text -> HashMap Text (Double, Int) -> Maybe (Double, Int)
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HashMap.lookup (Text -> Text
Text.toLower Text
match) HashMap Text (Double, Int)
powersOfTenMap
        Double -> Maybe Token
double Double
value 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
grain Maybe Token -> (Token -> Maybe Token) -> Maybe Token
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Token -> Maybe Token
withMultipliable
      [Token]
_ -> Maybe Token
forall a. Maybe a
Nothing
  }

ruleNumeralsPrefixWithM :: Rule
ruleNumeralsPrefixWithM :: Rule
ruleNumeralsPrefixWithM = Rule :: Text -> Pattern -> Production -> Rule
Rule
  { name :: Text
name = Text
"numbers prefix with -, âm"
  , pattern :: Pattern
pattern =
    [ String -> PatternItem
regex String
"\\-|âm"
    , 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
  }

ruleNumerals2 :: Rule
ruleNumerals2 :: Rule
ruleNumerals2 = Rule :: Text -> Pattern -> Production -> Rule
Rule
  { name :: Text
name = Text
"numbers 25 35 45 55 65 75 85 95"
  , pattern :: Pattern
pattern =
    [ [Double] -> PatternItem
oneOf [Double
20, Double
30 .. Double
90]
    , String -> PatternItem
regex String
"lăm"
    ]
  , prod :: Production
prod = \[Token]
tokens -> case [Token]
tokens of
      (Token Dimension a
Numeral NumeralData{TNumeral.value = v}:[Token]
_) -> Double -> Maybe Token
double (Double -> Maybe Token) -> Double -> Maybe Token
forall a b. (a -> b) -> a -> b
$ Double
v Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
5
      [Token]
_ -> Maybe Token
forall a. Maybe a
Nothing
  }

ruleDecimalWithThousandsSeparator :: Rule
ruleDecimalWithThousandsSeparator :: Rule
ruleDecimalWithThousandsSeparator = Rule :: Text -> Pattern -> Production -> Rule
Rule
  { name :: Text
name = Text
"decimal with thousands separator"
  , 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.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
  }

ruleDecimalNumeral :: Rule
ruleDecimalNumeral :: Rule
ruleDecimalNumeral = 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
False Text
match
      [Token]
_ -> Maybe Token
forall a. Maybe a
Nothing
  }

ruleInteger3 :: Rule
ruleInteger3 :: Rule
ruleInteger3 = 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 = v1}:
       Token Dimension a
Numeral NumeralData{TNumeral.value = v2}:
       [Token]
_) -> Double -> Maybe Token
double (Double -> Maybe Token) -> Double -> Maybe Token
forall a b. (a -> b) -> a -> b
$ Double
v1 Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
v2
      [Token]
_ -> Maybe Token
forall a. Maybe a
Nothing
  }

ruleNumeralDot :: Rule
ruleNumeralDot :: Rule
ruleNumeralDot = Rule :: Text -> Pattern -> Production -> Rule
Rule
  { name :: Text
name = Text
"number dot 1 9"
  , pattern :: Pattern
pattern =
    [ Dimension NumeralData -> PatternItem
forall a. Typeable a => Dimension a -> PatternItem
dimension Dimension NumeralData
Numeral
    , String -> PatternItem
regex String
"chấm|phẩy"
    , 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
  }

ruleIntersect :: Rule
ruleIntersect :: Rule
ruleIntersect = Rule :: Text -> Pattern -> Production -> Rule
Rule
  { name :: Text
name = Text
"intersect"
  , 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
  }

ruleNumeralsSuffixesKMG :: Rule
ruleNumeralsSuffixesKMG :: Rule
ruleNumeralsSuffixesKMG = Rule :: Text -> Pattern -> Production -> Rule
Rule
  { name :: Text
name = Text
"numbers suffixes (K, M, G)"
  , pattern :: Pattern
pattern =
    [ Dimension NumeralData -> PatternItem
forall a. Typeable a => Dimension a -> PatternItem
dimension Dimension NumeralData
Numeral
    , String -> PatternItem
regex String
"([kmg])(?=[\\W\\$€]|$)"
    ]
  , prod :: Production
prod = \[Token]
tokens -> case [Token]
tokens of
      (Token Dimension a
Numeral NumeralData{TNumeral.value = v}:
       Token Dimension a
RegexMatch (GroupMatch (match:_)):
       [Token]
_) -> case Text -> Text
Text.toLower Text
match of
         Text
"k" -> Double -> Maybe Token
double (Double -> Maybe Token) -> Double -> Maybe Token
forall a b. (a -> b) -> a -> b
$ Double
v Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
1e3
         Text
"m" -> Double -> Maybe Token
double (Double -> Maybe Token) -> Double -> Maybe Token
forall a b. (a -> b) -> a -> b
$ Double
v Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
1e6
         Text
"g" -> Double -> Maybe Token
double (Double -> Maybe Token) -> Double -> Maybe Token
forall a b. (a -> b) -> a -> b
$ Double
v Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
1e9
         Text
_   -> Maybe Token
forall a. Maybe a
Nothing
      [Token]
_ -> Maybe Token
forall a. Maybe a
Nothing
  }

integerMap :: HashMap.HashMap Text.Text Integer
integerMap :: HashMap Text Integer
integerMap = [(Text, Integer)] -> HashMap Text Integer
forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
HashMap.fromList
  [ (Text
"không", Integer
0)
  , (Text
"một", Integer
1)
  , (Text
"linh một", Integer
1)
  , (Text
"lẻ một", Integer
1)
  , (Text
"hai", Integer
2)
  , (Text
"lẻ hai", Integer
2)
  , (Text
"linh hai", Integer
2)
  , (Text
"ba", Integer
3)
  , (Text
"lẻ", Integer
3)
  , (Text
"linh ba", Integer
3)
  , (Text
"lẻ bốn", Integer
4)
  , (Text
"linh bốn", Integer
4)
  , (Text
"bốn", Integer
4)
  , (Text
"năm", Integer
5)
  , (Text
"lẻ năm", Integer
5)
  , (Text
"linh năm", Integer
5)
  , (Text
"linh sáu", Integer
6)
  , (Text
"sáu", Integer
6)
  , (Text
"lẻ sáu", Integer
6)
  , (Text
"linh bảy", Integer
7)
  , (Text
"lẻ bảy", Integer
7)
  , (Text
"bảy", Integer
7)
  , (Text
"lẻ tám", Integer
8)
  , (Text
"linh tám", Integer
8)
  , (Text
"tám", Integer
8)
  , (Text
"lẻ chín", Integer
9)
  , (Text
"chín", Integer
9)
  , (Text
"linh chín", Integer
9)
  , (Text
"linh mười", Integer
10)
  , (Text
"mười", Integer
10)
  , (Text
"lẻ mười", Integer
10)
  , (Text
"mười một", Integer
11)
  , (Text
"mười hai", Integer
12)
  , (Text
"mười ba", Integer
13)
  , (Text
"mười bốn", Integer
14)
  , (Text
"mười lăm", Integer
15)
  , (Text
"mười sáu", Integer
16)
  , (Text
"mười bảy", Integer
17)
  , (Text
"mười tám", Integer
18)
  , (Text
"mười chín", Integer
19)
  ]

ruleInteger :: Rule
ruleInteger :: Rule
ruleInteger = Rule :: Text -> Pattern -> Production -> Rule
Rule
  { name :: Text
name = Text
"integer (0..19)"
  , pattern :: Pattern
pattern =
    [ String -> PatternItem
regex String
"(không|một|linh một|lẻ một|hai|linh hai|lẻ hai|ba|linh ba|lẻ ba|bốn|linh bốn|lẻ bốn|năm|linh năm|lẻ năm|sáu|lẻ sáu|linh sáu|bảy|lẻ bảy|linh bảy|tám|linh tám|lẻ tám|chín|linh chín|lẻ chín|mười một|mười hai|mười ba|mười bốn|mười lăm|mười sáu|mười bảy|mười tám|mười chín|mười|linh mười)"
    ]
  , 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
integerMap 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.HashMap Text.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
"hai mươi", Integer
20)
  , (Text
"ba mươi", Integer
30)
  , (Text
"bốn mươi", Integer
40)
  , (Text
"năm mươi", Integer
50)
  , (Text
"sáu mươi", Integer
60)
  , (Text
"bảy mươi", Integer
70)
  , (Text
"tám mươi", Integer
80)
  , (Text
"chín mươi", Integer
90)
  ]

ruleInteger2 :: Rule
ruleInteger2 :: Rule
ruleInteger2 = Rule :: Text -> Pattern -> Production -> Rule
Rule
  { name :: Text
name = Text
"integer (20..90)"
  , pattern :: Pattern
pattern =
    [ String -> PatternItem
regex String
"(hai mươi|ba mươi|bốn mươi|năm mươi|sáu mươi|bảy mươi|tám mươi|chín mươi)"
    ]
  , 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
  }

ruleNumerals :: Rule
ruleNumerals :: Rule
ruleNumerals = Rule :: Text -> Pattern -> Production -> Rule
Rule
  { name :: Text
name = Text
"numbers 21 31 41 51 61 71 81 91"
  , pattern :: Pattern
pattern =
    [ [Double] -> PatternItem
oneOf [Double
20, Double
30 .. Double
90]
    , String -> PatternItem
regex String
"mốt"
    ]
  , prod :: Production
prod = \[Token]
tokens -> case [Token]
tokens of
      (Token Dimension a
Numeral NumeralData{TNumeral.value = v}:[Token]
_) -> Double -> Maybe Token
double (Double -> Maybe Token) -> Double -> Maybe Token
forall a b. (a -> b) -> a -> b
$ Double
v Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
1
      [Token]
_ -> Maybe Token
forall a. Maybe a
Nothing
  }

ruleT :: Rule
ruleT :: Rule
ruleT = Rule :: Text -> Pattern -> Production -> Rule
Rule
  { name :: Text
name = Text
"tá"
  , pattern :: Pattern
pattern =
    [ String -> PatternItem
regex String
"tá"
    ]
  , prod :: Production
prod = \[Token]
_ -> Integer -> Maybe Token
integer Integer
12 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
1 Maybe Token -> (Token -> Maybe Token) -> Maybe Token
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Token -> Maybe Token
withMultipliable
  }

ruleIntegerWithThousandsSeparator :: Rule
ruleIntegerWithThousandsSeparator :: Rule
ruleIntegerWithThousandsSeparator = Rule :: Text -> Pattern -> Production -> Rule
Rule
  { name :: Text
name = Text
"integer with thousands separator ,"
  , pattern :: Pattern
pattern =
    [ String -> PatternItem
regex String
"(\\d{1,3}(\\.\\d\\d\\d){1,5})"
    ]
  , prod :: Production
prod = \[Token]
tokens -> case [Token]
tokens of
      (Token Dimension a
RegexMatch (GroupMatch (match:_)):
       [Token]
_) -> let fmt :: Text
fmt = Text -> Text -> Text -> Text
Text.replace Text
"." Text
Text.empty Text
match
        in Text -> Maybe Double
parseDouble Text
fmt 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
ruleDecimalNumeral
  , Rule
ruleDecimalWithThousandsSeparator
  , Rule
ruleInteger
  , Rule
ruleInteger2
  , Rule
ruleInteger3
  , Rule
ruleIntegerWithThousandsSeparator
  , Rule
ruleIntersect
  , Rule
ruleMultiply
  , Rule
ruleNumeralDot
  , Rule
ruleNumerals
  , Rule
ruleNumerals2
  , Rule
ruleNumeralsPrefixWithM
  , Rule
ruleNumeralsSuffixesKMG
  , Rule
rulePowersOfTen
  , Rule
ruleT
  ]