-- | Parser for opening hours (incomplete). module ConditionalRestriction.Internal.Parse.OpeningHoursParser where import ConditionalRestriction.Internal.Parse.ParserLib ( Parser, bint, noneOf, str, word, ws, ) import ConditionalRestriction.Parse.AST ( OHState, OpeningHours (..), RuleSequence (..), RuleType (..), SelectorSequence (..), TimeSelector, TimeSpan (..), WeekdayRange (..), WeekdaySelector, ) import Control.Applicative (Alternative (many, (<|>)), optional) import Data.Hourglass (TimeOfDay (TimeOfDay), WeekDay (..)) -- | Parse opening hours, e.g. @"Di-Fr 08:00-20:00"@. pOpeningHours :: Parser String OpeningHours pOpeningHours = OpeningHours <$> ((:) <$> pRuleSequence Normal <*> many next_rule_sequence) where next_rule_sequence = word ";" *> pRuleSequence Normal <|> word "," *> pRuleSequence Additional pRuleSequence :: RuleType -> Parser String RuleSequence pRuleSequence t = RuleSequence t <$> pSelectorSequence <*> pRuleModifier pRuleModifier :: Parser String OHState pRuleModifier = ( Just False <$ (word "closed" <|> word "off") <|> Nothing <$ word "unknown" <|> Just True <$ (word "open" <|> ws) ) <* optional pComment pSelectorSequence :: Parser String SelectorSequence pSelectorSequence = TwentyFourSeven <$ word "24/7" <|> (WeekdayTime <$> pWeekdaySelector <*> pTimeSelector) <|> (WeekdaySel <$> pWeekdaySelector) <|> (TimeSel <$> pTimeSelector) pWeekdaySelector :: Parser String WeekdaySelector pWeekdaySelector = (:) <$> pWeekdayRange <*> many (word "," *> pWeekdayRange) pTimeSelector :: Parser String TimeSelector pTimeSelector = (:) <$> pTimeSpan <*> many (word "," *> pTimeSpan) pWeekdayRange :: Parser String WeekdayRange pWeekdayRange = WdayRange <$> pWday <*> (word "-" *> pWday) <|> SingleDay <$> pWday pWday :: Parser String WeekDay pWday = Sunday <$ word "Su" <|> Monday <$ word "Mo" <|> Tuesday <$ word "Tu" <|> Wednesday <$ word "We" <|> Thursday <$ word "Th" <|> Friday <$ word "Fr" <|> Saturday <$ word "Sa" pTimeSpan :: Parser String TimeSpan pTimeSpan = (Span <$> pTime False <*> (word "-" *> pTime True)) <|> Moment <$> pTime False pTime :: Bool -> Parser String TimeOfDay pTime extended = (\h m -> TimeOfDay (fromIntegral h) (fromIntegral m) 0 0) <$> p_hour <*> (str ":" *> bint 59) where p_hour = if extended then bint 48 else bint 24 pComment :: Parser String String pComment = str "\"" *> many (noneOf "\"") <* word "\""