module Data.Time.RRule
  ( fromText
  , toText
  , defaultRRule
  , description
  , RRule(..)
  , Day(..)
  , Frequency(..)
  )
where

import Data.Maybe (catMaybes, isJust)
import Data.Text (Text, intercalate, pack, unpack)
import Data.Time.Clock (UTCTime)
import Data.Time.Format (formatTime, defaultTimeLocale)
import Data.Time.RRule.Parse (parseRRule)
import Data.Time.RRule.Types as Ty
  ( defaultRRule
  , RRule(..)
  , Day(..)
  , Frequency(..)
  , TimeOrDate(..)
  , ToRRule(toRRule)
  )
import Text.Megaparsec (parseMaybe)
import qualified Data.List.NonEmpty as NE (NonEmpty(..), toList)

-- | Parses RFC 5545 recurrence rule text into an RRule
fromText :: Text -> Maybe RRule
fromText :: Text -> Maybe RRule
fromText = Parsec () Text RRule -> Text -> Maybe RRule
forall e s a. (Ord e, Stream s) => Parsec e s a -> s -> Maybe a
parseMaybe Parsec () Text RRule
parseRRule

-- | Formats RRule as RFC 5545 recurrence rule text
toText :: RRule -> Text
toText :: RRule -> Text
toText RRule{Bool
Maybe Int
Maybe (NonEmpty Int)
Maybe (NonEmpty (Int, Day))
Maybe Day
Maybe Frequency
Maybe TimeOrDate
bySetPos :: RRule -> Maybe (NonEmpty Int)
byYearDay :: RRule -> Maybe (NonEmpty Int)
byMonthDay :: RRule -> Maybe (NonEmpty Int)
byMonth :: RRule -> Maybe (NonEmpty Int)
byWeekNo :: RRule -> Maybe (NonEmpty Int)
byDay :: RRule -> Maybe (NonEmpty (Int, Day))
byHour :: RRule -> Maybe (NonEmpty Int)
byMinute :: RRule -> Maybe (NonEmpty Int)
bySecond :: RRule -> Maybe (NonEmpty Int)
interval :: RRule -> Maybe Int
until :: RRule -> Maybe TimeOrDate
count :: RRule -> Maybe Int
frequency :: RRule -> Maybe Frequency
weekStart :: RRule -> Maybe Day
prefix :: RRule -> Bool
bySetPos :: Maybe (NonEmpty Int)
byYearDay :: Maybe (NonEmpty Int)
byMonthDay :: Maybe (NonEmpty Int)
byMonth :: Maybe (NonEmpty Int)
byWeekNo :: Maybe (NonEmpty Int)
byDay :: Maybe (NonEmpty (Int, Day))
byHour :: Maybe (NonEmpty Int)
byMinute :: Maybe (NonEmpty Int)
bySecond :: Maybe (NonEmpty Int)
interval :: Maybe Int
until :: Maybe TimeOrDate
count :: Maybe Int
frequency :: Maybe Frequency
weekStart :: Maybe Day
prefix :: Bool
..} =
  (if Bool
prefix then Text
"RRULE:" else Text
"") Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>
  (Text -> [Text] -> Text
intercalate Text
";" ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$ [Maybe Text] -> [Text]
forall a. [Maybe a] -> [a]
catMaybes
    [ Text -> Maybe Day -> Maybe Text
forall a. ToRRule a => Text -> Maybe a -> Maybe Text
labelWith Text
"WKST"       Maybe Day
weekStart
    , Text -> Maybe Frequency -> Maybe Text
forall a. ToRRule a => Text -> Maybe a -> Maybe Text
labelWith Text
"FREQ"       Maybe Frequency
frequency
    , Text -> Maybe Int -> Maybe Text
forall a. ToRRule a => Text -> Maybe a -> Maybe Text
labelWith Text
"COUNT"      Maybe Int
count
    , Text -> Maybe TimeOrDate -> Maybe Text
forall a. ToRRule a => Text -> Maybe a -> Maybe Text
labelWith Text
"UNTIL"      Maybe TimeOrDate
until
    , Text -> Maybe Int -> Maybe Text
forall a. ToRRule a => Text -> Maybe a -> Maybe Text
labelWith Text
"INTERVAL"   Maybe Int
interval
    , Text -> Maybe (NonEmpty Int) -> Maybe Text
forall a. ToRRule a => Text -> Maybe a -> Maybe Text
labelWith Text
"BYSECOND"   Maybe (NonEmpty Int)
bySecond
    , Text -> Maybe (NonEmpty Int) -> Maybe Text
forall a. ToRRule a => Text -> Maybe a -> Maybe Text
labelWith Text
"BYMINUTE"   Maybe (NonEmpty Int)
byMinute
    , Text -> Maybe (NonEmpty Int) -> Maybe Text
forall a. ToRRule a => Text -> Maybe a -> Maybe Text
labelWith Text
"BYHOUR"     Maybe (NonEmpty Int)
byHour
    , Text -> Maybe (NonEmpty (Int, Day)) -> Maybe Text
forall a. ToRRule a => Text -> Maybe a -> Maybe Text
labelWith Text
"BYDAY"      Maybe (NonEmpty (Int, Day))
byDay
    , Text -> Maybe (NonEmpty Int) -> Maybe Text
forall a. ToRRule a => Text -> Maybe a -> Maybe Text
labelWith Text
"BYWEEKNO"   Maybe (NonEmpty Int)
byWeekNo
    , Text -> Maybe (NonEmpty Int) -> Maybe Text
forall a. ToRRule a => Text -> Maybe a -> Maybe Text
labelWith Text
"BYMONTH"    Maybe (NonEmpty Int)
byMonth
    , Text -> Maybe (NonEmpty Int) -> Maybe Text
forall a. ToRRule a => Text -> Maybe a -> Maybe Text
labelWith Text
"BYMONTHDAY" Maybe (NonEmpty Int)
byMonthDay
    , Text -> Maybe (NonEmpty Int) -> Maybe Text
forall a. ToRRule a => Text -> Maybe a -> Maybe Text
labelWith Text
"BYYEARDAY"  Maybe (NonEmpty Int)
byYearDay
    , Text -> Maybe (NonEmpty Int) -> Maybe Text
forall a. ToRRule a => Text -> Maybe a -> Maybe Text
labelWith Text
"BYSETPOS"   Maybe (NonEmpty Int)
bySetPos
    ])

