{-# 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@]	Provides a catalogue of /student-profile/s, indexed by the /student-body/ by whom it's shared.
-}

module WeekDaze.Aggregate.StudentBodyRegister(
-- * Types
-- ** Type-synonyms
        StudentBodyRegister,
        KnowledgeByStudentBody,
-- * Constants
        tag,
-- * Functions
        countAvailableStudentDays,
        countSubjectsRequired,
        extractDistinctSubjects,
        reduce,
        reduce',
-- ** Accessors
        getStudentBodies,
#ifdef USE_HDBC
-- ** Constructor
        fromDatabase,
#endif
-- ** Predicates
        hasAnyFreePeriodPreference,
        hasAnyCoreKnowledgeRequirements,
        hasAnyOptionalKnowledgeRequirements
) where

import                  Control.Arrow((&&&))
import qualified        Control.Monad.Writer
import qualified        Data.Foldable
import qualified        Data.Map
import qualified        Data.Set
import qualified        WeekDaze.Aggregate.StudentBody          as Aggregate.StudentBody
import qualified        WeekDaze.Aggregate.StudentClass         as Aggregate.StudentClass
import qualified        WeekDaze.Data.HumanResource             as Data.HumanResource
import qualified        WeekDaze.Data.Resource                  as Data.Resource
import qualified        WeekDaze.Data.Student                   as Data.Student
import qualified        WeekDaze.Data.Subject                   as Data.Subject
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        Data.Typeable
import qualified        WeekDaze.Database.Selector              as Database.Selector
import qualified        WeekDaze.Data.Group                     as Data.Group
import qualified        WeekDaze.Data.Requirements              as Data.Requirements
import qualified        WeekDaze.Temporal.Availability          as Temporal.Availability
import qualified        WeekDaze.Temporal.FreePeriodPreference  as Temporal.FreePeriodPreference

-- | Construct from the specified database-connection.
fromDatabase :: (
        Database.HDBC.IConnection               connection,
        Data.Convertible.Convertible            Database.HDBC.SqlValue level,           -- Flexible context.
        Data.Convertible.Convertible            Database.HDBC.SqlValue stream,          -- Flexible context.
        Data.Convertible.Convertible            Database.HDBC.SqlValue teachingRatio,   -- Flexible context.
        Data.Default.Default                    stream,
        Data.Typeable.Typeable                  teachingRatio,
        Ord                                     level,
        RealFrac                                teachingRatio,
        Show                                    level
 )
        => connection                   -- ^ An abstract database-connection.
        -> Database.HDBC.SqlValue       -- ^ The project-id.
        -> IO (StudentBodyRegister level stream teachingRatio)
fromDatabase connection projectIdSql    = let
        priorityColumnName, streamIdColumnName, streamNameColumnName, studentBodyRegisterIdColumnName :: Database.Selector.ColumnName
        priorityColumnName              = "priority"
        streamIdColumnName              = "streamId"
        streamNameColumnName            = "streamName"  -- CAVEAT: known merely as 'stream' in Data.Student & the DTD.
        studentBodyRegisterIdColumnName = showString tag "Id";

        knowledgeRequirementsTableName, streamTableName, studentBodyRegisterTableName, studentBodyMembershipTableName, studentGroupMembershipTableName :: Database.Selector.TableName
        [knowledgeRequirementsTableName, streamTableName, studentBodyRegisterTableName, studentBodyMembershipTableName, studentGroupMembershipTableName]        = map (showString Database.Selector.tablePrefix) ["knowledgeRequirement", "stream", tag, "studentBodyMembership", "studentGroupMembership"]
 in do
        streamNameByStreamId    <- (
                Data.IntMap.fromList . map (
                        \row -> case row of
                                [streamIdSql, streamNameSql]    -> (
                                        either (
                                                error . showString "WeekDaze.Aggregate.StudentBodyRegister.fromDatabase:\tfailed to parse the value for " . shows streamIdColumnName . showString " read from the database; " . show
                                         ) id $ Database.HDBC.safeFromSql streamIdSql,
                                        Database.HDBC.fromSql streamNameSql
                                 ) -- Pair.
                                _                               -> error . showString "WeekDaze.Aggregate.StudentBodyRegister.fromDatabase:\tunexpected number of columns=" . shows (length row) . showString " in row of table " $ shows streamTableName "."
                )
         ) `fmap` Database.Selector.select connection [streamIdColumnName, streamNameColumnName] [streamTableName] [(Database.Selector.projectIdColumnName, projectIdSql)]

