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

module Duckling.Numeral.TH.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

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
"โหล?( ของ)?"
    ]
  , 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
  }

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
0 )
  , ( Text
"หนึ่ง", Integer
1 )
  , ( Text
"เอ็ด", Integer
1 )
  , ( Text
"สอง", Integer
2 )
  , ( Text
"สาม", Integer
3 )
  , ( Text
"สี่", Integer
4 )
  , ( Text
"ห้า", Integer
5 )
  , ( Text
"หก", Integer
6 )
  , ( Text
"เจ็ด", Integer
7 )
  , ( Text
"แปด", Integer
8 )
  , ( Text
"เก้า", Integer
9 )
  , ( Text
"สิบ", Integer
10 )
  , ( Text
"สิบเอ็ด", Integer
11 )
  , ( Text
"สิบหนึ่ง", Integer
11 )
  , ( Text
"สิบสอง", Integer
12 )
  , ( Text
"สิบสาม", Integer
13 )
  , ( Text
"สิบสี่", Integer
14 )
  , ( Text
"สิบห้า", Integer
15 )
  , ( Text
"สิบหก", Integer
16 )
  , ( Text
"สิบเจ็ด", Integer
17 )
  , ( Text
"สิบแปด", Integer
18 )
  , ( Text
"สิบเก้า", Integer
19 )
  ]

informalMap :: HashMap Text Integer
informalMap :: HashMap Text Integer
informalMap = [(Text, Integer)] -> HashMap Text Integer
forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
HashMap.fromList
  [ ( Text
"อันนึง", Integer
1 )
  , ( Text
"คู่นึง", Integer
2 )
  , ( Text
"คู่ของ", Integer
2 )
  ]

ruleToNineteen :: Rule
ruleToNineteen :: Rule
ruleToNineteen = Rule :: Text -> Pattern -> Production -> Rule
Rule
  { name :: Text
name = Text
"integer (0..19)"
  -- e.g. fourteen must be before four, otherwise four will always shadow fourteen
  , pattern :: Pattern
pattern =
    [ String -> PatternItem
regex String
"(ไม่มี|ศูนย์|สิบหนึ่ง|หนึ่ง|(คู่)s?( ของ)?|(คู่)s?( นึง)?|สิบเอ็ด|เอ็ด|สิบสอง|สิบสาม|สิบสี่|สิบห้า|สิบหก|สิบเจ็ด|สิบแปด|สิบเก้า|สอง|สาม|สี่|ห้า|หก|เจ็ด|แปด|เก้า|สิบ)"
    ]
  , 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
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) 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
informalMap 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 -> (Token -> Maybe Token) -> Maybe Token
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Token -> Maybe Token
notOkForAnyTime)
      [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 )
  ]

ruleTens :: Rule
ruleTens :: Rule
ruleTens = HashMap Text Integer -> Text -> (Integer -> Maybe Token) -> Rule
forall a. HashMap Text a -> Text -> (a -> Maybe Token) -> Rule
singleStringLookupRule HashMap Text Integer
tensMap Text
"integer (20..90)" Integer -> Maybe Token
integer

