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

module Duckling.Duration.EL.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.Duration.Helpers
import Duckling.Duration.Types (DurationData (DurationData))
import Duckling.Numeral.Helpers (integer, numeralMapEL, parseInt, parseInteger)
import Duckling.Numeral.Types (NumeralData(..))
import Duckling.Regex.Types
import Duckling.Types
import qualified Duckling.Numeral.Types as TNumeral
import qualified Duckling.TimeGrain.Types as TG

timeGrainMap :: HashMap Text TG.Grain
timeGrainMap :: HashMap Text Grain
timeGrainMap = [(Text, Grain)] -> HashMap Text Grain
forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
HashMap.fromList
  [ ( Text
"λεπτο" , Grain
TG.Minute )
  , ( Text
"ωρο"   , Grain
TG.Hour   )
  , ( Text
"μερο"  , Grain
TG.Day    )
  , ( Text
"ήμερο" , Grain
TG.Day    )
  , ( Text
"μηνο"  , Grain
TG.Month  )
  , ( Text
"ετία"  , Grain
TG.Year   )
  , ( Text
"ετίας" , Grain
TG.Year   )
  , ( Text
"ετή"   , Grain
TG.Year   )
  , ( Text
"ετέ"   , Grain
TG.Year   )
  , ( Text
"χρονο" , Grain
TG.Year   )
  ]

ruleDurationQuarterOfAnHour :: Rule
ruleDurationQuarterOfAnHour :: Rule
ruleDurationQuarterOfAnHour = Rule :: Text -> Pattern -> Production -> Rule
Rule
  { name :: Text
name = Text
"quarter of an hour"
  , pattern :: Pattern
pattern =
    [ String -> PatternItem
regex String
"(1/4|[εέ]ν(α|ός)\\s+τ[εέ]τ[αά]ρτου?)(\\s*ω|\\s+(της\\s+)?ώρας)?"
    ]
  , prod :: Production
prod = \[Token]
_ -> Token -> Maybe Token
forall a. a -> Maybe a
Just (Token -> Maybe Token)
-> (DurationData -> Token) -> DurationData -> Maybe Token
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Dimension DurationData -> DurationData -> Token
forall a.
(Resolve a, Eq a, Hashable a, Show a, NFData a) =>
Dimension a -> a -> Token
Token Dimension DurationData
Duration (DurationData -> Maybe Token) -> DurationData -> Maybe Token
forall a b. (a -> b) -> a -> b
$ Grain -> Int -> DurationData
duration Grain
TG.Minute Int
15
  }

ruleDurationHalfAnHour :: Rule
ruleDurationHalfAnHour :: Rule
ruleDurationHalfAnHour = Rule :: Text -> Pattern -> Production -> Rule
Rule
  { name :: Text
name = Text
"half an hour"
  , pattern :: Pattern
pattern =
    [ String -> PatternItem
regex String
"(1/2\\s?((της )?ώρας?|ω)|μισάωρου?)"
    ]
  , prod :: Production
prod = \[Token]
_ -> Token -> Maybe Token
forall a. a -> Maybe a
Just (Token -> Maybe Token)
-> (DurationData -> Token) -> DurationData -> Maybe Token
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Dimension DurationData -> DurationData -> Token
forall a.
(Resolve a, Eq a, Hashable a, Show a, NFData a) =>
Dimension a -> a -> Token
Token Dimension DurationData
Duration (DurationData -> Maybe Token) -> DurationData -> Maybe Token
forall a b. (a -> b) -> a -> b
$ Grain -> Int -> DurationData
duration Grain
TG.Minute Int
30
  }

