module Data.Thyme.Calendar (
Day (..)
, Year, Month, DayOfMonth
, YearMonthDay (..)
, isLeapYear
, module Data.Thyme.Calendar
) where
import Prelude hiding ((.))
import Control.Applicative
import Control.Category
import Control.Lens
import Data.Thyme.Calendar.Internal
import Data.Thyme.Calendar.MonthDay
import Data.Thyme.Format.Internal
import Data.Thyme.TH
yearMonthDay :: Simple Iso OrdinalDate YearMonthDay
yearMonthDay = iso fromOrdinal toOrdinal where
fromOrdinal :: OrdinalDate -> YearMonthDay
fromOrdinal (OrdinalDate y yd) = YearMonthDay y m d where
MonthDay m d = view (monthDay (isLeapYear y)) yd
toOrdinal :: YearMonthDay -> OrdinalDate
toOrdinal (YearMonthDay y m d) = OrdinalDate y $
review (monthDay (isLeapYear y)) (MonthDay m d)
gregorian :: Simple Iso Day YearMonthDay
gregorian = ordinalDate . yearMonthDay
gregorianValid :: YearMonthDay -> Maybe Day
gregorianValid (YearMonthDay y m d) = review ordinalDate . OrdinalDate y
<$> monthDayToDayOfYearValid (isLeapYear y) (MonthDay m d)
showGregorian :: Day -> String
showGregorian (view gregorian -> YearMonthDay y m d) =
shows04 y . (:) '-' . shows02 m . (:) '-' . shows02 d $ ""
#if SHOW_INTERNAL
deriving instance Show Day
#else
instance Show Day where show = showGregorian
#endif
gregorianMonthLength :: Year -> Month -> Int
gregorianMonthLength = monthLength . isLeapYear
thymeLenses ''Day
thymeLenses ''YearMonthDay