module Data.UTC.Type.Date
( Date ()
) where
import Control.Monad.Catch
import Data.Ratio
import Data.UTC.Class.Epoch
import Data.UTC.Class.IsDate
import Data.UTC.Class.IsUnixTime
import Data.UTC.Internal
import Data.UTC.Type.Exception
data Date
= Date
{ dYear :: Integer
, dMonth :: Integer
, dDay :: Integer
} deriving (Eq, Ord)
instance Show Date where
show (Date yy mm dd)
= concat
[ if yy < 0
then "-"
else ""
, if abs yy > 9999
then show (abs yy)
else fixedDecimal 4 (abs yy)
, "-"
, fixedDecimal 2 mm
, "-"
, fixedDecimal 2 dd
]
instance Epoch Date where
epoch
= Date
{ dYear = 1970
, dMonth = 1
, dDay = 1
}
instance IsUnixTime Date where
unixSeconds t
= (days * secsPerDay % 1)
deltaUnixEpochCommonEpoch
where
days = yearMonthDayToDays (year t, month t, day t)
fromUnixSeconds u
= return
$ Date
{ dYear = y
, dMonth = m
, dDay = d
}
where
s = u + deltaUnixEpochCommonEpoch
(y, m, d) = daysToYearMonthDay (truncate s `div` secsPerDay)
instance IsDate Date where
year
= dYear
month
= dMonth
day
= dDay
setYear x t
= if isValidDate (x, month t, day t)
then return $ t { dYear = x }
else throwM $ UtcException $ "IsDate Date: setYear " ++ show x ++ " " ++ show t
setMonth x t
= if isValidDate (year t, x, day t)
then return $ t { dMonth = x }
else throwM $ UtcException $ "IsDate Date: setMonth " ++ show x ++ " " ++ show t
setDay x t
= if isValidDate (year t, month t, x)
then return $ t { dDay = x }
else throwM $ UtcException $ "IsDate Date: setDay " ++ show x ++ " " ++ show t