labelWith :: ToRRule a => Text -> Maybe a -> Maybe Text
labelWith :: Text -> Maybe a -> Maybe Text
labelWith Text
_ Maybe a
Nothing = Maybe Text
forall a. Maybe a
Nothing
labelWith Text
label (Just a
x) = Text -> Maybe Text
forall a. a -> Maybe a
Just (Text -> Maybe Text) -> Text -> Maybe Text
forall a b. (a -> b) -> a -> b
$ Text
label Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"=" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> a -> Text
forall a. ToRRule a => a -> Text
toRRule a
x

-- | Describes what an RRule means, in English
description :: RRule -> Text
description :: RRule -> Text
description RRule{Bool
Maybe Int
Maybe (NonEmpty Int)
Maybe (NonEmpty (Int, Day))
Maybe Day
Maybe Frequency
Maybe TimeOrDate
bySetPos :: Maybe (NonEmpty Int)
byYearDay :: Maybe (NonEmpty Int)
byMonthDay :: Maybe (NonEmpty Int)
byMonth :: Maybe (NonEmpty Int)
byWeekNo :: Maybe (NonEmpty Int)
byDay :: Maybe (NonEmpty (Int, Day))
byHour :: Maybe (NonEmpty Int)
byMinute :: Maybe (NonEmpty Int)
bySecond :: Maybe (NonEmpty Int)
interval :: Maybe Int
until :: Maybe TimeOrDate
count :: Maybe Int
frequency :: Maybe Frequency
weekStart :: Maybe Day
prefix :: Bool
bySetPos :: RRule -> Maybe (NonEmpty Int)
byYearDay :: RRule -> Maybe (NonEmpty Int)
byMonthDay :: RRule -> Maybe (NonEmpty Int)
byMonth :: RRule -> Maybe (NonEmpty Int)
byWeekNo :: RRule -> Maybe (NonEmpty Int)
byDay :: RRule -> Maybe (NonEmpty (Int, Day))
byHour :: RRule -> Maybe (NonEmpty Int)
byMinute :: RRule -> Maybe (NonEmpty Int)
bySecond :: RRule -> Maybe (NonEmpty Int)
interval :: RRule -> Maybe Int
until :: RRule -> Maybe TimeOrDate
count :: RRule -> Maybe Int
frequency :: RRule -> Maybe Frequency
weekStart :: RRule -> Maybe Day
prefix :: RRule -> Bool
..} = Text -> [Text] -> Text
intercalate Text
" " ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$ [Maybe Text] -> [Text]
forall a. [Maybe a] -> [a]
catMaybes
  [ Text -> (Int -> Text) -> Text -> Maybe (NonEmpty Int) -> Maybe Text
forall a.
Text -> (a -> Text) -> Text -> Maybe (NonEmpty a) -> Maybe Text
byDescription Text
"the" Int -> Text
ordinal Text
"instance of" Maybe (NonEmpty Int)
bySetPos
  , if Maybe Frequency -> Bool
forall a. Maybe a -> Bool
isJust Maybe Frequency
frequency then Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"every" else Maybe Text
forall a. Maybe a
Nothing
  , Int -> Maybe Text
intervalDescription (Int -> Maybe Text) -> Maybe Int -> Maybe Text
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Maybe Int
interval
  , Frequency -> Text
frequencyDescription (Frequency -> Text) -> Maybe Frequency -> Maybe Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Frequency
frequency
  , Text -> Maybe (NonEmpty Int) -> Maybe Text
byUsualDescription Text
"second" Maybe (NonEmpty Int)
bySecond
  , Text -> Maybe (NonEmpty Int) -> Maybe Text
byUsualDescription Text
"minute" Maybe (NonEmpty Int)
byMinute
  , Text -> Maybe (NonEmpty Int) -> Maybe Text
byUsualDescription Text
"hour" Maybe (NonEmpty Int)
byHour
  , Text
-> ((Int, Day) -> Text)
-> Text
-> Maybe (NonEmpty (Int, Day))
-> Maybe Text
forall a.
Text -> (a -> Text) -> Text -> Maybe (NonEmpty a) -> Maybe Text
byDescription Text
"on" (Int, Day) -> Text
ordinalDay Text
"" Maybe (NonEmpty (Int, Day))
byDay
  , Text -> Maybe (NonEmpty Int) -> Maybe Text
byUsualDescription Text
"week of the year" Maybe (NonEmpty Int)
byWeekNo
  , Text -> (Int -> Text) -> Text -> Maybe (NonEmpty Int) -> Maybe Text
forall a.
Text -> (a -> Text) -> Text -> Maybe (NonEmpty a) -> Maybe Text
byDescription Text
"in" Int -> Text
monthDescription Text
"" Maybe (NonEmpty Int)
byMonth
  , Text -> Maybe (NonEmpty Int) -> Maybe Text
byUsualDescription Text
"day of the month" Maybe (NonEmpty Int)
byMonthDay
  , Text -> Maybe (NonEmpty Int) -> Maybe Text
byUsualDescription Text
"day of the year" Maybe (NonEmpty Int)
byYearDay
  , Int -> Text
countDescription (Int -> Text) -> Maybe Int -> Maybe Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Int
count
  , TimeOrDate -> Text
untilDescription (TimeOrDate -> Text) -> Maybe TimeOrDate -> Maybe Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe TimeOrDate
until
  , Day -> Text
weekStartDescription (Day -> Text) -> Maybe Day -> Maybe Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Day
weekStart
  ]

