{-# LANGUAGE CPP, FlexibleContexts #-}
module WeekDaze.Aggregate.LocationCatalogue(
LocationCatalogue,
tag,
countDaysByFacilityName,
extractDistinctFacilityNames,
findSuitableLocations,
getLocationIds,
#ifdef USE_HDBC
fromDatabase,
#endif
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
fromDatabase :: (
Database.HDBC.IConnection connection,
Data.Convertible.Convertible Database.HDBC.SqlValue campus,
Data.Convertible.Convertible Database.HDBC.SqlValue locationId,
Data.Default.Default campus,
Ord locationId,
Show campus
)
=> connection
-> Database.HDBC.SqlValue
-> 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]
#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)]
#endif
return (
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
)
_ -> error . showString "WeekDaze.Aggregate.LocationCatalogue.fromDatabase:\tunexpected number of columns=" . shows (length locationRow) . showString " in row of table " $ shows locationCatalogueTableName "."
)
#endif /* USE_HDBC */
tag :: String
tag = "locationCatalogue"
type LocationCatalogue locationId campus = Data.Resource.ResourceMap locationId (Data.Location.Profile campus)
getLocationIds :: LocationCatalogue locationId campus -> [locationId]
getLocationIds = Data.Map.keys
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
countDistinctCampuses :: Ord campus => LocationCatalogue locationId campus -> Int
countDistinctCampuses = Data.Set.size . Data.Foldable.foldr (Data.Set.insert . Data.Location.getCampus) Data.Set.empty
isSingleCampus :: Ord campus => LocationCatalogue locationId campus -> Bool
isSingleCampus = (== 1) . countDistinctCampuses
extractDistinctFacilityNames :: LocationCatalogue locationId campus -> Data.Location.FacilityNames
extractDistinctFacilityNames = Data.Map.foldr (Data.Set.union . Data.Location.getFacilityNames) Data.Set.empty
findSuitableLocations
:: Size.NStudents
-> Data.Location.FacilityNames
-> LocationCatalogue locationId campus
-> LocationCatalogue locationId campus
findSuitableLocations requiredCapacity requiredFacilityNames = Data.Map.filter (Data.Location.isSuitable requiredCapacity requiredFacilityNames)
hasAnyFacilities :: LocationCatalogue locationId campus -> Bool
hasAnyFacilities = Data.Foldable.any Data.Location.hasFacilities