LocationCatalogue.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 names & attributes of all /location/s available to be booked in the /timetable/.

-}

module WeekDaze.Aggregate.LocationCatalogue(
-- * Types
-- ** Type-synonyms
	LocationCatalogue,
-- * Constants
	tag,
-- * Functions
	countDaysByFacilityName,
--	countDistinctCampuses,
	extractDistinctFacilityNames,
	findSuitableLocations,
-- ** Accessors
	getLocationIds,
#ifdef USE_HDBC
-- ** Constructor
	fromDatabase,
#endif
-- ** Predicates
	hasAnyFacilities,
	isSingleCampus
) where

import qualified	Data.Foldable
import qualified	Data.Map
import qualified	Data.Set
import qualified	WeekDaze.Data.Location		as Data.Location
import qualified	WeekDaze.Data.Resource		as Data.Resource
import qualified	WeekDaze.Size			as Size

#ifdef USE_HDBC
import qualified	Database.HDBC
import qualified	Data.Convertible
import qualified	Data.Default
import qualified	Data.IntMap
import qualified	Data.Maybe
import qualified	WeekDaze.Database.Selector	as Database.Selector
import qualified	WeekDaze.Temporal.Availability	as Temporal.Availability

{- |
	* Construct from the specified database-connection.

	* CAVEAT: though the database may not permit a null value for many fields (applying its own default value when the value is unspecified),
	default values are applied here should the SQL-query return one.
-}
fromDatabase :: (
	Database.HDBC.IConnection		connection,
	Data.Convertible.Convertible		Database.HDBC.SqlValue campus,		-- Flexible context.
	Data.Convertible.Convertible		Database.HDBC.SqlValue locationId,	-- Flexible context.
	Data.Default.Default			campus,
	Ord					locationId,
	Show					campus
 )
	=> connection			-- ^ An abstract database-connection.
	-> Database.HDBC.SqlValue	-- ^ The project-id.
	-> IO (LocationCatalogue locationId campus)
fromDatabase connection	projectIdSql	= let
	locationCatalogueIdColumnName :: Database.Selector.ColumnName
	locationCatalogueIdColumnName	= showString tag "Id";

	facilityTableName, locationCatalogueTableName :: Database.Selector.TableName
	facilityTableName		= showString Database.Selector.tablePrefix "facility"
	locationCatalogueTableName	= showString Database.Selector.tablePrefix tag
 in do
	facilityNameByFacilityTypeId			<- Data.Location.findFacilityNameByFacilityTypeId connection projectIdSql

#ifdef USE_HDBC_ODBC
	selectFacilityTypeIdsForLocationCatalogueId	<- Database.Selector.prepare connection [Data.Location.facilityTypeIdTag] [facilityTableName] [locationCatalogueIdColumnName]	-- Select the facilityTypeIds at a locationId to be defined. CAVEAT: prepared statements don't seem to work reliably with HDBC-mysql.
#endif
	Database.Selector.select connection [
		locationCatalogueIdColumnName,
		Database.Selector.locationIdColumnName,
		Temporal.Availability.tag,
		Data.Location.capacityTag,
		Database.Selector.campusColumnName
	 ] [locationCatalogueTableName] [(Database.Selector.projectIdColumnName, projectIdSql)] >>= fmap Data.Map.fromList . mapM (
		\locationRow -> case locationRow of
			[locationCatalogueIdSql, locationIdSql, availabilitySql, capacitySql, campusSql]	-> do
				facilityNames	<- map (
					\locationCatalogueRow -> case locationCatalogueRow of
						[facilityTypeIdSql]	-> let
							facilityTypeId	= Data.Maybe.fromMaybe (
								error . showString "WeekDaze.Aggregate.LocationCatalogue.fromDatabase:\tnull " $ shows Data.Location.facilityTypeIdTag "."
							 ) . either (
								error . showString "WeekDaze.Aggregate.LocationCatalogue.fromDatabase:\tfailed to parse the value for " . shows Data.Location.facilityTypeIdTag . showString " read from the database; " . show
							 ) id $ Database.HDBC.safeFromSql facilityTypeIdSql
						 in Data.Maybe.fromMaybe (
							error . showString "WeekDaze.Aggregate.LocationCatalogue.fromDatabase:\tunknown " . showString Data.Location.facilityTypeIdTag . showChar '=' $ shows facilityTypeId "."
						 ) $ Data.IntMap.lookup facilityTypeId facilityNameByFacilityTypeId
						_			-> error . showString "WeekDaze.Aggregate.LocationCatalogue.fromDatabase:\tunexpected number of columns=" . shows (length locationCatalogueRow) . showString" in row of table " $ shows facilityTableName "."
#ifdef USE_HDBC_ODBC
				 ) `fmap` (
					Database.HDBC.execute selectFacilityTypeIdsForLocationCatalogueId [locationCatalogueIdSql] >> Database.HDBC.fetchAllRows' selectFacilityTypeIdsForLocationCatalogueId
				 )
#else
				 ) `fmap` Database.Selector.select connection [Data.Location.facilityTypeIdTag] [facilityTableName] [(locationCatalogueIdColumnName, locationCatalogueIdSql)]	-- Select the facilityTypeIds at this locationId.
