module Data.Time.RRule.Types
  ( defaultRRule
  , RRule(..)
  , Day(..)
  , Frequency(..)
  , TimeOrDate(..)
  , ToRRule(toRRule)
  )
where

import Prelude hiding (until)
import Data.List.NonEmpty (NonEmpty(..))
import Data.Text (Text, intercalate, pack, unpack)
import Data.Time.Format (formatTime, defaultTimeLocale)
import Data.Time.Clock (UTCTime)
import qualified Data.Time.Calendar as Cal (Day, toGregorian)

class Show a => ToRRule a where
  toRRule :: a -> Text
  toRRule = String -> Text
pack (String -> Text) -> (a -> String) -> a -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> String
forall a. Show a => a -> String
show

instance ToRRule Int

instance ToRRule a => ToRRule (NonEmpty a) where
  toRRule :: NonEmpty a -> Text
toRRule (a
x :| [a]
xs) = Text -> [Text] -> Text
intercalate Text
"," ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$ a -> Text
forall a. ToRRule a => a -> Text
toRRule a
x Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: (a -> Text) -> [a] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map a -> Text
forall a. ToRRule a => a -> Text
toRRule [a]
xs

instance (Show a, Integral a, ToRRule b) => ToRRule (a, b) where
  toRRule :: (a, b) -> Text
toRRule (a
a, b
b) = (if a
a a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
0 then Text
"" else String -> Text
pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ a -> String
forall a. Show a => a -> String
show a
a) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> b -> Text
forall a. ToRRule a => a -> Text
toRRule b
b

instance ToRRule UTCTime where
  toRRule :: UTCTime -> Text
toRRule = String -> Text
pack (String -> Text) -> (UTCTime -> String) -> UTCTime -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TimeLocale -> String -> UTCTime -> String
forall t. FormatTime t => TimeLocale -> String -> t -> String
formatTime TimeLocale
defaultTimeLocale String
"%Y%m%dT%H%M%SZ"

data TimeOrDate = Time UTCTime | Date Cal.Day
  deriving (TimeOrDate -> TimeOrDate -> Bool
(TimeOrDate -> TimeOrDate -> Bool)
-> (TimeOrDate -> TimeOrDate -> Bool) -> Eq TimeOrDate
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TimeOrDate -> TimeOrDate -> Bool
$c/= :: TimeOrDate -> TimeOrDate -> Bool
== :: TimeOrDate -> TimeOrDate -> Bool
$c== :: TimeOrDate -> TimeOrDate -> Bool
Eq, Int -> TimeOrDate -> ShowS
[TimeOrDate] -> ShowS
TimeOrDate -> String
(Int -> TimeOrDate -> ShowS)
-> (TimeOrDate -> String)
-> ([TimeOrDate] -> ShowS)
-> Show TimeOrDate
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TimeOrDate] -> ShowS
$cshowList :: [TimeOrDate] -> ShowS
show :: TimeOrDate -> String
$cshow :: TimeOrDate -> String
showsPrec :: Int -> TimeOrDate -> ShowS
$cshowsPrec :: Int -> TimeOrDate -> ShowS
Show)

instance ToRRule TimeOrDate where
  toRRule :: TimeOrDate -> Text
toRRule (Time UTCTime
utc) = UTCTime -> Text
forall a. ToRRule a => a -> Text
toRRule UTCTime
utc
  toRRule (Date Day
day) =
    let (Integer
y,Int
m,Int
d) = Day -> (Integer, Int, Int)
Cal.toGregorian Day
day
    in String -> Text
pack (Integer -> String
forall a. Show a => a -> String
show Integer
y String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Int -> String
forall a. Show a => a -> String
show Int
m String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Int -> String
forall a. Show a => a -> String
show Int
d)

instance ToRRule a => ToRRule (Maybe a) where
  toRRule :: Maybe a -> Text
toRRule Maybe a
Nothing = Text
""
  toRRule (Just a
a) = a -> Text
forall a. ToRRule a => a -> Text
toRRule a
a