ordinal :: Int -> Text
ordinal :: Int -> Text
ordinal Int
n
  | Int
n Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== -Int
1 = Text
"last"
  | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 = Int -> Text
ordinal (Int -> Int
forall a. Num a => a -> a
abs Int
n) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" from last"
  | Int -> Int
forall a. Integral a => a -> a
lastDigits Int
n Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
11 = Int -> Text
forall a. Show a => a -> Text
showText Int
n Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"th"
  | Int -> Int
forall a. Integral a => a -> a
lastDigits Int
n Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
12 = Int -> Text
forall a. Show a => a -> Text
showText Int
n Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"th"
  | Int -> Int
forall a. Integral a => a -> a
lastDigits Int
n Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
13 = Int -> Text
forall a. Show a => a -> Text
showText Int
n Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"th"
  | Int -> Int
forall a. Integral a => a -> a
lastDigit  Int
n Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
==  Int
1 = Int -> Text
forall a. Show a => a -> Text
showText Int
n Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"st"
  | Int -> Int
forall a. Integral a => a -> a
lastDigit  Int
n Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
==  Int
2 = Int -> Text
forall a. Show a => a -> Text
showText Int
n Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"nd"
  | Int -> Int
forall a. Integral a => a -> a
lastDigit  Int
n Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
==  Int
3 = Int -> Text
forall a. Show a => a -> Text
showText Int
n Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"rd"
  | Bool
otherwise = Int -> Text
forall a. Show a => a -> Text
showText Int
n Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"th"
  where lastDigit :: a -> a
lastDigit a
n = a
n a -> a -> a
forall a. Integral a => a -> a -> a
`mod` a
10
        lastDigits :: a -> a
lastDigits a
n = a
n a -> a -> a
forall a. Integral a => a -> a -> a
`mod` a
100

ordinalDay :: (Int, Day) -> Text
ordinalDay :: (Int, Day) -> Text
ordinalDay (Int
0, Day
d) = Day -> Text
forall a. Show a => a -> Text
showText Day
d
ordinalDay (Int
n, Day
d) = Text
"the " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text
ordinal Int
n Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Day -> Text
forall a. Show a => a -> Text
showText Day
d

byUsualDescription :: Text -> Maybe (NE.NonEmpty Int) -> Maybe Text
byUsualDescription :: Text -> Maybe (NonEmpty Int) -> Maybe Text
byUsualDescription Text
t = Text -> (Int -> Text) -> Text -> Maybe (NonEmpty Int) -> Maybe Text
forall a.
Text -> (a -> Text) -> Text -> Maybe (NonEmpty a) -> Maybe Text
byDescription Text
"on the" Int -> Text
ordinal Text
t

