-- 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.DA.Rules
  ( rules ) where


import Data.HashMap.Strict (HashMap)
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, numberWith)
import Duckling.Numeral.Types (NumeralData (..), getIntValue)
import Duckling.Ordinal.Helpers
import Duckling.Ordinal.Types (OrdinalData (..))
import Duckling.Regex.Types
import Duckling.Types
import qualified Duckling.Numeral.Types as TNumeral

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ørste", Int
1 )
  , ( Text
"anden", Int
2 )
  , ( Text
"tredje", Int
3 )
  , ( Text
"fjerde", Int
4 )
  , ( Text
"femte", Int
5 )
  , ( Text
"sjette", Int
6 )
  , ( Text
"syvende", Int
7 )
  , ( Text
"ottende", Int
8 )
  , ( Text
"niende", Int
9 )
  , ( Text
"tiende", Int
10 )
  , ( Text
"elfte", Int
11 )
  , ( Text
"tolvte", Int
12 )
  , ( Text
"trettende", Int
13 )
  , ( Text
"fjortende", Int
14 )
  , ( Text
"femtende", Int
15 )
  , ( Text
"sekstende", Int
16 )
  , ( Text
"syttende", Int
17 )
  , ( Text
"attende", Int
18 )
  , ( Text
"nittende", Int
19 )
  , ( Text
"tyvende", Int
20 )
  , ( Text
"tenogtyvende", Int
21 )
  , ( Text
"toogtyvende", Int
22 )
  , ( Text
"treogtyvende", Int
23 )
  , ( Text
"fireogtyvende", Int
24 )
  , ( Text
"femogtyvende", Int
25 )
  , ( Text
"seksogtyvende", Int
26 )
  , ( Text
"syvogtyvende", Int
27 )
  , ( Text
"otteogtyvende", Int
28 )
  , ( Text
"niogtyvende", Int
29 )
  , ( Text
"tredivte", Int
30 )
  , ( Text
"enogtredivte", Int
31 )
  ]

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
"tyvende", Int
20 )
  , ( Text
"tredivte", Int
30 )
  , ( Text
"fyrrende", Int
40 )
  , ( Text
"fyrretyvende", Int
40 )
  , ( Text
"halvtredsende", Int
50 )
  , ( Text
"halvtredsindstyvende", Int
50 )
  , ( Text
"tressende", Int
60 )
  , ( Text
"tresindstyvende", Int
60 )
  , ( Text
"halvfjerdsende", Int
70 )
  , ( Text
"halvfjerdsindstyvende", Int
70 )
  , ( Text
"firsende", Int
80 )
  , ( Text
"firsindsstyvende", Int
80 )
  , ( Text
"halvfemsende", Int
90 )
  , ( Text
"halvfemsindstyvende", Int
90 )
  ]

oneValMap :: HashMap Text Int
oneValMap :: HashMap Text Int
oneValMap = [(Text, Int)] -> HashMap Text Int
forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
HashMap.fromList
  [ ( Text
"", Int
0 )
  , ( Text
"enog", Int
1 )
  , ( Text
"toog", Int
2 )
  , ( Text
"treog", Int
3 )
  , ( Text
"fireog", Int
4 )
  , ( Text
"femog", Int
5 )
  , ( Text
"seksog", Int
6 )
  , ( Text
"syvog", Int
7 )
  , ( Text
"otteog", Int
8 )
  , ( Text
"niog", Int
9 )
  ]

ruleOrdinalsFirstst :: Rule
ruleOrdinalsFirstst :: Rule
ruleOrdinalsFirstst = Rule :: Text -> Pattern -> Production -> Rule
Rule
  { name :: Text
name = Text
"ordinals (first..19st)"
  , pattern :: Pattern
pattern =
    [ String -> PatternItem
regex String
"(første|anden|tredje|fjerde|femte|sjette|syvende|ottende|niende|tiende|elfte|tolvte|trettende|fjortende|femtende|sekstende|syttende|attende|nittende)"
    ]
  , 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
  }

ruleSpelledOutOrdinals :: Rule
ruleSpelledOutOrdinals :: Rule
ruleSpelledOutOrdinals = Rule :: Text -> Pattern -> Production -> Rule
Rule
  { name :: Text
name = Text
"ordinals, 20 to 99, spelled-out"
  , pattern :: Pattern
pattern =
    [ String -> PatternItem
regex ([String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [String
"((?:en|to|tre|fire|fem|seks|syv|otte|ni)og)?",
                     String
"(tyvende",
                     String
"|tredivte",
                     String
"|fyrr(?:etyv)?ende",
                     String
"|halvtreds(?:indstyv)?ende",
                     String
"|tres(?:indstyv|s)?ende",
                     String
"|halvfjerds(?:indstyv)?ende",
                     String
"|firs(?:indstyv)?ende",
                     String
"|halvfems(?:indstyv)?ende)"])
    ]
  , prod :: Production
prod = \case
    (Token Dimension a
RegexMatch (GroupMatch (ones:tens:_)):[Token]
_) -> do
      Int
oneVal <- 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
ones) HashMap Text Int
oneValMap
      Int
tenVal <- 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
      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
oneVal Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
tenVal)
    [Token]
_ -> Maybe Token
forall a. Maybe a
Nothing

  }

ruleSpelledOutBigOrdinals :: Rule
ruleSpelledOutBigOrdinals :: Rule
ruleSpelledOutBigOrdinals = Rule :: Text -> Pattern -> Production -> Rule
Rule
  { name :: Text
name = Text
"ordinals, above 99, spelled out"
  , pattern :: Pattern
pattern =
    [ (NumeralData -> Double) -> (Double -> Bool) -> PatternItem
forall t. (NumeralData -> t) -> (t -> Bool) -> PatternItem
numberWith NumeralData -> Double
TNumeral.value (Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
> Double
99)
    , String -> PatternItem
regex String
"og"
    , Dimension OrdinalData -> PatternItem
forall a. Typeable a => Dimension a -> PatternItem
dimension Dimension OrdinalData
Ordinal
    ]
  , prod :: Production
prod = \case
      Token Dimension a
Numeral NumeralData {TNumeral.value=maybenumnum}:Token
_:Token Dimension a
Ordinal (OrdinalData ordnum):[Token]
_ ->
            case Double -> Maybe Int
getIntValue Double
maybenumnum of
              Just Int
numnum -> 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
numnum Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
ordnum)
              Maybe Int
Nothing -> Maybe Token
forall a. Maybe a
Nothing
      [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+)(\\.|ste?)"
    ]
  , prod :: Production
prod = \[Token]
tokens -> case [Token]
tokens of
      (Token Dimension a
RegexMatch (GroupMatch (match:_)):[Token]
_) -> do
        Int
v <- Text -> Maybe Int
parseInt Text
match
        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
v
      [Token]
_ -> Maybe Token
forall a. Maybe a
Nothing
  }

rules :: [Rule]
rules :: [Rule]
rules =
  [ Rule
ruleOrdinalDigits
  , Rule
ruleOrdinalsFirstst
  , Rule
ruleSpelledOutOrdinals
  , Rule
ruleSpelledOutBigOrdinals
  ]