data Frequency
  = Secondly
  | Minutely
  | Hourly
  | Daily
  | Weekly
  | Monthly
  | Yearly
  deriving (Frequency -> Frequency -> Bool
(Frequency -> Frequency -> Bool)
-> (Frequency -> Frequency -> Bool) -> Eq Frequency
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Frequency -> Frequency -> Bool
$c/= :: Frequency -> Frequency -> Bool
== :: Frequency -> Frequency -> Bool
$c== :: Frequency -> Frequency -> Bool
Eq, Int -> Frequency -> ShowS
[Frequency] -> ShowS
Frequency -> String
(Int -> Frequency -> ShowS)
-> (Frequency -> String)
-> ([Frequency] -> ShowS)
-> Show Frequency
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Frequency] -> ShowS
$cshowList :: [Frequency] -> ShowS
show :: Frequency -> String
$cshow :: Frequency -> String
showsPrec :: Int -> Frequency -> ShowS
$cshowsPrec :: Int -> Frequency -> ShowS
Show)

instance ToRRule Frequency where
  toRRule :: Frequency -> Text
toRRule = \case
    Frequency
Secondly -> Text
"SECONDLY"
    Frequency
Minutely -> Text
"MINUTELY"
    Frequency
Hourly   -> Text
"HOURLY"
    Frequency
Daily    -> Text
"DAILY"
    Frequency
Weekly   -> Text
"WEEKLY"
    Frequency
Monthly  -> Text
"MONTHLY"
    Frequency
Yearly   -> Text
"YEARLY"

data Day = Sunday | Monday | Tuesday | Wednesday | Thursday | Friday | Saturday
  deriving (Day -> Day -> Bool
(Day -> Day -> Bool) -> (Day -> Day -> Bool) -> Eq Day
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Day -> Day -> Bool
$c/= :: Day -> Day -> Bool
== :: Day -> Day -> Bool
$c== :: Day -> Day -> Bool
Eq, Int -> Day -> ShowS
[Day] -> ShowS
Day -> String
(Int -> Day -> ShowS)
-> (Day -> String) -> ([Day] -> ShowS) -> Show Day
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Day] -> ShowS
$cshowList :: [Day] -> ShowS
show :: Day -> String
$cshow :: Day -> String
showsPrec :: Int -> Day -> ShowS
$cshowsPrec :: Int -> Day -> ShowS
Show)

instance ToRRule Day where
  toRRule :: Day -> Text
toRRule = \case
    Day
Sunday    -> Text
"SU"
    Day
Monday    -> Text
"MO"
    Day
Tuesday   -> Text
"TU"
    Day
Wednesday -> Text
"WE"
    Day
Thursday  -> Text
"TH"
    Day
Friday    -> Text
"FR"
    Day
Saturday  -> Text
"SA"