ruleDurationThreeQuartersOfAnHour :: Rule
ruleDurationThreeQuartersOfAnHour :: Rule
ruleDurationThreeQuartersOfAnHour = Rule :: Text -> Pattern -> Production -> Rule
Rule
  { name :: Text
name = Text
"three quarters of an hour"
  , pattern :: Pattern
pattern =
    [ String -> PatternItem
regex String
"(3/4|τρ[ιί](α|ών)\\s+τ[εέ]τ[αά]ρτ(α|ων))(\\s*ω|\\s+(της\\s+)?ώρας)?"
    ]
  , prod :: Production
prod = \[Token]
_ -> Token -> Maybe Token
forall a. a -> Maybe a
Just (Token -> Maybe Token)
-> (DurationData -> Token) -> DurationData -> Maybe Token
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Dimension DurationData -> DurationData -> Token
forall a.
(Resolve a, Eq a, Hashable a, Show a, NFData a) =>
Dimension a -> a -> Token
Token Dimension DurationData
Duration (DurationData -> Maybe Token) -> DurationData -> Maybe Token
forall a b. (a -> b) -> a -> b
$ Grain -> Int -> DurationData
duration Grain
TG.Minute Int
45
  }

-- TODO: Single-word composition (#110)
ruleNumeralWithGrain :: Rule
ruleNumeralWithGrain :: Rule
ruleNumeralWithGrain = Rule :: Text -> Pattern -> Production -> Rule
Rule
  { name :: Text
name = Text
"<number><grain> (one word)"
  , pattern :: Pattern
pattern =
    [ String -> PatternItem
regex (String -> PatternItem) -> String -> PatternItem
forall a b. (a -> b) -> a -> b
$ String
"(δ[ιί]|τρ[ιί]|τετρ|πεν[θτ]|εξ|ε[πφ]τ|ο[κχ]τ|εννι|δεκ|"
           String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"δεκαπεν[θτ]|εικοσ|εικοσιπεν[θτ]|τριαντ|τριανταπεν[θτ]|σαραντ|"
           String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"σαρανταπεν[θτ]|πενηντ|πενηνταπεν[θτ]|εξηντ|ενενηντ)[αά]?"
           String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"(λεπτο|ωρο|ή?μερο|μηνο|ετία?|ετ[ήέ]|χρονο)ς?υ?"
    ]
  , prod :: Production
prod = \[Token]
tokens -> case [Token]
tokens of
      ( Token Dimension a
RegexMatch (GroupMatch (m:g:_)) : [Token]
_ ) ->
        (Dimension DurationData -> DurationData -> Token
forall a.
(Resolve a, Eq a, Hashable a, Show a, NFData a) =>
Dimension a -> a -> Token
Token Dimension DurationData
Duration (DurationData -> Token) -> (Int -> DurationData) -> Int -> Token
forall b c a. (b -> c) -> (a -> b) -> a -> c
.) ((Int -> DurationData) -> Int -> Token)
-> (Grain -> Int -> DurationData) -> Grain -> Int -> Token
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Grain -> Int -> DurationData
duration
          (Grain -> Int -> Token) -> Maybe Grain -> Maybe (Int -> Token)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> HashMap Text Grain -> Maybe Grain
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HashMap.lookup (Text -> Text
Text.toLower Text
g) HashMap Text Grain
timeGrainMap
          Maybe (Int -> Token) -> Maybe Int -> Maybe Token
forall (f :: * -> *) a b. Applicative f => 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
m) HashMap Text Int
numeralMapEL
      [Token]
_ -> Maybe Token
forall a. Maybe a
Nothing
  }

ruleNumeralQuotes :: Rule
ruleNumeralQuotes :: Rule
ruleNumeralQuotes = Rule :: Text -> Pattern -> Production -> Rule
Rule
  { name :: Text
name = Text
"<integer> + '\""
  , pattern :: Pattern
pattern =
    [ Predicate -> PatternItem
Predicate Predicate
isNatural
    , String -> PatternItem
regex String
"(['\"])"
    ]
  , prod :: Production
prod = \[Token]
tokens -> case [Token]
tokens of
      (Token Dimension a
Numeral NumeralData{TNumeral.value = v}:
       Token Dimension a
RegexMatch (GroupMatch (x:_)):
       [Token]
_) -> case Text
x of
         Text
"'"  -> 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
. Dimension DurationData -> DurationData -> Token
forall a.
(Resolve a, Eq a, Hashable a, Show a, NFData a) =>
Dimension a -> a -> Token
Token Dimension DurationData
Duration (DurationData -> Token) -> (Int -> DurationData) -> Int -> Token
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Grain -> Int -> DurationData
duration Grain
TG.Minute (Int -> Maybe Token) -> Int -> Maybe Token
forall a b. (a -> b) -> a -> b
$ Double -> Int
forall a b. (RealFrac a, Integral b) => a -> b
floor Double
v
         Text
"\"" -> 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
. Dimension DurationData -> DurationData -> Token
forall a.
(Resolve a, Eq a, Hashable a, Show a, NFData a) =>
Dimension a -> a -> Token
Token Dimension DurationData
Duration (DurationData -> Token) -> (Int -> DurationData) -> Int -> Token
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Grain -> Int -> DurationData
duration Grain
TG.Second (Int -> Maybe Token) -> Int -> Maybe Token
forall a b. (a -> b) -> a -> b
$ Double -> Int
forall a b. (RealFrac a, Integral b) => a -> b
floor Double
v
         Text
_    -> Maybe Token
forall a. Maybe a
Nothing
      [Token]
_ -> Maybe Token
forall a. Maybe a
Nothing
  }