digitsHundredTwentyToTwentyNineMap :: HashMap Text Integer
digitsHundredTwentyToTwentyNineMap :: HashMap Text Integer
digitsHundredTwentyToTwentyNineMap = [(Text, Integer)] -> HashMap Text Integer
forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
HashMap.fromList
  [ ( Text
"ร้อยยี่สิบ", Integer
120 )
  , ( Text
"ร้อยยี่สิบเอ็ด", Integer
121 )
  , ( Text
"ร้อยยี่สิบหนึ่ง", Integer
121 )
  , ( Text
"ร้อยยี่สิบสอง", Integer
122 )
  , ( Text
"ร้อยยี่สิบสาม", Integer
123 )
  , ( Text
"ร้อยยี่สิบสี่", Integer
124 )
  , ( Text
"ร้อยยี่สิบห้า", Integer
125 )
  , ( Text
"ร้อยยี่สิบหก", Integer
126 )
  , ( Text
"ร้อยยี่สิบเจ็ด", Integer
127 )
  , ( Text
"ร้อยยี่สิบแปด", Integer
128 )
  , ( Text
"ร้อยยี่สิบเก้า", Integer
129 )
  , ( Text
"หนึ่งร้อยยี่สิบ", Integer
120 )
  , ( Text
"หนึ่งร้อยยี่สิบเอ็ด", Integer
121 )
  , ( Text
"หนึ่งร้อยยี่สิบหนึ่ง", Integer
121 )
  , ( Text
"หนึ่งร้อยยี่สิบสอง", Integer
122 )
  , ( Text
"หนึ่งร้อยยี่สิบสาม", Integer
123 )
  , ( Text
"หนึ่งร้อยยี่สิบสี่", Integer
124 )
  , ( Text
"หนึ่งร้อยยี่สิบห้า", Integer
125 )
  , ( Text
"หนึ่งร้อยยี่สิบหก", Integer
126 )
  , ( Text
"หนึ่งร้อยยี่สิบเจ็ด", Integer
127 )
  , ( Text
"หนึ่งร้อยยี่สิบแปด", Integer
128 )
  , ( Text
"หนึ่งร้อยยี่สิบเก้า", Integer
129 )
  , ( Text
"สองร้อยยี่สิบ", Integer
220 )
  , ( Text
"สองร้อยยี่สิบเอ็ด", Integer
221 )
  , ( Text
"สองร้อยยี่สิบหนึ่ง", Integer
221 )
  , ( Text
"สองร้อยยี่สิบสอง", Integer
222 )
  , ( Text
"สองร้อยยี่สิบสาม", Integer
223 )
  , ( Text
"สองร้อยยี่สิบสี่", Integer
224 )
  , ( Text
"สองร้อยยี่สิบห้า", Integer
225 )
  , ( Text
"สองร้อยยี่สิบหก", Integer
226 )
  , ( Text
"สองร้อยยี่สิบเจ็ด", Integer
227 )
  , ( Text
"สองร้อยยี่สิบแปด", Integer
228 )
  , ( Text
"สองร้อยยี่สิบเก้า", Integer
229 )
  , ( Text
"สามร้อยยี่สิบ", Integer
320 )
  , ( Text
"สามร้อยยี่สิบเอ็ด", Integer
321 )
  , ( Text
"สามร้อยยี่สิบหนึ่ง", Integer
321 )
  , ( Text
"สามร้อยยี่สิบสอง", Integer
322 )
  , ( Text
"สามร้อยยี่สิบสาม", Integer
323 )
  , ( Text
"สามร้อยยี่สิบสี่", Integer
324 )
  , ( Text
"สามร้อยยี่สิบห้า", Integer
325 )
  , ( Text
"สามร้อยยี่สิบหก", Integer
326 )
  , ( Text
"สามร้อยยี่สิบเจ็ด", Integer
327 )
  , ( Text
"สามร้อยยี่สิบแปด", Integer
328 )
  , ( Text
"สามร้อยยี่สิบเก้า", Integer
329 )
  , ( Text
"สี่ร้อยยี่สิบ", Integer
420 )
  , ( Text
"สี่ร้อยยี่สิบเอ็ด", Integer
421 )
  , ( Text
"สี่ร้อยยี่สิบหนึ่ง", Integer
421 )
  , ( Text
"สี่ร้อยยี่สิบสอง", Integer
422 )
  , ( Text
"สี่ร้อยยี่สิบสาม", Integer
423 )
  , ( Text
"สี่ร้อยยี่สิบสี่", Integer
424 )
  , ( Text
"สี่ร้อยยี่สิบห้า", Integer
425 )
  , ( Text
"สี่ร้อยยี่สิบหก", Integer
426 )
  , ( Text
"สี่ร้อยยี่สิบเจ็ด", Integer
427 )
  , ( Text
"สี่ร้อยยี่สิบแปด", Integer
428 )
  , ( Text
"สี่ร้อยยี่สิบเก้า", Integer
429 )
  , ( Text
"ห้าร้อยยี่สิบ", Integer
520 )
  , ( Text
"ห้าร้อยยี่สิบเอ็ด", Integer
521 )
  , ( Text
"ห้าร้อยยี่สิบหนึ่ง", Integer
521 )
  , ( Text
"ห้าร้อยยี่สิบสอง", Integer
522 )
  , ( Text
"ห้าร้อยยี่สิบสาม", Integer
523 )
  , ( Text
"ห้าร้อยยี่สิบสี่", Integer
524 )
  , ( Text
"ห้าร้อยยี่สิบห้า", Integer
525 )
  , ( Text
"ห้าร้อยยี่สิบหก", Integer
526 )
  , ( Text
"ห้าร้อยยี่สิบเจ็ด", Integer
527 )
  , ( Text
"ห้าร้อยยี่สิบแปด", Integer
528 )
  , ( Text
"ห้าร้อยยี่สิบเก้า", Integer
529 )
  , ( Text
"หกร้อยยี่สิบ", Integer
620 )
  , ( Text
"หกร้อยยี่สิบเอ็ด", Integer
621 )
  , ( Text
"หกร้อยยี่สิบหนึ่ง", Integer
621 )
  , ( Text
"หกร้อยยี่สิบสอง", Integer
622 )
  , ( Text
"หกร้อยยี่สิบสาม", Integer
623 )
  , ( Text
"หกร้อยยี่สิบสี่", Integer
624 )
  , ( Text
"หกร้อยยี่สิบห้า", Integer
625 )
  , ( Text
"หกร้อยยี่สิบหก", Integer
626 )
  , ( Text
"หกร้อยยี่สิบเจ็ด", Integer
627 )
  , ( Text
"หกร้อยยี่สิบแปด", Integer
628 )
  , ( Text
"หกร้อยยี่สิบเก้า", Integer
629 )
  , ( Text
"เจ็ดร้อยยี่สิบ", Integer
720 )
  , ( Text
"เจ็ดร้อยยี่สิบเอ็ด", Integer
721 )
  , ( Text
"เจ็ดร้อยยี่สิบหนึ่ง", Integer
721 )
  , ( Text
"เจ็ดร้อยยี่สิบสอง", Integer
722 )
  , ( Text
"เจ็ดร้อยยี่สิบสาม", Integer
723 )
  , ( Text
"เจ็ดร้อยยี่สิบสี่", Integer
724 )
  , ( Text
"เจ็ดร้อยยี่สิบห้า", Integer
725 )
  , ( Text
"เจ็ดร้อยยี่สิบหก", Integer
726 )
  , ( Text
"เจ็ดร้อยยี่สิบเจ็ด", Integer
727 )
  , ( Text
"เจ็ดร้อยยี่สิบแปด", Integer
728 )
  , ( Text
"เจ็ดร้อยยี่สิบเก้า", Integer
729 )
  , ( Text
"แปดร้อยยี่สิบ", Integer
820 )
  , ( Text
"แปดร้อยยี่สิบเอ็ด", Integer
821 )
  , ( Text
"แปดร้อยยี่สิบหนึ่ง", Integer
821 )
  , ( Text
"แปดร้อยยี่สิบสอง", Integer
822 )
  , ( Text
"แปดร้อยยี่สิบสาม", Integer
823 )
  , ( Text
"แปดร้อยยี่สิบสี่", Integer
824 )
  , ( Text
"แปดร้อยยี่สิบห้า", Integer
825 )
  , ( Text
"แปดร้อยยี่สิบหก", Integer
826 )
  , ( Text
"แปดร้อยยี่สิบเจ็ด", Integer
827 )
  , ( Text
"แปดร้อยยี่สิบแปด", Integer
828 )
  , ( Text
"แปดร้อยยี่สิบเก้า", Integer
829 )
  , ( Text
"เก้าร้อยยี่สิบ", Integer
920 )
  , ( Text
"เก้าร้อยยี่สิบเอ็ด", Integer
921 )
  , ( Text
"เก้าร้อยยี่สิบหนึ่ง", Integer
921 )
  , ( Text
"เก้าร้อยยี่สิบสอง", Integer
922 )
  , ( Text
"เก้าร้อยยี่สิบสาม", Integer
923 )
  , ( Text
"เก้าร้อยยี่สิบสี่", Integer
924 )
  , ( Text
"เก้าร้อยยี่สิบห้า", Integer
925 )
  , ( Text
"เก้าร้อยยี่สิบหก", Integer
926 )
  , ( Text
"เก้าร้อยยี่สิบเจ็ด", Integer
927 )
  , ( Text
"เก้าร้อยยี่สิบแปด", Integer
928 )
  , ( Text
"เก้าร้อยยี่สิบเก้า", Integer
929 )
  ]