data RRule = RRule
  { RRule -> Bool
prefix     :: Bool                        -- ^ whether this rule has the "RRULE:" prefix
  , RRule -> Maybe Day
weekStart  :: Maybe Day                   -- ^ starting day of the week
  , RRule -> Maybe Frequency
frequency  :: Maybe Frequency             -- ^ how often to recur
  , RRule -> Maybe Int
count      :: Maybe Int                   -- ^ how many times to recur
  , RRule -> Maybe TimeOrDate
until      :: Maybe TimeOrDate            -- ^ what UTCTime or Date to stop recurring after
  , RRule -> Maybe Int
interval   :: Maybe Int                   -- ^ number of units to wait before recurring
  , RRule -> Maybe (NonEmpty Int)
bySecond   :: Maybe (NonEmpty Int)        -- ^ which second(s) to recur on
  , RRule -> Maybe (NonEmpty Int)
byMinute   :: Maybe (NonEmpty Int)        -- ^ which minute(s) to recur on
  , RRule -> Maybe (NonEmpty Int)
byHour     :: Maybe (NonEmpty Int)        -- ^ which hour(s) to recur on
  , RRule -> Maybe (NonEmpty (Int, Day))
byDay      :: Maybe (NonEmpty (Int, Day)) -- ^ which days(s) to recur on
  , RRule -> Maybe (NonEmpty Int)
byWeekNo   :: Maybe (NonEmpty Int)        -- ^ which week number(s) to recur on
  , RRule -> Maybe (NonEmpty Int)
byMonth    :: Maybe (NonEmpty Int)        -- ^ which month(s) to recur on
  , RRule -> Maybe (NonEmpty Int)
byMonthDay :: Maybe (NonEmpty Int)        -- ^ which day(s) of the month to recur on
  , RRule -> Maybe (NonEmpty Int)
byYearDay  :: Maybe (NonEmpty Int)        -- ^ which day(s) of the year to recur on
  , RRule -> Maybe (NonEmpty Int)
bySetPos   :: Maybe (NonEmpty Int)        -- ^ which occurrence of the rule inside the frequency period
  }
  deriving (RRule -> RRule -> Bool
(RRule -> RRule -> Bool) -> (RRule -> RRule -> Bool) -> Eq RRule
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RRule -> RRule -> Bool
$c/= :: RRule -> RRule -> Bool
== :: RRule -> RRule -> Bool
$c== :: RRule -> RRule -> Bool
Eq, Int -> RRule -> ShowS
[RRule] -> ShowS
RRule -> String
(Int -> RRule -> ShowS)
-> (RRule -> String) -> ([RRule] -> ShowS) -> Show RRule
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RRule] -> ShowS
$cshowList :: [RRule] -> ShowS
show :: RRule -> String
$cshow :: RRule -> String
showsPrec :: Int -> RRule -> ShowS
$cshowsPrec :: Int -> RRule -> ShowS
Show)

defaultRRule :: RRule
defaultRRule :: RRule
defaultRRule = RRule :: Bool
-> Maybe Day
-> Maybe Frequency
-> Maybe Int
-> Maybe TimeOrDate
-> Maybe Int
-> Maybe (NonEmpty Int)
-> Maybe (NonEmpty Int)
-> Maybe (NonEmpty Int)
-> Maybe (NonEmpty (Int, Day))
-> Maybe (NonEmpty Int)
-> Maybe (NonEmpty Int)
-> Maybe (NonEmpty Int)
-> Maybe (NonEmpty Int)
-> Maybe (NonEmpty Int)
-> RRule
RRule
  { prefix :: Bool
prefix     = Bool
False
  , weekStart :: Maybe Day
weekStart  = Maybe Day
forall a. Maybe a
Nothing
  , frequency :: Maybe Frequency
frequency  = Maybe Frequency
forall a. Maybe a
Nothing
  , count :: Maybe Int
count      = Maybe Int
forall a. Maybe a
Nothing
  , until :: Maybe TimeOrDate
until      = Maybe TimeOrDate
forall a. Maybe a
Nothing
  , interval :: Maybe Int
interval   = Maybe Int
forall a. Maybe a
Nothing
  , bySecond :: Maybe (NonEmpty Int)
bySecond   = Maybe (NonEmpty Int)
forall a. Maybe a
Nothing
  , byMinute :: Maybe (NonEmpty Int)
byMinute   = Maybe (NonEmpty Int)
forall a. Maybe a
Nothing
  , byHour :: Maybe (NonEmpty Int)
byHour     = Maybe (NonEmpty Int)
forall a. Maybe a
Nothing
  , byDay :: Maybe (NonEmpty (Int, Day))
byDay      = Maybe (NonEmpty (Int, Day))
forall a. Maybe a
Nothing
  , byWeekNo :: Maybe (NonEmpty Int)
byWeekNo   = Maybe (NonEmpty Int)
forall a. Maybe a
Nothing
  , byMonth :: Maybe (NonEmpty Int)
byMonth    = Maybe (NonEmpty Int)
forall a. Maybe a
Nothing
  , byMonthDay :: Maybe (NonEmpty Int)
byMonthDay = Maybe (NonEmpty Int)
forall a. Maybe a
Nothing
  , byYearDay :: Maybe (NonEmpty Int)
byYearDay  = Maybe (NonEmpty Int)
forall a. Maybe a
Nothing
  , bySetPos :: Maybe (NonEmpty Int)
bySetPos   = Maybe (NonEmpty Int)
forall a. Maybe a
Nothing
  }