-- 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. An additional grant -- of patent rights can be found in the PATENTS file in the same directory. {-# LANGUAGE GADTs #-} {-# LANGUAGE NoRebindableSyntax #-} {-# LANGUAGE OverloadedStrings #-} module Duckling.Time.DE.Rules ( rules ) where import Prelude import Data.Text (Text) import qualified Data.Text as Text import Duckling.Dimensions.Types import Duckling.Numeral.Helpers (parseInt) import Duckling.Ordinal.Types (OrdinalData (..)) import Duckling.Regex.Types import Duckling.Time.Helpers import Duckling.Time.Types (TimeData (..)) import Duckling.Types import qualified Duckling.Ordinal.Types as TOrdinal import qualified Duckling.Time.Types as TTime import qualified Duckling.TimeGrain.Types as TG instants :: [(Text, TG.Grain, Int, String)] instants = [ ( "now" , TG.Second, 0, "(genau)? ?jetzt|diesen moment|in diesem moment|gerade eben" ) , ( "today" , TG.Day , 0, "heute|(um diese zeit|zu dieser zeit|um diesen zeitpunkt|zu diesem zeitpunkt)" ) , ( "tomorrow" , TG.Day , 1, "morgen" ) , ( "yesterday" , TG.Day , -1, "gestern" ) , ( "after tomorrow" , TG.Day , 2, "(ü)bermorgen" ) , ( "before yesterday", TG.Day , -2, "vorgestern" ) , ( "EOM|End of month", TG.Month , 1, "(das )?ende des monats?" ) , ( "EOY|End of year" , TG.Year , 1, "(das )?(EOY|jahr(es)? ?ende|ende (des )?jahr(es)?)" ) ] ruleInstants :: [Rule] ruleInstants = map go instants where go (name, grain, n, regexPattern) = Rule { name = name , pattern = [regex regexPattern] , prod = \_ -> tt $ cycleNth grain n } daysOfWeek :: [(Text, String)] daysOfWeek = [ ( "Montag" , "montags?|mo\\.?" ) , ( "Dienstag" , "die?nstags?|di\\.?" ) , ( "Mittwoch" , "mittwochs?|mi\\.?" ) , ( "Donnerstag", "donn?erstag|do\\.?" ) , ( "Freitag" , "freitags?|fr\\.?" ) , ( "Samstag" , "samstags?|sonnabends?|sa\\.?" ) , ( "Sonntag" , "sonntags?|so\\.?" ) ] ruleDaysOfWeek :: [Rule] ruleDaysOfWeek = zipWith go daysOfWeek [1..7] where go (name, regexPattern) i = Rule { name = name , pattern = [regex regexPattern] , prod = \_ -> tt $ dayOfWeek i } months :: [(Text, String)] months = [ ( "Januar" , "januar|jan\\.?" ) , ( "Februar" , "februar|feb\\.?" ) , ( "Marz" , "m(ä)rz|m(ä)r\\.?" ) , ( "April" , "april|apr\\.?" ) , ( "Mai" , "mai\\.?" ) , ( "Juni" , "juni|jun\\.?" ) , ( "Juli" , "juli|jul\\.?" ) , ( "August" , "august|aug\\.?" ) , ( "September", "september|sept?\\.?" ) , ( "Oktober" , "oktober|okt\\.?" ) , ( "November" , "november|nov\\.?" ) , ( "Dezember" , "dezember|dez\\.?" ) ] ruleMonths :: [Rule] ruleMonths = zipWith go months [1..12] where go (name, regexPattern) i = Rule { name = name , pattern = [regex regexPattern] , prod = \_ -> tt $ month i } seasons :: [(Text, String, TimeData, TimeData)] seasons = [ ( "sommer" , "sommer" , monthDay 6 21, monthDay 9 23 ) , ( "herbst" , "herbst" , monthDay 9 23, monthDay 12 21 ) , ( "winter" , "winter" , monthDay 12 21, monthDay 3 20 ) , ( "fruhling", "fr(ü)h(ling|jahr)", monthDay 3 20, monthDay 6 21 ) ] ruleSeasons :: [Rule] ruleSeasons = map go seasons where go (name, regexPattern, start, end) = Rule { name = name , pattern = [regex regexPattern] , prod = \_ -> Token Time <$> interval TTime.Open start end } holidays :: [(Text, TimeData, String)] holidays = [ ( "new year's day" , monthDay 1 1, "neujahr(s?tag)?" ) , ( "valentine's day" , monthDay 2 14, "valentin'?stag" ) , ( "Schweizer Bundesfeiertag" , monthDay 8 1, "schweiz(er)? (bundes)?feiertag|bundes feiertag" ) , ( "Tag der Deutschen Einheit" , monthDay 10 3, "tag (der)? deutsc?hen? einheit" ) , ( "Oesterreichischer Nationalfeiertag", monthDay 10 26, "((ö)sterreichischer?)? nationalfeiertag|national feiertag" ) , ( "halloween day" , monthDay 10 31, "hall?owe?en?" ) , ( "Allerheiligen" , monthDay 11 1, "allerheiligen?|aller heiligen?" ) , ( "Nikolaus" , monthDay 12 6, "nikolaus(tag)?|nikolaus tag|nikolo" ) , ( "christmas eve" , monthDay 12 24, "heilig(er)? abend" ) , ( "christmas" , monthDay 12 25, "weih?nacht(en|stag)?" ) , ( "new year's eve" , monthDay 12 31, "silvester" ) , ( "Mother's Day" , nthDOWOfMonth 2 7 5, "mutt?ertag|mutt?er (tag)?" ) , ( "Father's Day" , nthDOWOfMonth 3 7 6, "vatt?er( ?tag)?" ) ] ruleHolidays :: [Rule] ruleHolidays = map go holidays where go (name, date, regexPattern) = Rule { name = name , pattern = [regex regexPattern] , prod = \_ -> tt date } ruleRelativeMinutesTotillbeforeIntegerHourofday :: Rule ruleRelativeMinutesTotillbeforeIntegerHourofday = Rule { name = "relative minutes to|till|before (hour-of-day)" , pattern = [ Predicate $ isIntegerBetween 1 59 , regex "vor" , Predicate isAnHourOfDay ] , prod = \tokens -> case tokens of (token:_:Token Time td:_) -> do n <- getIntValue token t <- minutesBefore n td Just $ Token Time t _ -> Nothing } ruleQuarterTotillbeforeIntegerHourofday :: Rule ruleQuarterTotillbeforeIntegerHourofday = Rule { name = "quarter to|till|before (hour-of-day)" , pattern = [regex "vie?rtel vor" , Predicate isAnHourOfDay ] , prod = \tokens -> case tokens of (_:Token Time td:_) -> do t <- minutesBefore 15 td Just $ Token Time t _ -> Nothing } ruleHalfTotillbeforeIntegerHourofday :: Rule ruleHalfTotillbeforeIntegerHourofday = Rule { name = "half to|till|before (hour-of-day)" , pattern = [ regex "halbe? vor" , Predicate isAnHourOfDay ] , prod = \tokens -> case tokens of (_:Token Time td:_) -> do t <- minutesBefore 30 td Just $ Token Time t _ -> Nothing } ruleTheOrdinalCycleOfTime :: Rule ruleTheOrdinalCycleOfTime = Rule { name = "the of