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

module Duckling.Ordinal.ML.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 (parseInt)
import Duckling.Ordinal.Helpers
import Duckling.Regex.Types
import Duckling.Types

oneToNineteenMap :: HashMap Text Int
oneToNineteenMap :: HashMap Text Int
oneToNineteenMap = [(Text, Int)] -> HashMap Text Int
forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
HashMap.fromList
  [ ( Text
"ഒന്നാം", Int
1 )
  , ( Text
"രണ്ടാം", Int
2 )
  , ( Text
"മൂന്നാം", Int
3 )
  , ( Text
"നാലാം", Int
4 )
  , ( Text
"അഞ്ചാം", Int
5 )
  , ( Text
"ആറാം", Int
6 )
  , ( Text
"ഏഴാം", Int
7 )
  , ( Text
"എട്ടാം", Int
8 )
  , ( Text
"ഒമ്പതാം", Int
9 )
  , ( Text
"പത്താം", Int
10 )
  , ( Text
"പതിനൊന്നാം", Int
11 )
  , ( Text
"പന്ത്രണ്ടാം", Int
12 )
  , ( Text
"പതിമൂന്നാം", Int
13 )
  , ( Text
"പതിനാലാം", Int
14 )
  , ( Text
"പതിനഞ്ചാം", Int
15 )
  , ( Text
"പതിനാറാം", Int
16 )
  , ( Text
"പതിനേഴാം", Int
17 )
  , ( Text
"പതിനെട്ടാം", Int
18 )
  , ( Text
"പത്തൊൻപതാം", Int
19 )
  ]

ruleOneToNineteen :: Rule
ruleOneToNineteen :: Rule
ruleOneToNineteen = Rule :: Text -> Pattern -> Production -> Rule
Rule
  { name :: Text
name = Text
"integer (1..19)"
  , pattern :: Pattern
pattern =
    [ String -> PatternItem
regex String
"(ഒന്നാം|രണ്ടാം|മൂന്നാം|നാലാം|അഞ്ചാം|ആറാം|ഏഴാം|എട്ടാം|ഒമ്പതാം|പത്താം|പതിനൊന്നാം|പന്ത്രണ്ടാം|പതിമൂന്നാം|പതിനാലാം|പതിനഞ്ചാം|പതിനാറാം|പതിനേഴാം|പതിനെട്ടാം|പത്തൊൻപതാം)"
    ]
  , prod :: Production
prod = \case
      (Token Dimension a
RegexMatch (GroupMatch (match:_)):[Token]
_) ->
        Int -> Token
ordinal (Int -> Token) -> Maybe Int -> Maybe Token
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> HashMap Text Int -> Maybe Int
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HashMap.lookup (Text -> Text
Text.toLower Text
match) HashMap Text Int
oneToNineteenMap
      [Token]
_ -> Maybe Token
forall a. Maybe a
Nothing
  }

tensMap :: HashMap Text Int
tensMap :: HashMap Text Int
tensMap = [(Text, Int)] -> HashMap Text Int
forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
HashMap.fromList
  [ ( Text
"ഇരുപതാം", Int
20 )
  , ( Text
"മുപ്പത്തഞ്ചാം", Int
30 )
  , ( Text
"നാല്പതാം", Int
40 )
  , ( Text
"അമ്പതാം", Int
50 )
  , ( Text
"അറുപതാം", Int
60 )
  , ( Text
"എഴുപത്താം", Int
70 )
  , ( Text
"എൺപത്താം", Int
80 )
  , ( Text
"തൊണ്ണൂറാം", Int
90 )
  ]

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 = \case
      (Token Dimension a
RegexMatch (GroupMatch (match:_)):[Token]
_) ->
        Int -> Token
ordinal (Int -> Token) -> Maybe Int -> Maybe Token
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> HashMap Text Int -> Maybe Int
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HashMap.lookup (Text -> Text
Text.toLower Text
match) HashMap Text Int
tensMap
      [Token]
