module Data.Thyme.Calendar.WeekdayOfMonth where
import Prelude
import Control.Applicative
import Control.DeepSeq
import Control.Lens
import Control.Monad
import Data.AffineSpace
import Data.Data
import Data.Thyme.Calendar
import Data.Thyme.Calendar.Internal
import Data.Thyme.Calendar.MonthDay
import Data.Thyme.TH
data WeekdayOfMonth = WeekdayOfMonth
{ womYear :: !Year
, womMonth :: !Month
, womNth :: !Int
, womDayOfWeek :: !DayOfWeek
} deriving (Eq, Ord, Data, Typeable, Show)
instance NFData WeekdayOfMonth
weekdayOfMonth :: Iso' Day WeekdayOfMonth
weekdayOfMonth = iso toWeekday fromWeekday where
toWeekday :: Day -> WeekdayOfMonth
toWeekday day@(view ordinalDate -> ord) = WeekdayOfMonth y m n wd where
YearMonthDay y m d = view yearMonthDay ord
WeekDate _ _ wd = toWeekOrdinal ord day
n = div (d 1) 7
fromWeekday :: WeekdayOfMonth -> Day
fromWeekday (WeekdayOfMonth y m n wd) = refDay .+^ s * offset where
refOrd = review yearMonthDay . YearMonthDay y m $
if n < 0 then monthLength (isLeapYear y) m else 1
refDay = review ordinalDate refOrd
WeekDate _ _ wd1 = toWeekOrdinal refOrd refDay
s = signum n
wo = s * (wd wd1)
offset = (abs n 1) * 7 + if wo < 0 then wo + 7 else wo
weekdayOfMonthValid :: WeekdayOfMonth -> Maybe Day
weekdayOfMonthValid (WeekdayOfMonth y m n wd) = (refDay .+^ s * offset)
<$ guard (n /= 0 && 1 <= wd && wd <= 7 && offset < len) where
len = monthLength (isLeapYear y) m
refOrd = review yearMonthDay $ YearMonthDay y m (if n < 0 then len else 1)
refDay = review ordinalDate refOrd
WeekDate _ _ wd1 = toWeekOrdinal refOrd refDay
s = signum n
wo = s * (wd wd1)
offset = (abs n 1) * 7 + if wo < 0 then wo + 7 else wo
thymeLenses ''WeekdayOfMonth