{-# LANGUAGE CPP, MultiParamTypeClasses #-}
module WeekDaze.Temporal.Day(
Weekend,
Day(),
tag,
nDaysPerWeek,
range,
getYesterday,
getTomorrow,
getAdjacentDays
) where
import Control.Arrow((&&&))
import qualified Control.DeepSeq
import qualified Data.Array.IArray
import qualified Data.Set
import qualified Text.XHtml.Strict
import qualified Text.XML.HXT.Arrow.Pickle as HXT
import qualified Text.XML.HXT.Arrow.Pickle.Schema
import qualified WeekDaze.Size as Size
#ifdef USE_HDBC
import qualified Data.Convertible
import qualified Database.HDBC
instance Data.Convertible.Convertible Database.HDBC.SqlValue Day where
safeConvert = fmap read . Data.Convertible.safeConvert
#endif /* USE_HDBC */
tag :: String
tag = "day"
data Day = Sunday | Monday | Tuesday | Wednesday | Thursday | Friday | Saturday deriving (
Data.Array.IArray.Ix,
Bounded,
Enum,
Eq,
Ord,
Read,
Show
)
instance Text.XHtml.Strict.HTML Day where
toHtml = Text.XHtml.Strict.toHtml . show
instance HXT.XmlPickler Day where
xpickle = HXT.xpElem tag . HXT.xpAttr "value" . HXT.xpWrap (read, show) . HXT.xpTextDT . Text.XML.HXT.Arrow.Pickle.Schema.scEnum $ map show range
instance Control.DeepSeq.NFData Day where
rnf _ = ()
getYesterday :: Day -> Day
getYesterday day
| day == minBound = maxBound
| otherwise = pred day
getTomorrow :: Day -> Day
getTomorrow day
| day == maxBound = minBound
| otherwise = succ day
getAdjacentDays :: Day -> (Day, Day)
getAdjacentDays = getYesterday &&& getTomorrow
nDaysPerWeek :: Size.NDays
nDaysPerWeek = succ $ fromEnum (maxBound :: Day) - fromEnum (minBound :: Day)
range :: [Day]
range = [minBound .. maxBound]
type Weekend = Data.Set.Set Day