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(..)
, ToRRule(toRRule)
)
import Text.Megaparsec (parseMaybe)
import qualified Data.List.NonEmpty as NE (NonEmpty(..), toList)
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
toText :: RRule -> Text
toText :: RRule -> Text
toText RRule{Bool
Maybe Int
Maybe (NonEmpty Int)
Maybe (NonEmpty (Int, Day))
Maybe UTCTime
Maybe Day
Maybe Frequency
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 UTCTime
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 UTCTime
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 UTCTime -> Maybe Text
forall a. ToRRule a => Text -> Maybe a -> Maybe Text
labelWith Text
"UNTIL" Maybe UTCTime
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
description :: RRule -> Text
description :: RRule -> Text
description RRule{Bool
Maybe Int
Maybe (NonEmpty Int)
Maybe (NonEmpty (Int, Day))
Maybe UTCTime
Maybe Day
Maybe Frequency
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 UTCTime
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 UTCTime
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
, UTCTime -> Text
untilDescription (UTCTime -> Text) -> Maybe UTCTime -> Maybe Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe UTCTime
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 :: UTCTime -> Text
untilDescription :: UTCTime -> Text
untilDescription 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)
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