_ -> Maybe Token
forall a. Maybe a
Nothing
  }

tensOrdinalMap :: HashMap Text Int
tensOrdinalMap :: HashMap Text Int
tensOrdinalMap = [(Text, Int)] -> HashMap Text Int
forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
HashMap.fromList
  [ ( Text
"ഇരുപത്തി", Int
20 )
  , ( Text
"മുപ്പത്തി", Int
30 )
  , ( Text
"നാല്പത്തി", Int
40 )
  , ( Text
"അമ്പത്തി", Int
50 )
  , ( Text
"അറുപത്തി", Int
60 )
  , ( Text
"എഴുപത്തി", Int
70 )
  , ( Text
"എൺപത്തി", Int
80 )
  , ( Text
"തൊണ്ണൂറ്റി", Int
90 )
  ]

oneToNineMap :: HashMap Text Int
oneToNineMap :: HashMap Text Int
oneToNineMap = (Text -> Int -> Bool) -> HashMap Text Int -> HashMap Text Int
forall k v. (k -> v -> Bool) -> HashMap k v -> HashMap k v
HashMap.filterWithKey (\Text
_ Int
v -> Int
v Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
9) HashMap Text Int
oneToNineteenMap


ruleCompositeTens :: Rule
ruleCompositeTens :: Rule
ruleCompositeTens = Rule :: Text -> Pattern -> Production -> Rule
Rule
  { name :: Text
name = Text
"integer ([2-9][1-9])"
  , pattern :: Pattern
pattern =
    [ String -> PatternItem
regex String
"(ഇരുപത്തി|മുപ്പത്തി|നാല്പത്തി|അമ്പത്തി|അറുപത്തി|എഴുപത്തി|എൺപത്തി|തൊണ്ണൂറ്റി)(ആദ്യം|രണ്ടാം|മൂന്നാം|നാലാം|അഞ്ചാം|ആറാം|ഏഴാം|എട്ടാം|ഒമ്പത)"
    ]
  , prod :: Production
prod = \case
      (Token Dimension a
RegexMatch (GroupMatch (m1:m2:_)):[Token]
_) -> do
        Int
v1 <- Text -> HashMap Text Int -> Maybe Int
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HashMap.lookup (Text -> Text
Text.toLower Text
m1) HashMap Text Int
tensOrdinalMap
        Int
v2 <- Text -> HashMap Text Int -> Maybe Int
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HashMap.lookup (Text -> Text
Text.toLower Text
m2) HashMap Text Int
oneToNineMap
        Token -> Maybe Token
forall a. a -> Maybe a
Just (Token -> Maybe Token) -> Token -> Maybe Token
forall a b. (a -> b) -> a -> b
$ Int -> Token
ordinal (Int
v1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
v2)
      [Token]
_ -> Maybe Token
forall a. Maybe a
Nothing
  }

ruleOrdinalDigits :: Rule
ruleOrdinalDigits :: Rule
ruleOrdinalDigits = Rule :: Text -> Pattern -> Production -> Rule
Rule
  { name :: Text
name = Text
"ordinal (digits)"
  , pattern :: Pattern
pattern =
    [ String -> PatternItem
regex String
"0*(\\d+)\\."
    ]
  , prod :: Production
prod = \case
    (   Token Dimension a
RegexMatch (GroupMatch (match :_)) : [Token]
_)
          -> Int -> Token
ordinal (Int -> Token) -> Maybe Int -> Maybe Token
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> Maybe Int
parseInt Text
match
    [Token]
_ -> Maybe Token
forall a. Maybe a
Nothing
  }

rules :: [Rule]
rules :: [Rule]
rules =
  [ Rule
ruleOrdinalDigits
  , Rule
ruleOneToNineteen
  , Rule
ruleTens
  , Rule
ruleCompositeTens
  ]