{-# LANGUAGE CPP, FlexibleContexts #-}
module WeekDaze.Temporal.Time(
TimeSet,
TimesByDay,
Time(
getDay,
getTimeslotId
),
calculateNTimeslotsPerWeek,
calculateDistance,
calculateAbsoluteDistance,
categoriseByDay,
shift,
shiftTime,
#ifdef USE_HDBC
mkTimeFromSql,
#endif
mkTime
) where
import qualified Control.Arrow
import Control.Arrow((&&&))
import qualified Control.DeepSeq
import qualified Data.Map
import qualified Data.Set
import qualified Text.XHtml.Strict
import Text.XHtml.Strict((+++))
import qualified Text.XML.HXT.Arrow.Pickle as HXT
import qualified WeekDaze.Size as Size
import qualified WeekDaze.Temporal.Day as Temporal.Day
#ifdef USE_HDBC
import qualified Database.HDBC
import qualified Data.Convertible
import qualified WeekDaze.Database.Selector as Database.Selector
mkTimeFromSql
:: Data.Convertible.Convertible Database.HDBC.SqlValue timeslotId
=> Database.HDBC.SqlValue
-> Database.HDBC.SqlValue
-> Time timeslotId
mkTimeFromSql daySql = mkTime (
either (
error . showString "WeekDaze.Temporal.Time.mkTimeFromSql:\tfailed to parse the value for " . shows Temporal.Day.tag . showString " read from the database; " . show
) id $ Database.HDBC.safeFromSql daySql
) . either (
error . showString "WeekDaze.Temporal.Time.mkTimeFromSql:\tfailed to parse the value for " . shows Database.Selector.timeslotIdColumnName . showString " read from the database; " . show
) id . Database.HDBC.safeFromSql
#endif /* USE_HDBC */
data Time timeslotId = MkTime {
getDay :: Temporal.Day.Day,
getTimeslotId :: timeslotId
} deriving (Eq, Ord)
instance Control.DeepSeq.NFData timeslotId => Control.DeepSeq.NFData (Time timeslotId) where
rnf = Control.DeepSeq.rnf . (getDay &&& getTimeslotId)
mkTime :: Temporal.Day.Day -> timeslotId -> Time timeslotId
mkTime = MkTime
tag :: String
tag = "time"
instance Read timeslotId => Read (Time timeslotId) where
readsPrec _ = map (Control.Arrow.first $ uncurry MkTime) . reads
instance Show timeslotId => Show (Time timeslotId) where
showsPrec _ = shows . (getDay &&& getTimeslotId)
instance Text.XHtml.Strict.HTML timeslotId => Text.XHtml.Strict.HTML (Time timeslotId) where
toHtml time = getDay time +++ Text.XHtml.Strict.spaceHtml +++ getTimeslotId time
instance HXT.XmlPickler timeslotId => HXT.XmlPickler (Time timeslotId) where
xpickle = HXT.xpElem tag $ HXT.xpWrap (
uncurry MkTime,
getDay &&& getTimeslotId
) HXT.xpickle
calculateNTimeslotsPerWeek :: Size.NTimeslots -> Size.NTimeslots
calculateNTimeslotsPerWeek = (Temporal.Day.nDaysPerWeek *)
calculateDistance :: Enum timeslotId => timeslotId -> timeslotId -> Size.NTimeslots
calculateDistance x y = fromEnum x - fromEnum y
calculateAbsoluteDistance :: Enum timeslotId => timeslotId -> timeslotId -> Size.NTimeslots
calculateAbsoluteDistance x y = abs $ calculateDistance x y
shift :: Enum timeslotId => Size.NTimeslots -> timeslotId -> timeslotId
shift i = toEnum . (+ i) . fromEnum
shiftTime :: Enum timeslotId => Size.NTimeslots -> Time timeslotId -> Time timeslotId
shiftTime i = uncurry MkTime . (getDay &&& shift i . getTimeslotId)
type TimeSet timeslotId = Data.Set.Set (Time timeslotId)
type TimesByDay timeslotId = Data.Map.Map Temporal.Day.Day (Data.Set.Set timeslotId)
categoriseByDay :: Ord timeslotId => TimeSet timeslotId -> TimesByDay timeslotId
categoriseByDay = Data.Set.foldr (
uncurry (Data.Map.insertWith Data.Set.union) . (getDay &&& Data.Set.singleton . getTimeslotId)
) Data.Map.empty