ruleXHundredTwentyToXHundredTwentyNine :: Rule
ruleXHundredTwentyToXHundredTwentyNine :: Rule
ruleXHundredTwentyToXHundredTwentyNine = HashMap Text Integer -> Text -> (Integer -> Maybe Token) -> Rule
forall a. HashMap Text a -> Text -> (a -> Maybe Token) -> Rule
singleStringLookupRule
  HashMap Text Integer
digitsHundredTwentyToTwentyNineMap Text
"integer (x20,x21,...,x29)" Integer -> Maybe Token
integer

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 = \case
      (Token Dimension a
RegexMatch (GroupMatch (match : _)) : [Token]
_) ->
        case Text -> Text
Text.toLower Text
match of
          Text
"ร้อย" -> 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
"พัน" -> 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
"หมื่น" -> Double -> Maybe Token
double Double
1e4 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
4 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
1e5 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
5 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
1e7 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
7 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
1e8 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
8 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
"[\\s\\-]+"
    , Double -> Double -> PatternItem
numberBetween Double
1 Double
10
    ]
  , prod :: Production
prod = \case
      (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
  }

ruleSumTenDigits :: Rule
ruleSumTenDigits :: Rule
ruleSumTenDigits = Rule :: Text -> Pattern -> Production -> Rule
Rule
  { name :: Text
name = Text
"สามสิบสี่"
  , pattern :: Pattern
pattern =
    [ String -> PatternItem
regex String
"(ยี่สิบ|สามสิบ|สี่สิบ|ห้าสิบ|หกสิบ|เจ็ดสิบ|แปดสิบ|เก้าสิบ)"
    , String -> PatternItem
regex String
"(หนึ่ง|เอ็ด|สอง|สาม|สี่|ห้า|หก|เจ็ด|แปด|เก้า|สิบ)"
    ]
  , prod :: Production
prod = \case
      (Token Dimension a
RegexMatch (GroupMatch (m1:_)):
       Token Dimension a
RegexMatch (GroupMatch (m2:_)):
       [Token]
_) -> do
       let x1 :: Text
x1 = Text -> Text
Text.toLower Text
m1
       let x2 :: Text
x2 = Text -> Text
Text.toLower Text
m2
       Integer
hundreds <- Text -> HashMap Text Integer -> Maybe Integer
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HashMap.lookup Text
x1 HashMap Text Integer
tensMap
       Integer
rest <- Text -> HashMap Text Integer -> Maybe Integer
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HashMap.lookup Text
x2 HashMap Text Integer
zeroNineteenMap
       Integer -> Maybe Token
integer (Integer
hundreds Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Integer
rest)
      [Token]
_ -> Maybe Token
forall a. Maybe a
Nothing
  }

