-- | AST for conditional restrictions and incomplete AST for opening hours.
module ConditionalRestriction.Parse.AST
  ( Token,
    ConditionalRestriction (..),
    Expression (..),
    Condition (..),
    ComparisonOp (..),
    OpeningHours (..),
    OHState,
    RuleType (..),
    RuleSequence (..),
    WeekdaySelector,
    TimeSelector,
    SelectorSequence (..),
    WeekdayRange (..),
    TimeSpan (..),
  )
where

import Data.Hourglass (TimeOfDay, WeekDay)

-- | A single token. Is used to represent values of any kind that the parser does not touch.
type Token = String

-- | AST representation of a conditional restriction.
newtype ConditionalRestriction = ConditionalRestriction [Expression]
  deriving (ConditionalRestriction -> ConditionalRestriction -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ConditionalRestriction -> ConditionalRestriction -> Bool
$c/= :: ConditionalRestriction -> ConditionalRestriction -> Bool
== :: ConditionalRestriction -> ConditionalRestriction -> Bool
$c== :: ConditionalRestriction -> ConditionalRestriction -> Bool
Eq, Int -> ConditionalRestriction -> ShowS
[ConditionalRestriction] -> ShowS
ConditionalRestriction -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ConditionalRestriction] -> ShowS
$cshowList :: [ConditionalRestriction] -> ShowS
show :: ConditionalRestriction -> String
$cshow :: ConditionalRestriction -> String
showsPrec :: Int -> ConditionalRestriction -> ShowS
$cshowsPrec :: Int -> ConditionalRestriction -> ShowS
Show)

-- | AST representation of a conditional restriction expression, containing a value and conditions for that value
data Expression
  = Expression
      Token
      -- ^ The value
      [Condition]
      -- ^ The conditions. All conditions must be met when evaluating.
  deriving (Expression -> Expression -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Expression -> Expression -> Bool
$c/= :: Expression -> Expression -> Bool
== :: Expression -> Expression -> Bool
$c== :: Expression -> Expression -> Bool
Eq, Int -> Expression -> ShowS
[Expression] -> ShowS
Expression -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Expression] -> ShowS
$cshowList :: [Expression] -> ShowS
show :: Expression -> String
$cshow :: Expression -> String
showsPrec :: Int -> Expression -> ShowS
$cshowsPrec :: Int -> Expression -> ShowS
Show)

-- | AST representation of a condition.
data Condition
  = -- | An 'OpeningHours' condition. When evaluating, the given time must be within those opening hours.
    OH OpeningHours
  | -- | A comparison. Looks something like @"weight > 3.0"@
    Comparison Token ComparisonOp Double
  | -- | An absolute condition, e.g. @"wet"@, @"disabled"@.
    Absolute Token
  deriving (Condition -> Condition -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Condition -> Condition -> Bool
$c/= :: Condition -> Condition -> Bool
== :: Condition -> Condition -> Bool
$c== :: Condition -> Condition -> Bool
Eq, Int -> Condition -> ShowS
[Condition] -> ShowS
Condition -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Condition] -> ShowS
$cshowList :: [Condition] -> ShowS
show :: Condition -> String
$cshow :: Condition -> String
showsPrec :: Int -> Condition -> ShowS
$cshowsPrec :: Int -> Condition -> ShowS
Show)

-- | A comparison operator.
data ComparisonOp = Gt | Lt | GtEq | LtEq | Eq
  deriving (ComparisonOp -> ComparisonOp -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ComparisonOp -> ComparisonOp -> Bool
$c/= :: ComparisonOp -> ComparisonOp -> Bool
== :: ComparisonOp -> ComparisonOp -> Bool
$c== :: ComparisonOp -> ComparisonOp -> Bool
Eq, Int -> ComparisonOp -> ShowS
[ComparisonOp] -> ShowS
ComparisonOp -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ComparisonOp] -> ShowS
$cshowList :: [ComparisonOp] -> ShowS
show :: ComparisonOp -> String
$cshow :: ComparisonOp -> String
showsPrec :: Int -> ComparisonOp -> ShowS
$cshowsPrec :: Int -> ComparisonOp -> ShowS
Show)

-- | AST representation of opening hours. Not complete.
newtype OpeningHours = OpeningHours [RuleSequence]
  deriving (OpeningHours -> OpeningHours -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: OpeningHours -> OpeningHours -> Bool
$c/= :: OpeningHours -> OpeningHours -> Bool
== :: OpeningHours -> OpeningHours -> Bool
$c== :: OpeningHours -> OpeningHours -> Bool
Eq, Int -> OpeningHours -> ShowS
[OpeningHours] -> ShowS
OpeningHours -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [OpeningHours] -> ShowS
$cshowList :: [OpeningHours] -> ShowS
show :: OpeningHours -> String
$cshow :: OpeningHours -> String
showsPrec :: Int -> OpeningHours -> ShowS
$cshowsPrec :: Int -> OpeningHours -> ShowS
Show)