ruleDurationMoreNumeral :: Rule
ruleDurationMoreNumeral :: Rule
ruleDurationMoreNumeral = Rule :: Text -> Pattern -> Production -> Rule
Rule
  { name :: Text
name = Text
"<integer> more <unit-of-duration>"
  , pattern :: Pattern
pattern =
    [ Predicate -> PatternItem
Predicate Predicate
isNatural
    , String -> PatternItem
regex String
"ακόμα|λιγότερ[οη]"
    , Dimension Grain -> PatternItem
forall a. Typeable a => Dimension a -> PatternItem
dimension Dimension Grain
TimeGrain
    ]
  , prod :: Production
prod = \[Token]
tokens -> case [Token]
tokens of
      (Token Dimension a
Numeral a
nd:Token
_:Token Dimension a
TimeGrain a
grain:[Token]
_) ->
        Token -> Maybe Token
forall a. a -> Maybe a
Just (Token -> Maybe Token)
-> (Double -> Token) -> Double -> Maybe Token
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Dimension DurationData -> DurationData -> Token
forall a.
(Resolve a, Eq a, Hashable a, Show a, NFData a) =>
Dimension a -> a -> Token
Token Dimension DurationData
Duration (DurationData -> Token)
-> (Double -> DurationData) -> Double -> Token
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Grain -> Int -> DurationData
duration a
Grain
grain (Int -> DurationData) -> (Double -> Int) -> Double -> DurationData
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Double -> Int
forall a b. (RealFrac a, Integral b) => a -> b
floor (Double -> Maybe Token) -> Double -> Maybe Token
forall a b. (a -> b) -> a -> b
$ NumeralData -> Double
TNumeral.value a
NumeralData
nd
      [Token]
_ -> Maybe Token
forall a. Maybe a
Nothing
  }

ruleDurationNumeralMore :: Rule
ruleDurationNumeralMore :: Rule
ruleDurationNumeralMore = Rule :: Text -> Pattern -> Production -> Rule
Rule
  { name :: Text
name = Text
"<integer> more <unit-of-duration>"
  , pattern :: Pattern
pattern =
    [ Predicate -> PatternItem
Predicate Predicate
isNatural
    , Dimension Grain -> PatternItem
forall a. Typeable a => Dimension a -> PatternItem
dimension Dimension Grain
TimeGrain
    , String -> PatternItem
regex String
"ακόμα|λιγότερ[οη]"
    ]
  , prod :: Production
prod = \[Token]
tokens -> case [Token]
tokens of
      (Token Dimension a
Numeral a
nd:Token Dimension a
TimeGrain a
grain:Token
_:[Token]
_) ->
        Token -> Maybe Token
forall a. a -> Maybe a
Just (Token -> Maybe Token)
-> (Double -> Token) -> Double -> Maybe Token
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Dimension DurationData -> DurationData -> Token
forall a.
(Resolve a, Eq a, Hashable a, Show a, NFData a) =>
Dimension a -> a -> Token
Token Dimension DurationData
Duration (DurationData -> Token)
-> (Double -> DurationData) -> Double -> Token
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Grain -> Int -> DurationData
duration a
Grain
grain (Int -> DurationData) -> (Double -> Int) -> Double -> DurationData
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Double -> Int
forall a b. (RealFrac a, Integral b) => a -> b
floor (Double -> Maybe Token) -> Double -> Maybe Token
forall a b. (a -> b) -> a -> b
$ NumeralData -> Double
TNumeral.value a
NumeralData
nd
      [Token]
_ -> Maybe Token
forall a. Maybe a
Nothing
  }