ruleSkipHundreds1 :: Rule
ruleSkipHundreds1 :: Rule
ruleSkipHundreds1 = Rule :: Text -> Pattern -> Production -> Rule
Rule
  { name :: Text
name = Text
"one eleven"
  , pattern :: Pattern
pattern =
    [ String -> PatternItem
regex String
"(หนึ่ง|สอง|สาม|สี่|ห้า|หก|เจ็ด|แปด|เก้า)"
    , String -> PatternItem
regex String
"(สิบ|สิบเอ็ด|สิบสอง|สิบสาม|สิบสี่|สิบห้า|สิบหก|สิบเจ็ด|สิบแปด|สิบเก้า|ยี่สิบ|สามสิบ|สี่สิบ|ห้าสิบ|หกสิบ|เจ็ดสิบ|แปดสิบ|เก้าสิบ)"
    ]
  , prod :: Production
prod = \case
      (Token Dimension a
RegexMatch (GroupMatch (m1:_)):
       Token Dimension a
RegexMatch (GroupMatch (m2:_)):
       [Token]
_) -> do
       let x1 :: Text
x1 = Text -> Text
Text.toLower Text
m1
       let x2 :: Text
x2 = Text -> Text
Text.toLower Text
m2
       Integer
hundreds <- Text -> HashMap Text Integer -> Maybe Integer
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HashMap.lookup Text
x1 HashMap Text Integer
zeroNineteenMap
       Integer
rest <- Text -> HashMap Text Integer -> Maybe Integer
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HashMap.lookup Text
x2 HashMap Text Integer
zeroNineteenMap Maybe Integer -> Maybe Integer -> Maybe Integer
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
x2 HashMap Text Integer
tensMap
       Integer -> Maybe Token
integer (Integer
hundreds Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer
100 Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Integer
rest)
      [Token]
_ -> Maybe Token
forall a. Maybe a
Nothing
  }

