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

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

import Control.Applicative ((<|>))
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

zeroAndTenMap :: HashMap Text Integer
zeroAndTenMap :: HashMap Text Integer
zeroAndTenMap = [(Text, Integer)] -> HashMap Text Integer
forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
HashMap.fromList
  [ ( Text
"nul" , Integer
0  )
  , ( Text
"geen", Integer
0  )
  , ( Text
"niks", Integer
0  )
  , ( Text
"zero", Integer
0  )
  , ( Text
"tien", Integer
10 )
  ]

oneToNineMap :: HashMap Text Integer
oneToNineMap :: HashMap Text Integer
oneToNineMap = [(Text, Integer)] -> HashMap Text Integer
forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
HashMap.fromList
  [ ( Text
"een" , Integer
1 )
  , ( Text
"twee", Integer
2 )
  , ( Text
"drie", Integer
3 )
  , ( Text
"vier", Integer
4 )
  , ( Text
"vyf" , Integer
5 )
  , ( Text
"ses" , Integer
6 )
  , ( Text
"sewe", Integer
7 )
  , ( Text
"agt" , Integer
8 )
  , ( Text
"ag"  , Integer
8 )
  , ( Text
"nege", Integer
9 )
  ]

ruleNumeral :: Rule
ruleNumeral :: Rule
ruleNumeral = Rule :: Text -> Pattern -> Production -> Rule
Rule
  { name :: Text
name = Text
"number (0..10)"
  , pattern :: Pattern
pattern =
    [ String -> PatternItem
regex (String -> PatternItem) -> (Text -> String) -> Text -> PatternItem
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
Text.unpack (Text -> PatternItem) -> Text -> PatternItem
forall a b. (a -> b) -> a -> b
$
        [Text] -> Text
Text.concat [ Text
"(", Text -> [Text] -> Text
Text.intercalate Text
"|"
          ((HashMap Text Integer -> [Text]
forall k v. HashMap k v -> [k]
HashMap.keys HashMap Text Integer
zeroAndTenMap) [Text] -> [Text] -> [Text]
forall a. [a] -> [a] -> [a]
++ (HashMap Text Integer -> [Text]
forall k v. HashMap k v -> [k]
HashMap.keys HashMap Text Integer
oneToNineMap)), Text
")" ]
    ]
  , prod :: Production
prod = \case
      (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
oneToNineMap 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 -> Maybe Token -> Maybe Token
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
        (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
zeroAndTenMap 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
  }

elevenToNineteenMap :: HashMap Text Integer
elevenToNineteenMap :: HashMap Text Integer
elevenToNineteenMap = [(Text, Integer)] -> HashMap Text Integer
forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
HashMap.fromList
  [ ( Text
"elf"      , Integer
11 )
  , ( Text
"twaalf"   , Integer
12 )
  , ( Text
"dertien"  , Integer
13 )
  , ( Text
"veertien" , Integer
14 )
  , ( Text
"vyftien"  , Integer
15 )
  , ( Text
"sestien"  , Integer
16 )
  , ( Text
"sewentien", Integer
17 )
  , ( Text
"agtien"   , Integer
18 )
  , ( Text
"negentien", Integer
19 )
  , ( Text
"neentien" , Integer
19 )
  ]

ruleElevenToNineteen :: Rule
ruleElevenToNineteen :: Rule
ruleElevenToNineteen = Rule :: Text -> Pattern -> Production -> Rule
Rule
  { name :: Text
name = Text
"number (11..19)"
  , pattern :: Pattern
pattern =
    [ String -> PatternItem
regex String
"(elf|twaalf|dertien|veertien|vyftien|sestien|sewentien|agtien|neg?entien)"
    ]
  , prod :: Production
prod = \case
      (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
elevenToNineteenMap 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
"twin" , Integer
20 )
  , ( Text
"der"  , Integer
30 )
  , ( Text
"veer" , Integer
40 )
  , ( Text
"vyf"  , Integer
50 )
  , ( Text
"ses"  , Integer
60 )
  , ( Text
"sewen", Integer
70 )
  , ( Text
"tag"  , Integer
80 )
  , ( Text
"negen", Integer
90 )
  , ( Text
"neen" , Integer
90 )
  ]

ruleTens :: Rule
ruleTens :: Rule
ruleTens = Rule :: Text -> Pattern -> Production -> Rule
Rule
  { name :: Text
name = Text
"integer (20,30..90)"
  , pattern :: Pattern
pattern =
    [ String -> PatternItem
regex String
"(twin|der|veer|vyf|ses|sewen|tag|neg?en)tig"
    ]
  , prod :: Production
prod = \case
      (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
  }

ruleCompositeTens :: Rule
ruleCompositeTens :: Rule
ruleCompositeTens = Rule :: Text -> Pattern -> Production -> Rule
Rule
  { name :: Text
name = Text
"integer ([3-9][1-9])"
  , pattern :: Pattern
pattern =
    [ Double -> Double -> PatternItem
numberBetween Double
1 Double
10
    , String -> PatternItem
regex String
"en"
    , [Double] -> PatternItem
oneOf [Double
20, Double
30..Double
90]
    ]
  , prod :: Production
prod = \case
      (Token Dimension a
Numeral NumeralData{TNumeral.value = units}:
       Token
_:
       Token Dimension a
Numeral NumeralData{TNumeral.value = tens}:
       [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
  }

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 = \case
      (Token Dimension a
RegexMatch (GroupMatch (match:_)):[Token]
_) -> Bool -> Text -> Maybe Token
parseDecimal Bool
False Text
match
      [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
"(honderd|duisend)"
    ]
  , prod :: Production
prod = \case
      (Token Dimension a
RegexMatch (GroupMatch (match:_)):[Token]
_) -> case Text -> Text
Text.toLower Text
match of
        Text
"honderd" -> Double -> Maybe Token
double Double
1e2 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
"duisend" -> 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
_ -> Maybe Token
forall a. Maybe a
Nothing
      [Token]
_ -> Maybe Token
forall a. Maybe a
Nothing
  }

ruleDozen :: Rule
ruleDozen :: Rule
ruleDozen = Rule :: Text -> Pattern -> Production -> Rule
Rule
  { name :: Text
name = Text
"a dozen of"
  , pattern :: Pattern
pattern =
    [ String -> PatternItem
regex String
"dosyn"
    ]
  , 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
>>= Token -> Maybe Token
withMultipliable Maybe Token -> (Token -> Maybe Token) -> Maybe Token
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Token -> Maybe Token
notOkForAnyTime
  }

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 = \case
      (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 = \case
      (Token
token1:Token
token2:[Token]
_) -> Token -> Token -> Maybe Token
multiply Token
token1 Token
token2
      [Token]
_ -> Maybe Token
forall a. Maybe a
Nothing
  }

rules :: [Rule]
rules :: [Rule]
rules =
  [ Rule
ruleNumeral
  , Rule
ruleDozen
  , Rule
ruleDecimals
  , Rule
rulePowersOfTen
  , Rule
ruleElevenToNineteen
  , Rule
ruleTens
  , Rule
ruleCompositeTens
  , Rule
ruleSum
  , Rule
ruleMultiply
  ]