-- 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.Ordinal.SV.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

ordinalsMap :: HashMap Text Int
ordinalsMap :: HashMap Text Int
ordinalsMap = [(Text, Int)] -> HashMap Text Int
forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
HashMap.fromList
  [ ( Text
"första", Int
1 )
  , ( Text
"förste", Int
1 )
  , ( Text
"andra", Int
2 )
  , ( Text
"andre", Int
2)
  , ( Text
"tredje", Int
3 )
  , ( Text
"fjärde", Int
4 )
  , ( Text
"femte", Int
5 )
  , ( Text
"sjätte", Int
6 )
  , ( Text
"sjunde", Int
7 )
  , ( Text
"åttonde", Int
8 )
  , ( Text
"nionde", Int
9 )
  , ( Text
"tionde", Int
10 )
  , ( Text
"elfte", Int
11 )
  , ( Text
"tolfte", Int
12 )
  , ( Text
"trettonde", Int
13 )
  , ( Text
"fjortonde", Int
14 )
  , ( Text
"femtonde", Int
15 )
  , ( Text
"sextonde", Int
16 )
  , ( Text
"sjuttonde", Int
17 )
  , ( Text
"artonde", Int
18 )
  , ( Text
"nittonde", Int
19 )
  , ( Text
"tjugonde", Int
20 )
  , ( Text
"trettionde", Int
30 )
  , ( Text
"fyrtionde", Int
40 )
  , ( Text
"femtionde", Int
50 )
  , ( Text
"sextionde", Int
60 )
  , ( Text
"sjuttionde", Int
70 )
  , ( Text
"åttionde", Int
80 )
  , ( Text
"nittionde", Int
90 )
  ]

cardinalsMap :: HashMap Text Int
cardinalsMap :: HashMap Text Int
cardinalsMap = [(Text, Int)] -> HashMap Text Int
forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
HashMap.fromList
  [ ( Text
"tjugo", Int
20 )
  , ( Text
"trettio", Int
30 )
  , ( Text
"fyrtio", Int
40 )
  , ( Text
"femtio", Int
50 )
  , ( Text
"sextio", Int
60 )
  , ( Text
"sjuttio", Int
70 )
  , ( Text
"åttio", Int
80 )
  , ( Text
"nittio", Int
90 )
  ]

ruleOrdinals :: Rule
ruleOrdinals :: Rule
ruleOrdinals = Rule :: Text -> Pattern -> Production -> Rule
Rule
  { name :: Text
name = Text
"ordinals (first..twentieth,thirtieth,...)"
  , pattern :: Pattern
pattern =
    [ String -> PatternItem
regex String
"(första|förste|andra|andre|tredje|fjärde|femte|sjätte|sjunde|åttonde|nionde|tionde|elfte|tolfte|trettionde|fjortonde|femtonde|sextonde|sjuttonde|artonde|nittonde|tjugonde|trettionde|fyrtionde|femtonde|sextionde|sjuttionde|åttionde|nittionde)"
    ]
  , prod :: Production
prod = \[Token]
tokens -> case [Token]
tokens of
      (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
ordinalsMap
      [Token]
_ -> Maybe Token
forall a. Maybe a
Nothing
    }

ruleCompositeOrdinals :: Rule
ruleCompositeOrdinals :: Rule
ruleCompositeOrdinals = Rule :: Text -> Pattern -> Production -> Rule
Rule
  { name :: Text
name = Text
"ordinals (composite, e.g., eighty-seven)"
  , pattern :: Pattern
pattern =
    [ String -> PatternItem
regex String
"(tjugo|trettio|fyrtio|femtio|sextio|sjuttio|åttio|nittio)(första|förste|andra|andre|tredje|fjärde|femte|sjätte|sjunde|åttonde|nionde)"
    ]
  , prod :: Production
prod = \[Token]
tokens -> case [Token]
tokens of
      (Token Dimension a
RegexMatch (GroupMatch (tens:units:_)):[Token]
_) -> do
        Int
tt <- 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
tens) HashMap Text Int
cardinalsMap
        Int
uu <- 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
units) HashMap Text Int
ordinalsMap
        Token -> Maybe Token
forall a. a -> Maybe a
Just (Token -> Maybe Token) -> (Int -> Token) -> Int -> Maybe Token
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Token
ordinal (Int -> Maybe Token) -> Int -> Maybe Token
forall a b. (a -> b) -> a -> b
$ Int
tt Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
uu
      [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+):?(a|e)"
    ]
  , prod :: Production
prod = \[Token]
tokens -> case [Token]
tokens of
      (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
ruleOrdinals
  , Rule
ruleCompositeOrdinals
  , Rule
ruleOrdinalDigits
  ]