validate using StudentWithRegs and show goSlots in elexams #32 #28

obcode · Dec 7, 2017 · 5e329e5 · 5e329e5
1 parent 0fb5d46
commit 5e329e5
Show file tree

Hide file tree

Showing 7 changed files with 257 additions and 183 deletions.
diff --git a/elexams/elexams.css b/elexams/elexams.css
@@ -75,6 +75,10 @@ div.inner {
   display: block;
 }
 
+div.goSlot {
+  background-color: rgb(255, 0, 255);
+}
+
 div.examsBySameLecturer {
   font-weight: bold;
   color: blue;

diff --git a/elexams/index.html b/elexams/index.html
@@ -28,7 +28,8 @@
       <input type="radio" name="tabs" checked="checked" id="tab1" />
       <label for="tab1">Plan</label>
       <div id="tab-content1" class="content">
-        <div id="validation">Validation</div>
+        <button onclick="toggleGoSlots()">GO Slots</button>
+        <div id="validation">... still validating</div>
         <div id="plan"></div>
         <div class="containerUnscheduled">
           <div class="unscheduledHeader" draggable="false">Not yet scheduled</div>

diff --git a/elexams/renderer.js b/elexams/renderer.js
@@ -10,6 +10,7 @@ const endpointUnscheduledExams = '/unscheduledExams'
 const endpointNotPlannedByMeExams = '/notPlannedByMeExams'
 const endpointValidation = '/validation'
 const endpointExamsBySameLecturer = '/examsBySameLecturer'
+const endpointGoSlots = '/goSlots'
 
 let _fetchValidation = () => {
   $.getJSON(host + endpointValidation, (validation) => {
@@ -212,7 +213,7 @@ let _fetchExamDays = function () {
               let examData = _fetchExamsData(j, i, slots)
               var anCodes = _getAncodesForSlot(j, i, slots);
               output += `<td class="exams">
-                        <div class="outer" data-day="${j}" data-slot="${i}"
+                        <div id="slot_${j}_${i}" class="outer" data-day="${j}" data-slot="${i}"
                         ondrop="dropExam(event)" ondragover="allowDropExam(event)">`
               for (let k in examData) {
                 output += `<div id="${anCodes[k]}" class="inner" ondrop="return false;"
@@ -259,7 +260,15 @@ function setNotPlannedByMe () {
   })
 }
 
-setNotPlannedByMe()
+
+function toggleGoSlots () {
+  $.getJSON(host + endpointGoSlots, (goSlots) => {
+    for (let i in goSlots) {
+      let goSlot = goSlots[i]
+      $(['#slot_', goSlot[0], '_', goSlot[1]].join('')).addClass('goSlot')
+    }
+  })
+}
 
 // Convenience function for _fetchExams
 let fetchExams = function () {
@@ -287,4 +296,6 @@ fetchUnscheduledExams()
 
 _fetchNotPlannedByMeExams()
 
+setNotPlannedByMe()
+
 _fetchValidation()
diff --git a/plexams-core/src/Plexams/PlanManip.hs b/plexams-core/src/Plexams/PlanManip.hs
@@ -4,7 +4,6 @@ module Plexams.PlanManip
     , applyAddExamToSlotListToPlan
     , makePlan
     , addRegistrationsListToExams
-    , addStudentRegistrationsToExams
     , addStudentRegistrationsToPlan
     , applyAddRoomToExamListToPlan
     , addConstraints
@@ -284,27 +283,22 @@ addStudentRegistrationsToPlan studentsWithRegs plan = plan
   , unscheduledExams = unscheduledExams'
   }
   where
-    unscheduledExams' = addStudentRegistrationsToExamsMap studentsWithRegs
-                        $ unscheduledExams plan
+    unscheduledExams' = addStudentRegistrationsToExamsMap
+                          studentsWithRegs allAncodes $ unscheduledExams plan
     slots' = M.map
              (\s -> s { examsInSlot = addStudentRegistrationsToExamsMap
-                                      studentsWithRegs $ examsInSlot s
+                               studentsWithRegs allAncodes $ examsInSlot s
                       }
              ) $ slots plan
-
-addStudentRegistrationsToExams :: StudentsWithRegs -> [Exam] -> [Exam]
-addStudentRegistrationsToExams studentsWithRegs =
-  M.elems
-  . addStudentRegistrationsToExamsMap studentsWithRegs
-  . M.fromList
-  . map (\e -> (anCode e, e))
+    allAncodes = map anCode $ initialPlan plan
 
 addStudentRegistrationsToExamsMap :: StudentsWithRegs
+                                  -> [Ancode]
                                   -> M.Map Ancode Exam
                                   -> M.Map Ancode Exam
-addStudentRegistrationsToExamsMap studentsWithRegs examsMap =
+addStudentRegistrationsToExamsMap studentsWithRegs allAncodes examsMap =
   M.map (\e -> e { conflictingAncodes =
-                    filter (`elem` M.keys examsMap \\ [anCode e])
+                    filter (`elem` allAncodes \\ [anCode e])
                     $ sort $ nub $conflictingAncodes e
 
                , registeredGroups = sumRegisteredGroups $ registeredGroups e

diff --git a/plexams-core/src/Plexams/Types/Slots.hs b/plexams-core/src/Plexams/Types/Slots.hs
@@ -1,24 +1,50 @@
-{-# LANGUAGE DeriveGeneric #-}
-
-module Plexams.Types.Slots
-  ( Slot(..)
-  , Slots
-  ) where
-
-import           Data.Aeson
-import qualified Data.Map              as M
-import           GHC.Generics
-import           Plexams.Types.Common
-import           Plexams.Types.Exam
-import           Plexams.Types.Persons
-
-type Slots = M.Map (DayIndex, SlotIndex) Slot
-
-data Slot = Slot
-    { examsInSlot        :: M.Map Ancode Exam -- Ancode -> Exam
-    , reserveInvigilator :: Maybe Invigilator  -- ^ Reserveaufsicht für die Prüfung
-    }
-  deriving (Show, Eq, Generic)
-
-instance FromJSON Slot
-instance ToJSON Slot
+{-# LANGUAGE DeriveGeneric #-}
+{-# LANGUAGE TupleSections #-}
+
+module Plexams.Types.Slots
+  ( Slot(..)
+  , Slots
+  , adjacentSlotPairs
+  , slotsByDay
+  ) where
+
+import           Data.Aeson
+import qualified Data.Map              as M
+import           Data.Maybe            (mapMaybe)
+import           GHC.Exts              (groupWith)
+import           GHC.Generics
+import           Plexams.Types.Common
+import           Plexams.Types.Exam
+import           Plexams.Types.Persons
+
+type Slots = M.Map (DayIndex, SlotIndex) Slot
+
+data Slot = Slot
+    { examsInSlot        :: M.Map Ancode Exam -- Ancode -> Exam
+    , reserveInvigilator :: Maybe Invigilator  -- ^ Reserveaufsicht für die Prüfung
+    }
+  deriving (Show, Eq, Generic)
+
+instance FromJSON Slot
+instance ToJSON Slot
+
+-- dayindex: from 0 to maxDayIndex
+-- slotindex: from 0 to maxSlotIndex
+adjacentSlotPairs :: Slots -> [[((DayIndex, SlotIndex), Slot)]]
+adjacentSlotPairs slots =
+  let maxSlotIndex = maximum $ map snd $ M.keys slots
+      maxDayIndex = maximum $ map fst $ M.keys slots
+      indexPairs = map (\(d,s) -> map (d,) s)
+                       [(d, slotIndexPair)
+                       | d <- [0..maxDayIndex]
+                       , slotIndexPair <- [[x,x+1] | x <- [0..maxSlotIndex-1]]
+                       ]
+      maybeSlotPair [idx1, idx2] = do
+        slot1 <- M.lookup idx1 slots
+        slot2 <- M.lookup idx2 slots
+        return [(idx1, slot1), (idx2, slot2)]
+      maybeSlotPair _ = Nothing
+  in mapMaybe maybeSlotPair indexPairs
+
+slotsByDay :: Slots -> [[((DayIndex, SlotIndex), Slot)]]
+slotsByDay slots = groupWith (fst . fst) $ M.toList slots