ruleDurationDotNumeralHours :: Rule
ruleDurationDotNumeralHours :: Rule
ruleDurationDotNumeralHours = Rule :: Text -> Pattern -> Production -> Rule
Rule
  { name :: Text
name = Text
"number.number hours"
  , pattern :: Pattern
pattern =
    [ String -> PatternItem
regex String
"(\\d+),(\\d+)"
    , Dimension Grain -> PatternItem
forall a. Typeable a => Dimension a -> PatternItem
dimension Dimension Grain
TimeGrain
    ]
  , prod :: Production
prod = \[Token]
tokens -> case [Token]
tokens of
      (Token Dimension a
RegexMatch (GroupMatch (h:m:_)):Token Dimension a
TimeGrain a
TG.Hour:[Token]
_) -> do
        Integer
hh <- Text -> Maybe Integer
parseInteger Text
h
        Integer
mnum <- Text -> Maybe Integer
parseInteger Text
m
        let mden :: Integer
mden = Integer
10 Integer -> Int -> Integer
forall a b. (Num a, Integral b) => a -> b -> a
^ Text -> Int
Text.length Text
m
        Token -> Maybe Token
forall a. a -> Maybe a
Just (Token -> Maybe Token)
-> (DurationData -> Token) -> DurationData -> Maybe Token
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Dimension DurationData -> DurationData -> Token
forall a.
(Resolve a, Eq a, Hashable a, Show a, NFData a) =>
Dimension a -> a -> Token
Token Dimension DurationData
Duration (DurationData -> Maybe Token) -> DurationData -> Maybe Token
forall a b. (a -> b) -> a -> b
$ Integer -> Integer -> Integer -> DurationData
minutesFromHourMixedFraction Integer
hh Integer
mnum Integer
mden
      [Token]
_ -> Maybe Token
forall a. Maybe a
Nothing
  }

ruleHalfDuration :: Rule
ruleHalfDuration :: Rule
ruleHalfDuration = Rule :: Text -> Pattern -> Production -> Rule
Rule
  { name :: Text
name = Text
"half a <grain>"
  , pattern :: Pattern
pattern =
    [ String -> PatternItem
regex String
"μισ[ήό]ς?"
    , Dimension Grain -> PatternItem
forall a. Typeable a => Dimension a -> PatternItem
dimension Dimension Grain
TimeGrain
    ]
  , prod :: Production
prod = \[Token]
tokens -> case [Token]
tokens of
      (Token
_:Token Dimension a
TimeGrain a
g:[Token]
_) -> Dimension DurationData -> DurationData -> Token
forall a.
(Resolve a, Eq a, Hashable a, Show a, NFData a) =>
Dimension a -> a -> Token
Token Dimension DurationData
Duration (DurationData -> Token) -> Maybe DurationData -> Maybe Token
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Grain -> Int -> Maybe DurationData
nPlusOneHalf a
Grain
g Int
0
      [Token]
_ -> Maybe Token
forall a. Maybe a
Nothing
  }

ruleDurationAndAHalf :: Rule
ruleDurationAndAHalf :: Rule
ruleDurationAndAHalf = Rule :: Text -> Pattern -> Production -> Rule
Rule
  { name :: Text
name = Text
"<integer> and a half <grain>"
  , pattern :: Pattern
pattern =
    [ Predicate -> PatternItem
Predicate Predicate
isNatural
    , String -> PatternItem
regex String
"και μισ[ήό]ς?"
    , Dimension Grain -> PatternItem
forall a. Typeable a => Dimension a -> PatternItem
dimension Dimension Grain
TimeGrain
    ]
  , prod :: Production
prod = \[Token]
tokens -> case [Token]
tokens of
      (Token Dimension a
Numeral a
nd:Token
_:Token Dimension a
TimeGrain a
grain:[Token]
_) ->
        Grain -> Int -> Maybe DurationData
nPlusOneHalf a
Grain
grain (Double -> Int
forall a b. (RealFrac a, Integral b) => a -> b
floor (Double -> Int) -> Double -> Int
forall a b. (a -> b) -> a -> b
$ NumeralData -> Double
TNumeral.value a
NumeralData
nd) Maybe DurationData -> (DurationData -> Maybe Token) -> Maybe Token
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=
        Token -> Maybe Token
forall a. a -> Maybe a
Just (Token -> Maybe Token)
-> (DurationData -> Token) -> DurationData -> Maybe Token
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Dimension DurationData -> DurationData -> Token
forall a.
(Resolve a, Eq a, Hashable a, Show a, NFData a) =>
Dimension a -> a -> Token
Token Dimension DurationData
Duration
      [Token]
_ -> Maybe Token
forall a. Maybe a
Nothing
  }

