GroupCatalogue.hs

{-# LANGUAGE CPP, FlexibleContexts #-}
{-
	Copyright (C) 2013-2015 Dr. Alistair Ward

	This file is part of WeekDaze.

	WeekDaze is free software: you can redistribute it and/or modify
	it under the terms of the GNU General Public License as published by
	the Free Software Foundation, either version 3 of the License, or
	(at your option) any later version.

	WeekDaze is distributed in the hope that it will be useful,
	but WITHOUT ANY WARRANTY; without even the implied warranty of
	MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
	GNU General Public License for more details.

	You should have received a copy of the GNU General Public License
	along with WeekDaze.  If not, see <http://www.gnu.org/licenses/>.
-}
{- |
 [@AUTHOR@]	Dr. Alistair Ward

 [@DESCRIPTION@]	Defines the name & attributes, of all /group/s.
-}

module WeekDaze.Aggregate.GroupCatalogue(
-- * Types
-- ** Type-synonyms
	GroupCatalogue,
	ResourceIdsByGroupId,
-- * Constants
	tag,
-- * Functions
	extractDistinctMeetingLocationIds,
	getMeetingTimes
#ifdef USE_HDBC
-- ** Translation
	,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

-- | Construct from the specified database-connection.
fromDatabase :: (
	Database.HDBC.IConnection	connection,
	Data.Convertible.Convertible	Database.HDBC.SqlValue locationId,	-- Flexible context.
	Data.Convertible.Convertible	Database.HDBC.SqlValue timeslotId,	-- Flexible context.
	Ord				timeslotId
 )
	=> connection			-- ^ An abstract database-connection.
	-> Database.HDBC.SqlValue	-- ^ The project-id.
	-> 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 {-to IO-monad-} (
					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	-- Returns Nothing for SqlNull.
					) $ 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
				 ) -- Pair.
			_						-> error . showString "WeekDaze.Aggregate.GroupCatalogue.fromDatabase:\tunexpected number of columns=" . shows (length groupRow) . showString " in row of table " $ shows groupCatalogueTableName "."
	 )
#endif /* USE_HDBC */

-- | Used to qualify XML.
tag :: String
tag	= "groupCatalogue"

-- | The complete set of 'Data.Group.Profile', indexed by 'Data.Group.Id'.
type GroupCatalogue timeslotId locationId	= Data.Resource.ResourceMap Data.Group.Id (Data.Group.Profile timeslotId locationId)

-- | A map indexed by a /group/-id, of /resource-id/s.
type ResourceIdsByGroupId resourceId	= Data.Map.Map Data.Group.Id (Data.Set.Set resourceId)

-- | Extracts the set of distinct 'locationId's, from the /group-catalogue/.
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

-- | Gather the set of /meeting-time/s corresponding to the specified set of /group/s.
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