-- | Opening hour state. True\/False if known to be open/closed, Nothing if unknown.
type OHState = Maybe Bool

-- | Type of opening hour rule.
data RuleType
  = -- | First rule or rules separated by ";".
    Normal
  | -- | Rules separated by ",".
    Additional
  deriving (RuleType -> RuleType -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RuleType -> RuleType -> Bool
$c/= :: RuleType -> RuleType -> Bool
== :: RuleType -> RuleType -> Bool
$c== :: RuleType -> RuleType -> Bool
Eq, Int -> RuleType -> ShowS
[RuleType] -> ShowS
RuleType -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RuleType] -> ShowS
$cshowList :: [RuleType] -> ShowS
show :: RuleType -> String
$cshow :: RuleType -> String
showsPrec :: Int -> RuleType -> ShowS
$cshowsPrec :: Int -> RuleType -> ShowS
Show)

-- | AST representation of a rule sequence.
data RuleSequence = RuleSequence RuleType SelectorSequence OHState
  deriving (RuleSequence -> RuleSequence -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RuleSequence -> RuleSequence -> Bool
$c/= :: RuleSequence -> RuleSequence -> Bool
== :: RuleSequence -> RuleSequence -> Bool
$c== :: RuleSequence -> RuleSequence -> Bool
Eq, Int -> RuleSequence -> ShowS
[RuleSequence] -> ShowS
RuleSequence -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RuleSequence] -> ShowS
$cshowList :: [RuleSequence] -> ShowS
show :: RuleSequence -> String
$cshow :: RuleSequence -> String
showsPrec :: Int -> RuleSequence -> ShowS
$cshowsPrec :: Int -> RuleSequence -> ShowS
Show)

-- | AST representation of a weekday selector (e.g. @"Sa-Di, Th"@).
type WeekdaySelector = [WeekdayRange]

-- | AST representation of a time selector (e.g. @"18:00-20:00, 21:00-03:00"@).
type TimeSelector = [TimeSpan]

-- | AST representation of a selector sequence (e.g. @"24/7"@, @"We-Su 18:00-20:00"@).
data SelectorSequence
  = TwentyFourSeven
  | WeekdaySel WeekdaySelector
  | TimeSel TimeSelector
  | WeekdayTime WeekdaySelector TimeSelector
  deriving (SelectorSequence -> SelectorSequence -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SelectorSequence -> SelectorSequence -> Bool
$c/= :: SelectorSequence -> SelectorSequence -> Bool
== :: SelectorSequence -> SelectorSequence -> Bool
$c== :: SelectorSequence -> SelectorSequence -> Bool
Eq, Int -> SelectorSequence -> ShowS
[SelectorSequence] -> ShowS
SelectorSequence -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SelectorSequence] -> ShowS
$cshowList :: [SelectorSequence] -> ShowS
show :: SelectorSequence -> String
$cshow :: SelectorSequence -> String
showsPrec :: Int -> SelectorSequence -> ShowS
$cshowsPrec :: Int -> SelectorSequence -> ShowS
Show)

-- | AST representation of a weekday range.
data WeekdayRange
  = SingleDay WeekDay
  | WdayRange WeekDay WeekDay
  deriving (WeekdayRange -> WeekdayRange -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: WeekdayRange -> WeekdayRange -> Bool
$c/= :: WeekdayRange -> WeekdayRange -> Bool
== :: WeekdayRange -> WeekdayRange -> Bool
$c== :: WeekdayRange -> WeekdayRange -> Bool
Eq, Int -> WeekdayRange -> ShowS
WeekdaySelector -> ShowS
WeekdayRange -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: WeekdaySelector -> ShowS
$cshowList :: WeekdaySelector -> ShowS
show :: WeekdayRange -> String
$cshow :: WeekdayRange -> String
showsPrec :: Int -> WeekdayRange -> ShowS
$cshowsPrec :: Int -> WeekdayRange -> ShowS
Show)

-- | AST representation of time span.
data TimeSpan
  = Moment TimeOfDay
  | Span TimeOfDay TimeOfDay
  deriving (TimeSpan -> TimeSpan -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TimeSpan -> TimeSpan -> Bool
$c/= :: TimeSpan -> TimeSpan -> Bool
== :: TimeSpan -> TimeSpan -> Bool
$c== :: TimeSpan -> TimeSpan -> Bool
Eq, Int -> TimeSpan -> ShowS
TimeSelector -> ShowS
TimeSpan -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: TimeSelector -> ShowS
$cshowList :: TimeSelector -> ShowS
show :: TimeSpan -> String
$cshow :: TimeSpan -> String
showsPrec :: Int -> TimeSpan -> ShowS
$cshowsPrec :: Int -> TimeSpan -> ShowS
Show)