{-# LANGUAGE CPP #-}
module WeekDaze.Temporal.TimeslotRequest(
TimeslotRequest(..),
specificallyTag,
countSpecifiedTimes,
countSpecifiedDays,
getMaybeIdealTimeslotId,
getSpecifiedTimes,
findDistinctRunlengthsOfSpecifiedTimes,
isIdeally,
isSpecific,
isNull,
isASpecifiedTime,
isASpecifiedDay
) where
import Control.Arrow((&&&))
import qualified Control.DeepSeq
import qualified Data.Default
import qualified Data.Foldable
import qualified Data.List
import qualified Data.Set
import qualified Text.XML.HXT.Arrow.Pickle as HXT
import qualified ToolShed.Data.List
import qualified ToolShed.Data.List.Runlength
import qualified WeekDaze.Size as Size
import qualified WeekDaze.Temporal.Day as Temporal.Day
import qualified WeekDaze.Temporal.Time as Temporal.Time
tag :: String
tag = "timeslotRequest"
ideallyTag :: String
ideallyTag = "ideally"
specificallyTag :: String
specificallyTag = "specifically"
data TimeslotRequest timeslotId
= Ideally timeslotId
| Specifically (Temporal.Time.TimeSet timeslotId)
deriving (Eq, Ord)
instance Show timeslotId => Show (TimeslotRequest timeslotId) where
showsPrec _ timeslotRequest = showString (tag ++ "={") . (
case timeslotRequest of
Ideally timeslotId -> showString ideallyTag . showChar '=' . shows timeslotId
Specifically timeSet -> showString specificallyTag . showChar '=' . shows (Data.Set.toList timeSet)
) . showChar '}'
instance Data.Default.Default (TimeslotRequest timeslotId) where
def = Specifically Data.Set.empty
instance (HXT.XmlPickler timeslotId, Ord timeslotId) => HXT.XmlPickler (TimeslotRequest timeslotId) where
xpickle = HXT.xpDefault Data.Default.def . HXT.xpElem tag $ HXT.xpAlt (
\timeslotRequest -> if isIdeally timeslotRequest then 0 else 1
) [
HXT.xpElem ideallyTag $ HXT.xpWrap (
Ideally,
\(Ideally timeslotId) -> timeslotId
) HXT.xpickle,
HXT.xpElem specificallyTag . HXT.xpWrap (
Specifically . Data.Set.fromList,
Data.Set.toList . getSpecifiedTimes
) $ HXT.xpList1 HXT.xpickle
]
instance Control.DeepSeq.NFData timeslotId => Control.DeepSeq.NFData (TimeslotRequest timeslotId) where
rnf (Specifically timeSet) = Control.DeepSeq.rnf timeSet
rnf _ = ()
getMaybeIdealTimeslotId :: TimeslotRequest timeslotId -> Maybe timeslotId
getMaybeIdealTimeslotId (Ideally timeslotId) = Just timeslotId
getMaybeIdealTimeslotId _ = Nothing
getSpecifiedTimes :: TimeslotRequest timeslotId -> Temporal.Time.TimeSet timeslotId
getSpecifiedTimes (Specifically timeSet) = timeSet
getSpecifiedTimes _ = Data.Set.empty
countSpecifiedTimes :: TimeslotRequest timeslotId -> Size.NTimeslots
countSpecifiedTimes = Data.Set.size . getSpecifiedTimes
countSpecifiedDays ::
#if !MIN_VERSION_containers(0,5,2)
Ord timeslotId =>
#endif
TimeslotRequest timeslotId -> Size.NDays
countSpecifiedDays = Data.Set.size . Data.Set.map Temporal.Time.getDay . getSpecifiedTimes
isIdeally :: TimeslotRequest timeslotId -> Bool
isIdeally (Ideally _) = True
isIdeally _ = False
isSpecific :: TimeslotRequest timeslotId -> Bool
isSpecific (Specifically _) = True
isSpecific _ = False
isNull :: TimeslotRequest timeslotId -> Bool
isNull = Data.Set.null . getSpecifiedTimes
isASpecifiedTime :: Ord timeslotId => Temporal.Time.Time timeslotId -> TimeslotRequest timeslotId -> Bool
isASpecifiedTime time (Specifically timeSet) = Data.Set.member time timeSet
isASpecifiedTime _ _ = False
isASpecifiedDay :: Temporal.Day.Day -> TimeslotRequest timeslotId -> Bool
isASpecifiedDay day (Specifically timeSet) = Data.Foldable.any ((== day) . Temporal.Time.getDay) timeSet
isASpecifiedDay _ _ = False
groupSpecifiedTimesByDay :: TimeslotRequest timeslotId -> [[Temporal.Time.Time timeslotId]]
groupSpecifiedTimesByDay = Data.List.groupBy (ToolShed.Data.List.equalityBy Temporal.Time.getDay) . Data.Set.toAscList . getSpecifiedTimes
findDistinctRunlengthsOfSpecifiedTimes :: Enum timeslotId => TimeslotRequest timeslotId -> Data.Set.Set Size.NTimeslots
findDistinctRunlengthsOfSpecifiedTimes = Data.Set.fromList . concatMap (
map (
succ . ToolShed.Data.List.Runlength.getLength
) . filter ToolShed.Data.List.Runlength.getDatum . ToolShed.Data.List.Runlength.encode . map (
== 1
) . (
uncurry (
zipWith (-)
) . (
tail &&& id
)
) . map (
fromEnum . Temporal.Time.getTimeslotId
)
) . groupSpecifiedTimesByDay