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

import Data.String
import Data.Text (Text)
import Prelude
import qualified Data.Text as Text

import Duckling.Dimensions.Types
import Duckling.Duration.Helpers
import Duckling.Numeral.Helpers (numberWith)
import Duckling.Numeral.Types (NumeralData(..), isInteger)
import Duckling.Duration.Types (DurationData (DurationData))
import Duckling.Regex.Types
import Duckling.Types
import Duckling.TimeGrain.Types
import qualified Duckling.Numeral.Types as TNumeral

ruleHalves :: Rule
ruleHalves :: Rule
ruleHalves = Rule :: Text -> Pattern -> Production -> Rule
Rule
  { name :: Text
name = Text
"half of a <time-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
grain:[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
grain Int
0
      [Token]
_ -> Maybe Token
forall a. Maybe a
Nothing
  }

ruleGrainAndAHalf :: Rule
ruleGrainAndAHalf :: Rule
ruleGrainAndAHalf = Rule :: Text -> Pattern -> Production -> Rule
Rule
  { name :: Text
name = Text
"<time-grain> and a half"
  , pattern :: Pattern
pattern =
    [ 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
TimeGrain a
grain:[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
grain Int
1
      [Token]
_ -> Maybe Token
forall a. Maybe a
Nothing
  }

ruleDurationAndAHalf :: Rule
ruleDurationAndAHalf :: Rule
ruleDurationAndAHalf = Rule :: Text -> Pattern -> Production -> Rule
Rule
  { name :: Text
name = Text
"<positive-numeral> <time-grain> and a half"
  , 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 NumeralData{TNumeral.value = v}:
       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
$ Double
v) 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
  }

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

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
  }

ruleGrainAsDuration :: Rule
ruleGrainAsDuration :: Rule
ruleGrainAsDuration = Rule :: Text -> Pattern -> Production -> Rule
Rule
  { name :: Text
name = Text
"a <unit-of-duration>"
  , pattern :: Pattern
pattern =
    [ 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
TimeGrain a
grain:[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 a
Grain
grain Int
1
      [Token]
_ -> Maybe Token
forall a. Maybe a
Nothing
  }

rulePositiveDuration :: Rule
rulePositiveDuration :: Rule
rulePositiveDuration = Rule :: Text -> Pattern -> Production -> Rule
Rule
  { name :: Text
name = Text
"<positive-numeral> <time-grain>"
  , pattern :: Pattern
pattern =
    [ (NumeralData -> Double) -> (Double -> Bool) -> PatternItem
forall t. (NumeralData -> t) -> (t -> Bool) -> PatternItem
numberWith NumeralData -> Double
TNumeral.value ((Double -> Bool) -> PatternItem)
-> (Double -> Bool) -> PatternItem
forall a b. (a -> b) -> a -> b
$ [Bool] -> Bool
forall (t :: * -> *). Foldable t => t Bool -> Bool
and ([Bool] -> Bool) -> (Double -> [Bool]) -> Double -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Double -> Bool] -> Double -> [Bool]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence [Bool -> Bool
not (Bool -> Bool) -> (Double -> Bool) -> Double -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Double -> Bool
isInteger, (Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
>Double
0)]
    , 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 NumeralData{TNumeral.value = v}:
       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 Grain
Second (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
$ Grain -> Double -> Double
forall a. Num a => Grain -> a -> a
inSeconds a
Grain
grain Double
v
      [Token]
_ -> Maybe Token
forall a. Maybe a
Nothing
  }

rules :: [Rule]
rules :: [Rule]
rules =
  [ Rule
ruleDurationAndAHalf
  , Rule
ruleGrainAndAHalf
  , Rule
rulePositiveDuration
  , Rule
ruleDurationPrecision
  , Rule
ruleNumeralQuotes
  , Rule
ruleGrainAsDuration
  , Rule
ruleHalves
  ]