-- | 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 :: Parser String OpeningHours
pOpeningHours = [RuleSequence] -> OpeningHours
OpeningHours forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((:) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> RuleType -> Parser String RuleSequence
pRuleSequence RuleType
Normal forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (f :: * -> *) a. Alternative f => f a -> f [a]
many Parser String RuleSequence
next_rule_sequence)
  where
    next_rule_sequence :: Parser String RuleSequence
next_rule_sequence =
      String -> Parser String String
word String
";" forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> RuleType -> Parser String RuleSequence
pRuleSequence RuleType
Normal
        forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> String -> Parser String String
word String
"," forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> RuleType -> Parser String RuleSequence
pRuleSequence RuleType
Additional

pRuleSequence :: RuleType -> Parser String RuleSequence
pRuleSequence :: RuleType -> Parser String RuleSequence
pRuleSequence RuleType
t = RuleType -> SelectorSequence -> OHState -> RuleSequence
RuleSequence RuleType
t forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser String SelectorSequence
pSelectorSequence forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser String OHState
pRuleModifier

pRuleModifier :: Parser String OHState
pRuleModifier :: Parser String OHState
pRuleModifier =
  ( forall a. a -> Maybe a
Just Bool
False forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ (String -> Parser String String
word String
"closed" forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> String -> Parser String String
word String
"off")
      forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall a. Maybe a
Nothing forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ String -> Parser String String
word String
"unknown"
      forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall a. a -> Maybe a
Just Bool
True forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ (String -> Parser String String
word String
"open" forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser String String
ws)
  )
    forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional Parser String String
pComment

pSelectorSequence :: Parser String SelectorSequence
pSelectorSequence :: Parser String SelectorSequence
pSelectorSequence =
  SelectorSequence
TwentyFourSeven forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ String -> Parser String String
word String
"24/7"
    forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (WeekdaySelector -> TimeSelector -> SelectorSequence
WeekdayTime forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser String WeekdaySelector
pWeekdaySelector forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser String TimeSelector
pTimeSelector)
    forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (WeekdaySelector -> SelectorSequence
WeekdaySel forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser String WeekdaySelector
pWeekdaySelector)
    forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (TimeSelector -> SelectorSequence
TimeSel forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser String TimeSelector
pTimeSelector)

pWeekdaySelector :: Parser String WeekdaySelector
pWeekdaySelector :: Parser String WeekdaySelector
pWeekdaySelector = (:) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser String WeekdayRange
pWeekdayRange forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (f :: * -> *) a. Alternative f => f a -> f [a]
many (String -> Parser String String
word String
"," forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser String WeekdayRange
pWeekdayRange)

pTimeSelector :: Parser String TimeSelector
pTimeSelector :: Parser String TimeSelector
pTimeSelector = (:) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser String TimeSpan
pTimeSpan forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (f :: * -> *) a. Alternative f => f a -> f [a]
many (String -> Parser String String
word String
"," forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser String TimeSpan
pTimeSpan)

pWeekdayRange :: Parser String WeekdayRange
pWeekdayRange :: Parser String WeekdayRange
pWeekdayRange =
  WeekDay -> WeekDay -> WeekdayRange
WdayRange forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser String WeekDay
pWday forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (String -> Parser String String
word String
"-" forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser String WeekDay
pWday)
    forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> WeekDay -> WeekdayRange
SingleDay forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser String WeekDay
pWday

pWday :: Parser String WeekDay
pWday :: Parser String WeekDay
pWday =
  WeekDay
Sunday forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ String -> Parser String String
word String
"Su"
    forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> WeekDay
Monday forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ String -> Parser String String
word String
"Mo"
    forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> WeekDay
Tuesday forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ String -> Parser String String
word String
"Tu"
    forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> WeekDay
Wednesday forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ String -> Parser String String
word String
"We"
    forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> WeekDay
Thursday forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ String -> Parser String String
word String
"Th"
    forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> WeekDay
Friday forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ String -> Parser String String
word String
"Fr"
    forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> WeekDay
Saturday forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ String -> Parser String String
word String
"Sa"

pTimeSpan :: Parser String TimeSpan
pTimeSpan :: Parser String TimeSpan
pTimeSpan =
  (TimeOfDay -> TimeOfDay -> TimeSpan
Span forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Bool -> Parser String TimeOfDay
pTime Bool
False forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (String -> Parser String String
word String
"-" forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Bool -> Parser String TimeOfDay
pTime Bool
True))
    forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> TimeOfDay -> TimeSpan
Moment forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Bool -> Parser String TimeOfDay
pTime Bool
False

pTime :: Bool -> Parser String TimeOfDay
pTime :: Bool -> Parser String TimeOfDay
pTime Bool
extended = (\Int
h Int
m -> Hours -> Minutes -> Seconds -> NanoSeconds -> TimeOfDay
TimeOfDay (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
h) (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
m) Seconds
0 NanoSeconds
0) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser String Int
p_hour forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (String -> Parser String String
str String
":" forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Int -> Parser String Int
bint Int
59)
  where
    p_hour :: Parser String Int
p_hour = if Bool
extended then Int -> Parser String Int
bint Int
48 else Int -> Parser String Int
bint Int
24

pComment :: Parser String String
pComment :: Parser String String
pComment = String -> Parser String String
str String
"\"" forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall (f :: * -> *) a. Alternative f => f a -> f [a]
many (String -> Parser String Char
noneOf String
"\"") forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* String -> Parser String String
word String
"\""