byDescription :: Text -> (a -> Text) -> Text -> Maybe (NE.NonEmpty a) -> Maybe Text
byDescription :: Text -> (a -> Text) -> Text -> Maybe (NonEmpty a) -> Maybe Text
byDescription Text
_ a -> Text
_ Text
_ Maybe (NonEmpty a)
Nothing = Maybe Text
forall a. Maybe a
Nothing
byDescription Text
inOrOn a -> Text
toOrdinal Text
t (Just NonEmpty a
ns) =
  Text -> Maybe Text
forall a. a -> Maybe a
Just (Text -> Maybe Text) -> Text -> Maybe Text
forall a b. (a -> b) -> a -> b
$ Text
inOrOn Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
andedList Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
timePeriod
  where andedList :: Text
andedList = [Text] -> Text
intercalateAnd ([Text] -> Text) -> ([a] -> [Text]) -> [a] -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> Text) -> [a] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map a -> Text
toOrdinal ([a] -> Text) -> [a] -> Text
forall a b. (a -> b) -> a -> b
$ NonEmpty a -> [a]
forall a. NonEmpty a -> [a]
NE.toList NonEmpty a
ns
        timePeriod :: Text
timePeriod = if Text
t Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"" then Text
"" else Text
" " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
t

intercalateAnd :: [Text] -> Text
intercalateAnd :: [Text] -> Text
intercalateAnd [Text
t1, Text
t2, Text
t3] = Text
t1 Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
", " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
t2 Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
", and " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
t3
intercalateAnd [Text
t1, Text
t2] = Text
t1 Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" and " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
t2
intercalateAnd [Text
t] = Text
t
intercalateAnd [] = Text
""
intercalateAnd (Text
t:[Text]
ts) = Text
t Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
", " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> [Text] -> Text
intercalateAnd [Text]
ts

monthDescription :: Int -> Text
monthDescription :: Int -> Text
monthDescription = \case
  Int
1  -> Text
"January"
  Int
2  -> Text
"February"
  Int
3  -> Text
"March"
  Int
4  -> Text
"April"
  Int
5  -> Text
"May"
  Int
6  -> Text
"June"
  Int
7  -> Text
"July"
  Int
8  -> Text
"August"
  Int
9  -> Text
"September"
  Int
10 -> Text
"October"
  Int
11 -> Text
"November"
  Int
12 -> Text
"December"

showText :: Show a => a -> Text
showText :: a -> Text
showText = 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

intervalDescription :: Int -> Maybe Text
intervalDescription :: Int -> Maybe Text
intervalDescription Int
n = case Int
n of
  Int
0 -> Maybe Text
forall a. Maybe a
Nothing
  Int
1 -> Maybe Text
forall a. Maybe a
Nothing
  Int
2 -> Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"other"
  Int
n -> Text -> Maybe Text
forall a. a -> Maybe a
Just (Text -> Maybe Text) -> Text -> Maybe Text
forall a b. (a -> b) -> a -> b
$ Int -> Text
ordinal Int
n

frequencyDescription :: Frequency -> Text
frequencyDescription :: Frequency -> Text
frequencyDescription Frequency
freq = case Frequency
freq of
  Frequency
Secondly -> Text
"second"
  Frequency
Minutely -> Text
"minute"
  Frequency
Hourly   -> Text
"hour"
  Frequency
Daily    -> Text
"day"
  Frequency
Weekly   -> Text
"week"
  Frequency
Monthly  -> Text
"month"
  Frequency
Yearly   -> Text
"year"

countDescription :: Int -> Text
countDescription :: Int -> Text
countDescription Int
n = Text
"for " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text
forall a. Show a => a -> Text
showText Int
n Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" occurrences"

untilDescription :: Ty.TimeOrDate -> Text
untilDescription :: TimeOrDate -> Text
untilDescription (Ty.Time UTCTime
t) = Text
"until " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> (String -> Text
pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ TimeLocale -> String -> UTCTime -> String
forall t. FormatTime t => TimeLocale -> String -> t -> String
formatTime TimeLocale
defaultTimeLocale String
"%B %d, %Y at %H:%M:%S" UTCTime
t)
untilDescription (Ty.Date Day
d) = Text
"until " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> (String -> Text
pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ TimeLocale -> String -> Day -> String
forall t. FormatTime t => TimeLocale -> String -> t -> String
formatTime TimeLocale
defaultTimeLocale String
"%B %d, %Y" Day
d)

weekStartDescription :: Day -> Text
weekStartDescription :: Day -> Text
weekStartDescription Day
d = Text
"with weeks starting on " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Day -> Text
forall a. Show a => a -> Text
showText Day
d