{-# LANGUAGE CPP, MultiParamTypeClasses #-}
module WeekDaze.Temporal.Availability(
Availability(
deconstruct
),
tag,
calculateAvailabilityRatio,
countDaysPerWeekAvailable,
countInternalAvailabilityGaps,
findIntersection,
findIntersections,
findUnions,
mkAvailability,
isFulltime,
isUnavailable,
isAvailableOn
#ifdef USE_HDBC
,fromMySqlSet
,toMySqlSet
#endif
) where
import Control.Arrow((&&&))
import qualified Control.DeepSeq
import qualified Data.Default
import qualified Data.Foldable
import qualified Data.Set
import qualified Text.XML.HXT.Arrow.Pickle as HXT
import qualified ToolShed.SelfValidate
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
instance Data.Convertible.Convertible Database.HDBC.SqlValue Availability where
safeConvert = fmap fromMySqlSet . Data.Convertible.safeConvert
fromMySqlSet :: String -> Availability
fromMySqlSet = mkAvailability . Database.Selector.fromMySqlSet
toMySqlSet :: Availability -> String
toMySqlSet = Database.Selector.toMySqlSet . Data.Set.toList . deconstruct
#endif /* USE_HDBC */
tag :: String
tag = "availability"
newtype Availability = MkAvailability {
deconstruct :: Data.Set.Set Temporal.Day.Day
} deriving (Eq, Ord)
instance Show Availability where
showsPrec _ = shows . Data.Set.toList . deconstruct
instance Control.DeepSeq.NFData Availability where
rnf = Control.DeepSeq.rnf . deconstruct
fulltime :: Availability
fulltime = mkAvailability Temporal.Day.range
unavailable :: Availability
unavailable = MkAvailability Data.Set.empty
instance Data.Default.Default Availability where
def = fulltime
mkAvailability :: [Temporal.Day.Day] -> Availability
mkAvailability days
| ToolShed.SelfValidate.isValid availability = availability
| otherwise = error $ "WeekDaze.Temporal.Availability.mkAvailability:\t" ++ ToolShed.SelfValidate.getFirstError availability ++ "."
where
availability = MkAvailability $ Data.Set.fromList days
instance ToolShed.SelfValidate.SelfValidator Availability where
getErrors availability = ToolShed.SelfValidate.extractErrors [(isUnavailable availability, "no availability")]
instance HXT.XmlPickler Availability where
xpickle = HXT.xpElem tag . HXT.xpWrap (
mkAvailability,
Data.Set.toList . deconstruct
) $ HXT.xpList1 HXT.xpickle
countDaysPerWeekAvailable :: Availability -> Size.NDays
countDaysPerWeekAvailable = Data.Set.size . deconstruct
countInternalAvailabilityGaps :: Availability -> Size.NDays
countInternalAvailabilityGaps available
| isUnavailable available = 0
| otherwise = length . filter (
> 1
) . uncurry (
zipWith (-)
) . (
map fromEnum . tail &&& map fromEnum . init
) . Data.Set.toAscList $ deconstruct available
calculateAvailabilityRatio :: Fractional f => Availability -> f
calculateAvailabilityRatio = (/ fromIntegral Temporal.Day.nDaysPerWeek) . fromIntegral . countDaysPerWeekAvailable
findIntersection :: Availability -> Availability -> Availability
findIntersection (MkAvailability l) (MkAvailability r) = MkAvailability $ Data.Set.intersection l r
findIntersections :: Data.Foldable.Foldable foldable => foldable Availability -> Availability
findIntersections = Data.Foldable.foldr findIntersection fulltime
findUnion :: Availability -> Availability -> Availability
findUnion (MkAvailability l) (MkAvailability r) = MkAvailability $ Data.Set.union l r
findUnions :: Data.Foldable.Foldable foldable => foldable Availability -> Availability
findUnions = Data.Foldable.foldr findUnion unavailable
isFulltime :: Availability -> Bool
isFulltime = (== Temporal.Day.nDaysPerWeek) . Data.Set.size . deconstruct
isUnavailable :: Availability -> Bool
isUnavailable = Data.Set.null . deconstruct
isAvailableOn :: Temporal.Day.Day -> Availability -> Bool
isAvailableOn day = (day `Data.Set.member`) . deconstruct