ruleSkipHundreds2 :: Rule
ruleSkipHundreds2 :: Rule
ruleSkipHundreds2 = Rule :: Text -> Pattern -> Production -> Rule
Rule
  { name :: Text
name = Text
"one twenty two"
  , pattern :: Pattern
pattern =
    [ String -> PatternItem
regex String
"(หนึ่ง|สอง|สาม|สี่|ห้า|หก|เจ็ด|แปด|เก้า)"
    , String -> PatternItem
regex String
"(ยี่สิบ|สามสิบ|สี่สิบ|ห้าสิบ|หกสิบ|เจ็ดสิบ|แปดสิบ|เก้าสิบ)"
    , String -> PatternItem
regex String
"(หนึ่ง|สอง|สาม|สี่|ห้า|หก|เจ็ด|แปด|เก้า)"
    ]
  , prod :: Production
prod = \case
      (Token Dimension a
RegexMatch (GroupMatch (m1:_)):
       Token Dimension a
RegexMatch (GroupMatch (m2:_)):
       Token Dimension a
RegexMatch (GroupMatch (m3:_)):
       [Token]
_) -> do
       let x1 :: Text
x1 = Text -> Text
Text.toLower Text
m1
       let x2 :: Text
x2 = Text -> Text
Text.toLower Text
m2
       let x3 :: Text
x3 = Text -> Text
Text.toLower Text
m3
       Integer
hundreds <- Text -> HashMap Text Integer -> Maybe Integer
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HashMap.lookup Text
x1 HashMap Text Integer
zeroNineteenMap
       Integer
tens <- Text -> HashMap Text Integer -> Maybe Integer
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HashMap.lookup Text
x2 HashMap Text Integer
tensMap
       Integer
rest <- Text -> HashMap Text Integer -> Maybe Integer
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HashMap.lookup Text
x3 HashMap Text Integer
zeroNineteenMap
       Integer -> Maybe Token
integer (Integer
hundreds Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer
100 Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Integer
tens Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Integer
rest)
      [Token]
_ -> Maybe Token
forall a. Maybe a
Nothing
  }