ruleDurationAndAHalfOneWord :: Rule
ruleDurationAndAHalfOneWord :: Rule
ruleDurationAndAHalfOneWord = Rule :: Text -> Pattern -> Production -> Rule
Rule
  { name :: Text
name = Text
"<integer-and-half> <grain>"
  , pattern :: Pattern
pattern =
    [ String -> PatternItem
regex (String -> PatternItem) -> String -> PatternItem
forall a b. (a -> b) -> a -> b
$ String
"(μιά|ενά|δυό|τρεισή|τεσσερι?σή|πεντέ|εξί|ε[πφ]τά|ο[κχ]τώ|εννιά|"
           String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"δεκά|εντεκά|δωδεκά)μισ[ιη]ς?"
    , Dimension Grain -> PatternItem
forall a. Typeable a => Dimension a -> PatternItem
dimension Dimension Grain
TimeGrain
    ]
  , prod :: Production
prod = \[Token]
tokens -> case [Token]
tokens of
      (Token Dimension a
RegexMatch (GroupMatch (num:_)):Token Dimension a
TimeGrain a
grain:[Token]
_) ->
        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
num) HashMap Text Int
numeralMapEL Maybe Int -> (Int -> Maybe DurationData) -> Maybe DurationData
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=
        Grain -> Int -> Maybe DurationData
nPlusOneHalf a
Grain
grain Maybe DurationData -> (DurationData -> Maybe Token) -> Maybe Token
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=
        Token -> Maybe Token
forall a. a -> Maybe a
Just (Token -> Maybe Token)
-> (DurationData -> Token) -> DurationData -> Maybe Token
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Dimension DurationData -> DurationData -> Token
forall a.
(Resolve a, Eq a, Hashable a, Show a, NFData a) =>
Dimension a -> a -> Token
Token Dimension DurationData
Duration
      [Token]
_ -> Maybe Token
forall a. Maybe a
Nothing
  }

ruleDurationPrecision :: Rule
ruleDurationPrecision :: Rule
ruleDurationPrecision = Rule :: Text -> Pattern -> Production -> Rule
Rule
  { name :: Text
name = Text
"about|exactly <duration>"
  , pattern :: Pattern
pattern =
    [ String -> PatternItem
regex String
"(περίπου|πάνω κάτω|ακριβώς)"
    , Dimension DurationData -> PatternItem
forall a. Typeable a => Dimension a -> PatternItem
dimension Dimension DurationData
Duration
    ]
    , prod :: Production
prod = \[Token]
tokens -> case [Token]
tokens of
        (Token
_:Token
token:[Token]
_) -> Token -> Maybe Token
forall a. a -> Maybe a
Just Token
token
        [Token]
_ -> Maybe Token
forall a. Maybe a
Nothing
  }

rules :: [Rule]
rules :: [Rule]
rules =
  [ Rule
ruleDurationQuarterOfAnHour
  , Rule
ruleDurationHalfAnHour
  , Rule
ruleNumeralQuotes
  , Rule
ruleDurationNumeralMore
  , Rule
ruleDurationMoreNumeral
  , Rule
ruleNumeralWithGrain
  , Rule
ruleDurationThreeQuartersOfAnHour
  , Rule
ruleDurationDotNumeralHours
  , Rule
ruleHalfDuration
  , Rule
ruleDurationAndAHalf
  , Rule
ruleDurationAndAHalfOneWord
  , Rule
ruleDurationPrecision
  ]