{-# LANGUAGE CPP, FlexibleContexts #-}
module WeekDaze.Aggregate.GroupCatalogue(
GroupCatalogue,
ResourceIdsByGroupId,
tag,
extractDistinctMeetingLocationIds,
getMeetingTimes
#ifdef USE_HDBC
,fromDatabase
#endif
) where
import qualified Data.Map
import Data.Map((!))
import qualified Data.Maybe
import qualified Data.Set
import qualified WeekDaze.Data.Group as Data.Group
import qualified WeekDaze.Data.Location as Data.Location
import qualified WeekDaze.Data.Resource as Data.Resource
import qualified WeekDaze.Temporal.Time as Temporal.Time
#ifdef USE_HDBC
import qualified Database.HDBC
import qualified Data.Convertible
import qualified WeekDaze.Database.Selector as Database.Selector
import qualified WeekDaze.Temporal.Day as Temporal.Day
fromDatabase :: (
Database.HDBC.IConnection connection,
Data.Convertible.Convertible Database.HDBC.SqlValue locationId,
Data.Convertible.Convertible Database.HDBC.SqlValue timeslotId,
Ord timeslotId
)
=> connection
-> Database.HDBC.SqlValue
-> IO (GroupCatalogue timeslotId locationId)
fromDatabase connection projectIdSql = let
groupCatalogueIdColumnName :: Database.Selector.ColumnName
groupCatalogueIdColumnName = showString tag "Id";
groupCatalogueTableName, meetingTimesTableName :: Database.Selector.TableName
groupCatalogueTableName = showString Database.Selector.tablePrefix tag
meetingTimesTableName = showString Database.Selector.tablePrefix "meetingTime"
in do
#ifdef USE_HDBC_ODBC
selectMeetingTimesForGroupCatalogueId <- Database.Selector.prepare connection [Temporal.Day.tag, Database.Selector.timeslotIdColumnName] [meetingTimesTableName] [groupCatalogueIdColumnName]
#endif
Database.Selector.select connection [
groupCatalogueIdColumnName,
Data.Group.groupIdTag,
Database.Selector.locationIdColumnName,
Data.Group.mandatesAttendanceTag
] [groupCatalogueTableName] [(Database.Selector.projectIdColumnName, projectIdSql)] >>= fmap Data.Map.fromList . mapM (
\groupRow -> case groupRow of
[groupCatalogueIdSql, groupIdSql, locationIdSql, mandatesAttendanceSql] -> do
meetingTimes <- (
Data.Set.fromList . map (
\meetingTimesRow -> case meetingTimesRow of
[day, timeslotId] -> Temporal.Time.mkTimeFromSql day timeslotId
_ -> error . showString "WeekDaze.Aggregate.GroupCatalogue.fromDatabase:\tunexpected number of columns=" . shows (length meetingTimesRow) . showString " in row of table " . shows meetingTimesTableName . showString ", where " . showString Data.Group.groupIdTag . showChar '=' $ shows groupIdSql "."
)
#ifdef USE_HDBC_ODBC
) `fmap` (
Database.HDBC.execute selectMeetingTimesForGroupCatalogueId [groupCatalogueIdSql] >> Database.HDBC.fetchAllRows' selectMeetingTimesForGroupCatalogueId
)
#else
) `fmap` Database.Selector.select connection [
Temporal.Day.tag,
Database.Selector.timeslotIdColumnName
] [meetingTimesTableName] [(groupCatalogueIdColumnName, groupCatalogueIdSql)]
#endif
return (
Data.Maybe.fromMaybe (
error . showString "WeekDaze.Aggregate.GroupCatalogue.fromDatabase:\tnull " $ shows Data.Group.groupIdTag "."
) $ Database.HDBC.fromSql groupIdSql,
Data.Group.mkProfile meetingTimes (
Database.HDBC.fromSql locationIdSql
) $ Data.Maybe.fromMaybe Data.Group.defaultMandatesAttendance . either (
error . showString "WeekDaze.Aggregate.GroupCatalogue.fromDatabase:\tfailed to parse the value for " . shows Data.Group.mandatesAttendanceTag . showString " read from the database; " . show
) id $ Database.HDBC.safeFromSql mandatesAttendanceSql
)
_ -> error . showString "WeekDaze.Aggregate.GroupCatalogue.fromDatabase:\tunexpected number of columns=" . shows (length groupRow) . showString " in row of table " $ shows groupCatalogueTableName "."
)
#endif /* USE_HDBC */
tag :: String
tag = "groupCatalogue"
type GroupCatalogue timeslotId locationId = Data.Resource.ResourceMap Data.Group.Id (Data.Group.Profile timeslotId locationId)
type ResourceIdsByGroupId resourceId = Data.Map.Map Data.Group.Id (Data.Set.Set resourceId)
extractDistinctMeetingLocationIds :: Ord locationId => GroupCatalogue timeslotId locationId -> Data.Location.Locus locationId
extractDistinctMeetingLocationIds = Data.Map.foldr (\profile locus -> Data.Maybe.maybe locus (`Data.Set.insert` locus) $ Data.Group.getMaybeLocationId profile) Data.Set.empty
getMeetingTimes :: Ord timeslotId => GroupCatalogue timeslotId locationId -> Data.Group.Membership -> Temporal.Time.TimeSet timeslotId
getMeetingTimes groupCatalogue = Data.Set.foldr (Data.Set.union . Data.Group.getMeetingTimes . (groupCatalogue !)) Data.Set.empty