ruleDotSpelledOut :: Rule
ruleDotSpelledOut :: Rule
ruleDotSpelledOut = Rule :: Text -> Pattern -> Production -> Rule
Rule
  { name :: Text
name = Text
"one point 2"
  , pattern :: Pattern
pattern =
    [ Dimension NumeralData -> PatternItem
forall a. Typeable a => Dimension a -> PatternItem
dimension Dimension NumeralData
Numeral
    , String -> PatternItem
regex String
"จุด"
    , 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 = \case
      (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
  }

ruleLeadingDotSpelledOut :: Rule
ruleLeadingDotSpelledOut :: Rule
ruleLeadingDotSpelledOut = Rule :: Text -> Pattern -> Production -> Rule
Rule
  { name :: Text
name = Text
"point 77"
  , pattern :: Pattern
pattern =
    [ String -> PatternItem
regex String
"จุด"
    , 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 = \case
      (Token
_:Token Dimension a
Numeral a
nd:[Token]
_) -> Double -> Maybe Token
double (Double -> Maybe Token) -> Double -> Maybe Token
forall a b. (a -> b) -> a -> b
$ Double -> Double
decimalsToDouble (Double -> Double) -> Double -> Double
forall a b. (a -> b) -> a -> b
$ NumeralData -> Double
TNumeral.value a
NumeralData
nd
      [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
True Text
match
      [Token]
_ -> Maybe Token
forall a. Maybe a
Nothing
  }

ruleCommas :: Rule
ruleCommas :: Rule
ruleCommas = Rule :: Text -> Pattern -> Production -> Rule
Rule
  { name :: Text
name = Text
"comma-separated numbers"
  , pattern :: Pattern
pattern =
    [ String -> PatternItem
regex String
"(\\d+(,\\d\\d\\d)+(\\.\\d+)?)"
    ]
  , prod :: Production
prod = \case
      (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
  }

ruleSuffixes :: Rule
ruleSuffixes :: Rule
ruleSuffixes = Rule :: Text -> Pattern -> Production -> Rule
Rule
  { name :: Text
name = Text
"suffixes (กิโลกรัม,กรัม))"
  , pattern :: Pattern
pattern =
    [ Dimension NumeralData -> PatternItem
forall a. Typeable a => Dimension a -> PatternItem
dimension Dimension NumeralData
Numeral
    , String -> PatternItem
regex String
"(กิโลกรัม|กรัม)(?=[\\W$€¢£]|$)"
    ]
  , prod :: Production
prod = \case
      (Token Dimension a
Numeral a
nd : Token Dimension a
RegexMatch (GroupMatch (match : _)):[Token]
_) -> do
        Double
x <- case Text -> Text
Text.toLower Text
match of
          Text
"กิโลกรัม" -> Double -> Maybe Double
forall a. a -> Maybe a
Just Double
1e3
          Text
"กรัม" -> Double -> Maybe Double
forall a. a -> Maybe a
Just Double
1e1
          Text
_ -> Maybe Double
forall a. Maybe a
Nothing
        Double -> Maybe Token
double (Double -> Maybe Token) -> Double -> Maybe Token
forall a b. (a -> b) -> a -> b
$ NumeralData -> Double
TNumeral.value a
NumeralData
nd Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
x
      [Token]
_ -> Maybe Token
forall a. Maybe a
Nothing
  }

ruleNegative :: Rule
ruleNegative :: Rule
ruleNegative = Rule :: Text -> Pattern -> Production -> Rule
Rule
  { name :: Text
name = Text
"negative numbers"
  , pattern :: Pattern
pattern =
    [ String -> PatternItem
regex String
"(-|ลบ)(?!\\s*-)"
    , Predicate -> PatternItem
Predicate Predicate
isPositive
    ]
  , prod :: Production
prod = \case
      (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
  }

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
  }

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 = \case
      (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 = \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
ruleXHundredTwentyToXHundredTwentyNine
  , Rule
ruleSkipHundreds1
  , Rule
ruleSkipHundreds2
  , Rule
ruleToNineteen
  , Rule
ruleTens
  , Rule
rulePowersOfTen
  , Rule
ruleCompositeTens
  , Rule
ruleSumTenDigits
  , Rule
ruleDotSpelledOut
  , Rule
ruleLeadingDotSpelledOut
  , Rule
ruleDecimals
  , Rule
ruleCommas
  , Rule
ruleSuffixes
  , Rule
ruleNegative
  , Rule
ruleSum
  , Rule
ruleSumAnd
  , Rule
ruleMultiply
  , Rule
ruleDozen
  ]