#ifdef USE_HDBC_ODBC
        [
                selectStudentIdsForStudentBodyRegisterId,
                selectKnowledgeRequirementsForStudentBodyRegisterId,
                selectGroupIdsForStudentBodyRegisterId
         ] <- mapM (
                \(columnNames, tableName)       -> Database.Selector.prepare connection columnNames [tableName] [studentBodyRegisterIdColumnName]
         ) [
                (
                        [Aggregate.StudentBody.studentIdTag],
                        studentBodyMembershipTableName
                ), (
                        [
                                priorityColumnName,
                                Data.Subject.topicTag,
                                Data.Subject.levelTag
                        ],
                        knowledgeRequirementsTableName
                ), (
                        [Data.Group.groupIdTag],
                        studentGroupMembershipTableName
                )
         ] -- Prepare statements for execution with each studentBodyRegisterId.
#endif /* USE_HDBC_ODBC */
        Database.Selector.select connection [
                studentBodyRegisterIdColumnName,
                Aggregate.StudentBody.mnemonicTag,
                Temporal.Availability.tag,
                streamIdColumnName,
                Data.Student.teachingRatioTag,
                Temporal.FreePeriodPreference.tag
         ] [studentBodyRegisterTableName] [(Database.Selector.projectIdColumnName, projectIdSql)] >>= fmap Data.Map.fromList . mapM (
                \studentRow -> case studentRow of
                        [studentBodyRegisterIdSql, mnemonicSql, availabilitySql, streamIdSql, teachingRatioSql, freePeriodPreferenceSql]        -> do
#ifndef USE_HDBC_ODBC
                                let primaryKey  = [(studentBodyRegisterIdColumnName, studentBodyRegisterIdSql)]
#endif
                                studentIds      <- map (
                                        Database.HDBC.fromSql . head {-select the only column-}
#ifdef USE_HDBC_ODBC
                                 ) `fmap` (
                                        Database.HDBC.execute selectStudentIdsForStudentBodyRegisterId [studentBodyRegisterIdSql] >> Database.HDBC.fetchAllRows' selectStudentIdsForStudentBodyRegisterId
                                 )
#else
                                 ) `fmap` Database.Selector.select connection [Aggregate.StudentBody.studentIdTag] [studentBodyMembershipTableName] primaryKey
#endif
                                knowledgeRequirements   <- (
                                        (
                                                Data.Maybe.fromMaybe Data.Set.empty . Data.Map.lookup Data.Requirements.coreTag &&& Data.Maybe.fromMaybe Data.Set.empty . Data.Map.lookup Data.Requirements.optionalTag
                                        ) . Data.Map.fromListWith Data.Set.union . map (
                                                \knowledgeRequirementRow -> case knowledgeRequirementRow of
                                                        [prioritySql, topicSql, levelSql]       -> (
                                                                Data.Maybe.fromMaybe (
                                                                        error . showString "WeekDaze.Aggregate.StudentBodyRegister.fromDatabase:\tnull " $ shows priorityColumnName "."
                                                                ) $ Database.HDBC.fromSql prioritySql,
                                                                Data.Set.singleton $ Data.Subject.mkSubjectFromSql topicSql levelSql
                                                         ) -- Pair
                                                        _                                       -> error . showString "WeekDaze.Aggregate.StudentBodyRegister.fromDatabase:\tunexpected number of columns=" . shows (length knowledgeRequirementRow) . showString " in row of table " $ shows knowledgeRequirementsTableName "."
                                        )
#ifdef USE_HDBC_ODBC
                                 ) `fmap` (
                                        Database.HDBC.execute selectKnowledgeRequirementsForStudentBodyRegisterId [studentBodyRegisterIdSql] >> Database.HDBC.fetchAllRows' selectKnowledgeRequirementsForStudentBodyRegisterId
                                 )
#else
                                 ) `fmap` Database.Selector.select connection [
                                        priorityColumnName,
                                        Data.Subject.topicTag,
                                        Data.Subject.levelTag
                                 ] [knowledgeRequirementsTableName] primaryKey
