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

module Duckling.Ordinal.TA.Rules
  ( rules ) where

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

oneToNineMap :: HashMap Text Int
oneToNineMap :: HashMap Text Int
oneToNineMap = [(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 )
  ]


ruleOneToNine :: Rule
ruleOneToNine :: Rule
ruleOneToNine = Rule :: Text -> Pattern -> Production -> Rule
Rule
  { name :: Text
name = Text
"integer (1..9)"
  , 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
oneToNineMap
      [Token]
_ -> Maybe Token
forall a. Maybe a
Nothing
  }

tenToNineteenMap :: HashMap Text Int
tenToNineteenMap :: HashMap Text Int
tenToNineteenMap = [(Text, Int)] -> HashMap Text Int
forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
HashMap.fromList
  [ ( 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 )
  ]

ruleTenToNineteen :: Rule
ruleTenToNineteen :: Rule
ruleTenToNineteen = Rule :: Text -> Pattern -> Production -> Rule
Rule
  { name :: Text
name = Text
"integer (10..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
tenToNineteenMap
      [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 )
  ]

oneToNineOrdinalMap :: HashMap Text Int
oneToNineOrdinalMap :: HashMap Text Int
oneToNineOrdinalMap = [(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 )
  ]

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
oneToNineOrdinalMap
        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 -> Token) -> Int -> Token
forall a b. (a -> b) -> a -> b
$ (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
ruleOneToNine
  , Rule
ruleTenToNineteen
  , Rule
ruleTens
  , Rule
ruleCompositeTens
  ]