#endif
				return {-to IO-monad-} (
					Data.Maybe.fromMaybe (
						error . showString "WeekDaze.Aggregate.LocationCatalogue.fromDatabase:\tnull " $ shows Database.Selector.locationIdColumnName "."
					) $ Database.HDBC.fromSql locationIdSql,
					Data.Location.mkProfile (
						Data.Maybe.fromMaybe (
							error . showString "WeekDaze.Aggregate.LocationCatalogue.fromDatabase:\tnull " $ shows Data.Location.capacityTag "."
						) . either (
							error . showString "WeekDaze.Aggregate.LocationCatalogue.fromDatabase:\tfailed to parse the value for " . shows Data.Location.capacityTag . showString " read from the database; " . show
						) id $ Database.HDBC.safeFromSql capacitySql
					) (
						Data.Set.fromList facilityNames
					) (
						Data.Maybe.fromMaybe Data.Default.def $ Database.HDBC.fromSql availabilitySql
					) . Data.Maybe.fromMaybe Data.Default.def $ Database.HDBC.fromSql campusSql
				 ) -- Pair.
			_											-> error . showString "WeekDaze.Aggregate.LocationCatalogue.fromDatabase:\tunexpected number of columns=" . shows (length locationRow) . showString " in row of table " $ shows locationCatalogueTableName "."
	 )
#endif /* USE_HDBC */

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

-- | The complete set of /location/s, indexed by their 'locationId'.
type LocationCatalogue locationId campus	= Data.Resource.ResourceMap locationId (Data.Location.Profile campus)

-- | Accessor.
getLocationIds :: LocationCatalogue locationId campus -> [locationId]
getLocationIds	= Data.Map.keys

-- | Count the total available /day/s, of those /location/s offering each type of /facility/.
countDaysByFacilityName :: LocationCatalogue locationId campus -> Data.Map.Map Data.Location.FacilityName Size.NDays
countDaysByFacilityName	= Data.Map.foldr (
	\profile m	-> Data.Set.foldr (
		\facilityName -> Data.Map.insertWith (+) facilityName (Data.Resource.countDaysPerWeekAvailable profile)
	) m $ Data.Location.getFacilityNames profile
 ) Data.Map.empty

-- | Count the number of distinct /campus/es which have been configured.
countDistinctCampuses :: Ord campus => LocationCatalogue locationId campus -> Int
countDistinctCampuses	= Data.Set.size . Data.Foldable.foldr (Data.Set.insert . Data.Location.getCampus) Data.Set.empty

-- | Whether all /location/s exist on the same /campus/.
isSingleCampus :: Ord campus => LocationCatalogue locationId campus -> Bool
isSingleCampus	= (== 1) . countDistinctCampuses

-- | Extracts the set of distinct /facilities/, from the catalogue.
extractDistinctFacilityNames :: LocationCatalogue locationId campus -> Data.Location.FacilityNames
extractDistinctFacilityNames	= Data.Map.foldr (Data.Set.union . Data.Location.getFacilityNames) Data.Set.empty

-- | Find those /locations/ which meet or exceed, the specified criteria.
findSuitableLocations
	:: Size.NStudents
	-> Data.Location.FacilityNames
	-> LocationCatalogue locationId campus
	-> LocationCatalogue locationId campus
findSuitableLocations requiredCapacity requiredFacilityNames	= Data.Map.filter (Data.Location.isSuitable requiredCapacity requiredFacilityNames)

-- | True if any /location/ offers any /facilities/.
hasAnyFacilities :: LocationCatalogue locationId campus -> Bool
hasAnyFacilities	= Data.Foldable.any Data.Location.hasFacilities