#endif

                                groupMembership         <- (
                                        Data.Set.fromList . map (
                                                either (
                                                        error . showString "WeekDaze.Aggregate.StudentBodyRegister.fromDatabase:\tfailed to parse the value for " . shows Data.Group.groupIdTag . showString " read from the database; " . show
                                                ) id . Database.HDBC.safeFromSql . head {-select the only column-}
                                        )
#ifdef USE_HDBC_ODBC
                                 ) `fmap` (
                                        Database.HDBC.execute selectGroupIdsForStudentBodyRegisterId [studentBodyRegisterIdSql] >> Database.HDBC.fetchAllRows' selectGroupIdsForStudentBodyRegisterId
                                 )
#else
                                 ) `fmap` Database.Selector.select connection [Data.Group.groupIdTag] [studentGroupMembershipTableName] primaryKey
#endif
                                return {-to IO-monad-} (
                                        Aggregate.StudentBody.mkStudentBody (
                                                either (
                                                        error . showString "WeekDaze.Aggregate.StudentBodyRegister.fromDatabase:\tfailed to parse the value for " . shows Aggregate.StudentBody.mnemonicTag . showString " read from the database; " . show
                                                ) id $ Database.HDBC.safeFromSql mnemonicSql
                                        ) . Data.Set.fromList $ map (
                                                Data.Maybe.fromMaybe (
                                                        error . showString "WeekDaze.Aggregate.StudentBodyRegister.fromDatabase:\tnull " $ shows Aggregate.StudentBody.studentIdTag "."
                                                )
                                        ) studentIds,
                                        Data.Student.mkProfile (
                                                Data.Maybe.maybe Data.Default.def (
                                                        Data.Maybe.fromMaybe (
                                                                error . showString "WeekDaze.Aggregate.StudentBodyRegister.fromDatabase:\tfailed to find a " . shows streamNameColumnName . showString " corresponding to the value for " $ shows streamIdColumnName " read from the database."
                                                        ) . (
                                                                `Data.IntMap.lookup` streamNameByStreamId
                                                        )
                                                ) . either (
                                                        error . showString "WeekDaze.Aggregate.StudentBodyRegister.fromDatabase:\tfailed to parse the value for " . shows streamIdColumnName . showString " read from the database; " . show
                                                ) id $ Database.HDBC.safeFromSql streamIdSql
                                        ) knowledgeRequirements (
                                                Data.Maybe.fromMaybe (
                                                        error . showString "WeekDaze.Aggregate.StudentBodyRegister.fromDatabase:\tnull " $ shows Temporal.Availability.tag "."
                                                ) $ Database.HDBC.fromSql availabilitySql
                                        ) (
                                                Database.Selector.fromSqlFractional Data.Student.defaultTeachingRatio teachingRatioSql
                                        ) groupMembership $ Database.HDBC.fromSql freePeriodPreferenceSql       -- Returns Nothing for SqlNull.
                                 ) -- Pair.
                        _ -> error . showString "WeekDaze.Aggregate.StudentBodyRegister.fromDatabase:\tunexpected number of columns=" . shows (length studentRow) . showString" in row of table " $ shows studentBodyRegisterTableName "."
         )
#endif /* USE_HDBC */

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

-- | A map indexed by /student-body/, of /profile/s shared amongst /student/s in the /body/.
type StudentBodyRegister level stream teachingRatio     = Data.Resource.ResourceMap Aggregate.StudentBody.StudentBody (Data.Student.Profile level stream teachingRatio)

-- | Accessor.
getStudentBodies :: StudentBodyRegister level stream teachingRatio -> [Aggregate.StudentBody.StudentBody]
getStudentBodies        = Data.Map.keys

-- | Extracts the set of distinct /subjects/ required, gathered from all /students/.
extractDistinctSubjects :: Ord level => StudentBodyRegister level stream teachingRatio -> Data.Subject.Knowledge level
extractDistinctSubjects = Data.Map.foldr (Data.Set.union . Data.Student.deriveAmalgamatedKnowledgeRequirement) Data.Set.empty

{- |
	* Merges those /student-bodies/ whose /profile/s are identical, into a single larger /student-body/.

	* Writes the lists of merged /student-bodies/.

	* Checks that any new /mnemonic/s, composed from those of /student-bodies/ with identical profiles, differ from existing ones.
	This shouldn't matter, because the key of 'StudentBodyRegister' is the whole /student-body/ not just the /mnemonic/,
	regrettably, for efficiency, /StudentBody/ implements 'Eq' & 'Ord' using only the /mnemonic/.
-}
reduce :: (
        Ord     level,
        Ord     stream,
        Ord     teachingRatio
 )
        => Aggregate.StudentClass.MnemonicSeparator
        -> StudentBodyRegister level stream teachingRatio
        -> Control.Monad.Writer.Writer [[Aggregate.StudentBody.StudentBody]] (StudentBodyRegister level stream teachingRatio)
