-- 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.Time.EL.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.Duration.Helpers (duration, isGrain) import Duckling.Duration.Types (DurationData(DurationData)) import Duckling.Numeral.Helpers (parseInt, numeralMapEL) import Duckling.Numeral.Types (NumeralData(..)) import Duckling.Ordinal.Types (OrdinalData(..), isBetween) import Duckling.Regex.Types 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 ruleInstants :: [Rule] ruleInstants = mkRuleInstants [ ( "now" , TG.Second, 0, "(αμέσως\\s+)?τώρα(\\s+αμέσως)?|αυτή τη στιγμή" ) , ( "today" , TG.Day , 0, "σήμερα" ) , ( "tomorrow" , TG.Day , 1, "(επ)?αύριο" ) , ( "yesterday" , TG.Day , -1, "ε?χ[θτ][εέ]ς" ) , ( "after tomorrow" , TG.Day , 2, "μεθαύριο" ) , ( "before yesterday", TG.Day , -2, "προχ[θτ]ές" ) , ( "EOD|End of day" , TG.Day , 1, "τέλου?ς\\s+της\\s+η?μέρας") , ( "EOM|End of month", TG.Month , 1, "τέλου?ς\\s+του\\s+μήνα" ) , ( "EOY|End of year" , TG.Year , 1, "τέλου?ς\\s+του\\s+χρόνου" ) ] daysOfWeek :: [(Text, String)] daysOfWeek = [ ( "monday" , "δευτ(έρας?|\\.?)" ) , ( "tuesday" , "τρ[ιί](της?|\\.?)" ) , ( "wednesday" , "τετ(άρτης?|\\.?)" ) , ( "thursday" , "π[εέ]μ(πτης?|\\.?)" ) , ( "friday" , "παρ(ασκευής?|\\.?)" ) , ( "saturday" , "σ[αά]β(β[αά]το[νυ]?|\\.?)" ) , ( "sunday" , "κυρ(ιακής?|\\.?)" ) ] ruleDaysOfWeek :: [Rule] ruleDaysOfWeek = zipWith go daysOfWeek [1..7] where go (name, regexPattern) i = Rule { name = name , pattern = [regex regexPattern] , prod = const . tt . mkOkForThisNext $ dayOfWeek i } months :: [(Text, String)] months = [ ( "January" , "ιαν(ου[αά]ρ[ιί]ο[υς]?)?|γενάρης?" ) , ( "February" , "φεβ(ρου[αά]ρ[ιί]ο[υς]?)?|φλεβάρης?" ) , ( "March" , "μ[αά]ρ(τ([ιί]ο([νυ]?)|η)ς?)?" ) , ( "April" , "απρ([ιί]λ([ιί]ο([νυ]?)|η)ς?)?" ) , ( "May" , "μ[αά]([ιίϊΐ]ο[νυ]?|η)ς?" ) , ( "June" , "ιο[υύ]ν([ιί]ο[υν]?|η)?ς?" ) , ( "July" , "ιο[υύ]λ([ιί]ο[υν]?|η)?ς?" ) , ( "August" , "α[υύ]γ(ο[υύ]στο(ν|υ|ς)?)?" ) , ( "September", "σεπτ([εέ]μβρ([ιί]ο([νυ]?)|η)ς?)?" ) , ( "October" , "οκτ([ωώ]βρ([ιί]ο([νυ]?)|η)ς?)?" ) , ( "November" , "νο[εέ](μ(βρ([ιί]ο([νυ]?)|η)ς?)?)?" ) , ( "December" , "δεκ([εέ]μβρ([ιί]ο([νυ]?)|η)ς?)?" ) ] ruleMonths :: [Rule] ruleMonths = zipWith go months [1..12] where go (name, regexPattern) i = Rule { name = name , pattern = [regex regexPattern] , prod = const . tt . mkOkForThisNext $ month i } ruleSeasons :: [Rule] ruleSeasons = mkRuleSeasons [ ( "summer" , "καλοκα[ιί]ρι(ού)?", monthDay 6 21, monthDay 9 23 ) , ( "fall" , "φθιν[οό]π[ωώ]ρου?", monthDay 9 23, monthDay 12 21 ) , ( "winter" , "χειμώνας?" , monthDay 12 21, monthDay 3 20 ) , ( "spring" , "άνοιξης?" , monthDay 3 20, monthDay 6 21 ) ] ruleHolidays :: [Rule] ruleHolidays = map go holidays where go (name, td, regexPattern) = Rule { name = name , pattern = [regex regexPattern] , prod = const . tt $ mkOkForThisNext td } holidays :: [(Text, TimeData, String)] holidays = [ ("new year's day" , monthDay 1 1, "πρωτοχρονιάς?") , ("valentine's day" , monthDay 2 14, "αγίου\\s+βαλεντίνου") , ("halloween day" , monthDay 10 31, "halloween") , ("Epiphany" , monthDay 1 6, "θεοφ(αά)νε[ιί](α|ων)|φ[ωώ]τ(α|ων)") , ("annunciation day" , monthDay 3 25, "ευαγγελισμ(ός|ού)\\s+της\\s+θεοτόκου") , ("revolution day" , monthDay 3 25 , "η?μέρα\\s+(της\\s+)?(ελληνικής\\s+)?επανάστασης") , ("assumption day" , monthDay 8 15 , "κο[ιί]μ[ηή]σ(η|ις|εως)\\s+της\\s+θεοτόκου") , ("christmas eve" , monthDay 12 24, "παραμν(ή|έ)ς?\\s+χριστουγέννων") , ("christmas" , monthDay 12 25, "χριστο[υύ]γ[εέ]νν(α|ων)") , ("new year's eve" , monthDay 12 31, "παραμον(ή|έ)ς?\\s+πρωτοχρονιάς") , ("Mother's Day" , nthDOWOfMonth 2 7 5, "η?μέρας?\\s+της\\s+μητέρας") , ("Father's Day" , nthDOWOfMonth 3 7 6 , "(γιορτής?|η?μέρας?)\\s+του\\s+πατέρα") ] ruleRelativeIntegerToOrAfterIntegerPartOfDay :: Rule ruleRelativeIntegerToOrAfterIntegerPartOfDay = Rule { name = "relative integer (minutes) to|till|before|after (time-of-day)" , pattern = [ Predicate $ isIntegerBetween 1 30 , regex "(πριν|μετά)" , Predicate isATimeOfDay ] , prod = \tokens -> case tokens of (Token Numeral NumeralData{TNumeral.value = v}: Token RegexMatch (GroupMatch (match:_)): Token Time td: _) -> case Text.toLower match of "πριν" -> tt $ durationBefore (duration TG.Minute $ floor v) td _ -> tt $ durationAfter (duration TG.Minute $ floor v) td _ -> Nothing } ruleQuarterBeforeOrAfterIntegerHourofday :: Rule ruleQuarterBeforeOrAfterIntegerHourofday = Rule { name = "quarter to|past (hour-of-day)" , pattern = [ Predicate isAnHourOfDay , regex "(παρά|και)\\s+τέταρτο" ] , prod = \tokens -> case tokens of (Token Time td: Token RegexMatch (GroupMatch (match:_)): _) -> case Text.toLower match of "παρά" -> Token Time <$> minutesBefore 15 td _ -> Token Time <$> minutesAfter 15 td _ -> Nothing } ruleHalfAfterIntegerHourofday :: Rule ruleHalfAfterIntegerHourofday = Rule { name = "half after|past (hour-of-day)" , pattern = [ Predicate isAnHourOfDay , regex "και μισή" ] , prod = \tokens -> case tokens of (Token Time TimeData {TTime.form = Just (TTime.TimeOfDay (Just hours) is12H)}: _) -> tt $ hourMinute is12H hours 30 _ -> Nothing } ruleHalfAfterIntegerHourofday2 :: Rule ruleHalfAfterIntegerHourofday2 = Rule { name = "-and-half (hour-of-day)" , pattern = [ regex $ "(μιά|ενά|δυό|τρεισή|τεσσερι?σή|πεντέ|εξί|ε[πφ]τά|ο[κχ]τώ|εννιά|" ++ "δεκά|εντεκά|δωδεκά)μισ[ιη]ς?" ] , prod = \tokens -> case tokens of (Token RegexMatch (GroupMatch (num:_)):_) -> case HashMap.lookup (Text.toLower num) numeralMapEL of Just hours -> tt $ hourMinute True hours 30 _ -> Nothing _ -> Nothing } ruleOrdinalCycleOfTime :: Rule ruleOrdinalCycleOfTime = Rule { name = " of