-- 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.Time.AR.Rules ( rules ) where import Data.Maybe import Data.Text (Text) import Prelude import Data.HashMap.Strict (HashMap) import qualified Data.HashMap.Strict as HashMap import qualified Data.Text as Text import Duckling.Dimensions.Types import Duckling.Duration.Helpers (duration) import Duckling.Numeral.Helpers (parseInt) import Duckling.Numeral.Types (NumeralData (..)) import Duckling.Regex.Types import Duckling.Time.Computed import Duckling.Time.Helpers import Duckling.Time.Types (TimeData (..)) import Duckling.Types import qualified Duckling.Numeral.Types as TNumeral import qualified Duckling.Ordinal.Types as TOrdinal import qualified Duckling.Time.Types as TTime import qualified Duckling.TimeGrain.Types as TG ruleIntersect :: Rule ruleIntersect = Rule { name = "intersect" , pattern = [ Predicate isNotLatent , Predicate isNotLatent ] , prod = \tokens -> case tokens of (Token Time td1:Token Time td2:_) -> Token Time <$> intersect td1 td2 _ -> Nothing } ruleIntersectOf :: Rule ruleIntersectOf = Rule { name = "intersect by \",\", \"of\", \"from\", \"'s\"" , pattern = [ Predicate isNotLatent , regex "من|,|،|لـ?|بـ?|الموافق( ل)?" , Predicate isNotLatent ] , prod = \tokens -> case tokens of (Token Time td1:_:Token Time td2:_) -> Token Time <$> intersect td1 td2 _ -> Nothing } ruleAbsorbOnTime :: Rule ruleAbsorbOnTime = Rule { name = "on " , pattern = [ regex "في" , dimension Time ] , prod = \tokens -> case tokens of (_:token:_) -> Just token _ -> Nothing } ruleAbsorbOnADOW :: Rule ruleAbsorbOnADOW = Rule { name = "on a " , pattern = [ regex "يوم" , Predicate isADayOfWeek ] , prod = \tokens -> case tokens of (_:token:_) -> Just token _ -> Nothing } ruleAbsorbInMonth :: Rule ruleAbsorbInMonth = Rule { name = "in " , pattern = [ regex "شهر" , Predicate isAMonth ] , prod = \tokens -> case tokens of (_:token:_) -> Just token _ -> Nothing } ruleAbsorbCommaTOD :: Rule ruleAbsorbCommaTOD = Rule { name = "absorption of , after named day" , pattern = [ Predicate isADayOfWeek , regex "[,،]" ] , prod = \tokens -> case tokens of (token:_) -> Just token _ -> Nothing } instants :: [(Text, String, TG.Grain, Int)] instants = [ ("right now", "الان|حالا|(في )?هذه اللحظ[ةه]", TG.Second, 0) , ("today", "اليوم", TG.Day, 0) , ("tomorrow", "((يوم )?(غدا?|الغد))|(بكر[اةه])", TG.Day, 1) -- TODO: add regex for more variation of yesterday , ("yesterday", "[أا]مس|(ال|ام)بارح[ةه]?", TG.Day, - 1) , ("end of month", "(نهاي[ةه] الشهر)", TG.Month, 1) , ("end of year", "(نهاي[ةه] (السن[ةه]|العام))", TG.Year, 1) ] ruleInstants :: [Rule] ruleInstants = map go instants where go (name, regexPattern, grain, n) = Rule { name = name , pattern = [regex regexPattern] , prod = \_ -> tt $ cycleNth grain n } ruleNow :: Rule ruleNow = Rule { name = "now" , pattern = [ regex "ال[اآ]ن|حالا" ] , prod = \_ -> tt now } ruleThisDOW :: Rule ruleThisDOW = Rule { name = "this " , pattern = [ regex "هذا" , Predicate isADayOfWeek ] , prod = \tokens -> case tokens of (_:Token Time td:_) -> tt $ predNth 0 True td _ -> Nothing } ruleDOWNext :: Rule ruleDOWNext = Rule { name = " next" , pattern = [ Predicate isADayOfWeek , regex "القادم|التالي|ال[آا]تي?|القادم" ] , prod = \tokens -> case tokens of (Token Time td:_) -> tt $ predNth 0 True td _ -> Nothing } ruleDOWLast :: Rule ruleDOWLast = Rule { name = " last" , pattern = [ Predicate isADayOfWeek , regex "السابق|الماضي|المنصرم|الفا[يئ]ت" ] , prod = \tokens -> case tokens of (Token Time td:_) -> tt $ predNth (- 1) True td _ -> Nothing } ruleThisTime :: Rule ruleThisTime = Rule { name = "this