reduce mnemonicSeparator studentBodyRegister
        | null ambiguousMnemonics       = Control.Monad.Writer.writer (studentBodyRegister', mergeableStudentBodies)
        | otherwise                     = error . showString "WeekDaze.Aggregate.StudentBodyRegister.reduce:\tsome of the mnemonics composed by merging those of student-bodies with identical profiles, are ambiguous; " $ shows ambiguousMnemonics "."
        where
                (studentBodyRegister', (ambiguousMnemonics, mergeableStudentBodies))    = (
                        Data.Map.fromList . map (
                                \(sharedStudentProfile, studentClass)   -> (Aggregate.StudentClass.merge mnemonicSeparator studentClass, sharedStudentProfile)  -- Reverse the mapping back to the original.
                        ) . Data.Map.toList &&& (
                                Data.Set.toList . Data.Set.intersection (
                                        Data.Set.map Aggregate.StudentBody.getMnemonic $ Data.Map.keysSet studentBodyRegister
                                ) . Data.Set.fromList . map (
                                        Aggregate.StudentBody.getMnemonic . Aggregate.StudentClass.merge mnemonicSeparator
                                ) &&& map Data.Set.toList
                        ) . filter (
                                (/= 1) . Data.Set.size  -- Select student-bodies that can be merged.
                        ) . Data.Map.elems
                 ) . Data.Map.fromListWith Data.Set.union . map (
                        \(studentBody, studentProfile)  -> (studentProfile, Data.Set.singleton studentBody)     -- Reverse the mapping.
                 ) $ Data.Map.toList studentBodyRegister

-- | Merges those /student-bodies/ whose /profile/s are identical, into a single larger /student-body/.
reduce' :: (
        Ord     level,
        Ord     stream,
        Ord     teachingRatio
 )
        => Aggregate.StudentClass.MnemonicSeparator
        -> StudentBodyRegister level stream teachingRatio
        -> StudentBodyRegister level stream teachingRatio
reduce' s       = fst {-StudentBodyRegister-} . Control.Monad.Writer.runWriter . reduce s

-- | The sum of the number of /day/s worked by each /student/.
countAvailableStudentDays :: StudentBodyRegister level stream teachingRatio -> Size.NDays
countAvailableStudentDays       = Data.Map.foldrWithKey (\studentBody -> (+) . (* Aggregate.StudentBody.getSize studentBody) . Data.Resource.countDaysPerWeekAvailable) 0

-- | /Knowlege-requirement/, indexed by /student-body/.
type KnowledgeByStudentBody level       = Data.Map.Map Aggregate.StudentBody.StudentBody (Data.Subject.Knowledge level)

-- | Count the total number of /subject/s required by all /student/s.
countSubjectsRequired :: KnowledgeByStudentBody level -> Int
countSubjectsRequired   = Data.Map.foldrWithKey (\studentBody -> (+) . (* Aggregate.StudentBody.getSize studentBody) . Data.Set.size) 0

-- | True if any /student-body/ has specified a free-period preference.
hasAnyFreePeriodPreference :: RealFrac teachingRatio => StudentBodyRegister level stream teachingRatio -> Bool
hasAnyFreePeriodPreference      = Data.Foldable.any Data.HumanResource.hasFreePeriodPreference

-- | True if any /student-body/ has specified a core /subject/ in their knowledge-requirements.
hasAnyCoreKnowledgeRequirements :: StudentBodyRegister level stream teachingRatio -> Bool
hasAnyCoreKnowledgeRequirements = Data.Foldable.any Data.Student.hasAnyCoreKnowledgeRequirements

-- | True if any /student-body/ has specified an optional /subject/ in their knowledge-requirements.
hasAnyOptionalKnowledgeRequirements :: StudentBodyRegister level stream teachingRatio -> Bool
hasAnyOptionalKnowledgeRequirements     = Data.Foldable.any Data.Student.hasAnyOptionalKnowledgeRequirements