feat(course-users): fuse avs register form with CAddUserR

messages/uniworx/utils/navigation/breadcrumbs/de-de-formal.msg

@@ -137,7 +137,6 @@ BreadcrumbCourseEventEdit: Kurstermin bearbeiten
 BreadcrumbExamList: Prüfungen
 BreadcrumbExamNew: Neue Prüfung anlegen
 BreadcrumbCourseApplications: Bewerbungen
-BreadcrumbCourseAvsRegister: AVS-Teilnehmer:innen anmelden
 BreadcrumbExamEdit: Prüfung bearbeiten
 BreadcrumbExamUsers: Teilnehmer:innen
 BreadcrumbExamGrades: Prüfungsleistungen

messages/uniworx/utils/navigation/breadcrumbs/en-eu.msg

@@ -131,7 +131,6 @@ BreadcrumbCourseNewsNew: Add course news
 BreadcrumbCourseNewsEdit: Edit course news
 BreadcrumbCourseEventNew: New course occurrence
 BreadcrumbCourseEventEdit: Edit course occurrence
-BreadcrumbCourseAvsRegister: Register AVS participants
 BreadcrumbExamList: Exams
 BreadcrumbExamNew: Create new exam
 BreadcrumbCourseApplications: Applications

messages/uniworx/utils/navigation/menu/de-de-formal.msg

@@ -147,7 +147,5 @@ MenuApc: Druckerei
 MenuPrintSend: Manueller Briefversand
 MenuPrintDownload: Brief herunterladen
 
-MenuCourseAvsRegister: AVS-Teilnehmer:innen anmelden
-
 MenuApiDocs: API-Dokumentation (Englisch)
 MenuSwagger !ident-ok: OpenAPI 2.0 (Swagger)

messages/uniworx/utils/navigation/menu/en-eu.msg

@@ -148,7 +148,5 @@ MenuApc: Printing
 MenuPrintSend: Send Letter
 MenuPrintDownload: Download Letter
 
-MenuCourseAvsRegister: Register AVS participants
-
 MenuApiDocs: API documentation
 MenuSwagger: OpenAPI 2.0 (Swagger)

routes

@@ -176,8 +176,6 @@
   !/users/new                 CAddUserR        GET POST        !lecturerANDallocation-time
   !/users/invite              CInviteR         GET POST
   /users/#CryptoUUIDUser      CUserR           GET POST        !lecturerANDparticipant !lecturerANDapplicant
-  /avs                        CAvsR:
-    /register                 CAvsRegisterR    GET POST
   /correctors                 CHiWisR          GET
   /communication              CCommR           GET POST
   /notes                      CNotesR          GET POST        !corrector -- THIS route is used to check for overall course corrector access!

src/Foundation/Navigation.hs

@@ -250,7 +250,6 @@ breadcrumb (CourseR tid ssh csh CEditR)     = i18nCrumb MsgMenuCourseEdit . Just
 breadcrumb (CourseR tid ssh csh CUsersR)    = i18nCrumb MsgMenuCourseMembers . Just $ CourseR tid ssh csh CShowR
 breadcrumb (CourseR tid ssh csh CAddUserR)  = i18nCrumb MsgMenuCourseAddMembers . Just $ CourseR tid ssh csh CUsersR
 breadcrumb (CourseR tid ssh csh CInviteR)   = i18nCrumb MsgBreadcrumbCourseParticipantInvitation . Just $ CourseR tid ssh csh CShowR
-breadcrumb (CourseR tid ssh csh (CAvsR CAvsRegisterR)) = i18nCrumb MsgBreadcrumbCourseAvsRegister . Just $ CourseR tid ssh csh CUsersR
 breadcrumb (CourseR tid ssh csh CExamOfficeR) = i18nCrumb MsgMenuCourseExamOffice . Just $ CourseR tid ssh csh CShowR
 breadcrumb (CourseR tid ssh csh (CUserR cID)) = useRunDB . maybeT (i18nCrumb MsgBreadcrumbUser . Just $ CourseR tid ssh csh CUsersR) $ do
   guardM . lift . hasReadAccessTo . CourseR tid ssh csh $ CUserR cID
@@ -986,17 +985,6 @@ pageActions (CourseR tid ssh csh CShowR) = do
 
   return $
     [ NavPageActionPrimary
-      { navLink = NavLink
-        { navLabel       = MsgMenuCourseAvsRegister
-        , navRoute       = CourseR tid ssh csh $ CAvsR CAvsRegisterR
-        , navAccess'     = NavAccessDB . hasWriteAccessTo . CourseR tid ssh csh $ CAvsR CAvsRegisterR
-        , navType        = NavTypeLink { navModal = True }
-        , navQuick'      = mempty
-        , navForceActive = False
-        }
-      , navChildren = mempty
-      }
-    , NavPageActionPrimary
       { navLink = NavLink
         { navLabel       = MsgMenuMaterialList
         , navRoute       = CourseR tid ssh csh MaterialListR
@@ -1729,17 +1717,6 @@ pageActions (CourseR tid ssh csh SheetListR) = do
     ]
 pageActions (CourseR tid ssh csh CUsersR) = return
   [ NavPageActionPrimary
-    { navLink = NavLink
-      { navLabel       = MsgMenuCourseAvsRegister
-      , navRoute       = CourseR tid ssh csh $ CAvsR CAvsRegisterR
-      , navAccess'     = NavAccessDB . hasWriteAccessTo . CourseR tid ssh csh $ CAvsR CAvsRegisterR
-      , navType        = NavTypeLink { navModal = True }
-      , navQuick'      = mempty
-      , navForceActive = False
-      }
-    , navChildren = mempty
-    }
-  , NavPageActionPrimary
     { navLink = NavLink
       { navLabel       = MsgMenuCourseAddMembers
       , navRoute       = CourseR tid ssh csh CAddUserR
@@ -1814,17 +1791,6 @@ pageActions (CMaterialR tid ssh csh mnm MShowR) = return
   ]
 pageActions (CourseR tid ssh csh CTutorialListR) = return
   [ NavPageActionPrimary
-    { navLink = NavLink
-      { navLabel       = MsgMenuCourseAvsRegister
-      , navRoute       = CourseR tid ssh csh $ CAvsR CAvsRegisterR
-      , navAccess'     = NavAccessDB . hasWriteAccessTo . CourseR tid ssh csh $ CAvsR CAvsRegisterR
-      , navType        = NavTypeLink { navModal = True }
-      , navQuick'      = mempty
-      , navForceActive = False
-      }
-    , navChildren = mempty
-    }
-  , NavPageActionPrimary
     { navLink = NavLink
       { navLabel       = MsgMenuTutorialNew
       , navRoute       = CourseR tid ssh csh CTutorialNewR
@@ -1871,17 +1837,6 @@ pageActions (CTutorialR tid ssh csh tutn TUsersR) = return
       }
     , navChildren = []
     }
-  , NavPageActionPrimary
-    { navLink = NavLink
-      { navLabel       = MsgMenuCourseAvsRegister
-      , navRoute       = CourseR tid ssh csh $ CAvsR CAvsRegisterR
-      , navAccess'     = NavAccessDB . hasWriteAccessTo . CourseR tid ssh csh $ CAvsR CAvsRegisterR
-      , navType        = NavTypeLink { navModal = True }
-      , navQuick'      = mempty
-      , navForceActive = False
-      }
-    , navChildren = mempty
-    }
   , NavPageActionSecondary
     { navLink = NavLink
       { navLabel       = MsgMenuTutorialDelete

src/Foundation/Routes.hs

@@ -34,7 +34,6 @@ import ServantApi.ExternalApis.Type
 mkYesodData "UniWorX" uniworxRoutes
 
 deriving instance Generic CourseR
-deriving instance Generic CAvsR
 deriving instance Generic SheetR
 deriving instance Generic SubmissionR
 deriving instance Generic MaterialR
@@ -52,7 +51,6 @@ deriving instance Generic (Route UniWorX)
 
 
 instance Hashable CourseR
-instance Hashable CAvsR
 instance Hashable SheetR
 instance Hashable SubmissionR
 instance Hashable MaterialR
@@ -78,7 +76,6 @@ instance Ord (Route EmbeddedStatic) where
   compare = compare `on` renderRoute
 
 deriving instance Ord CourseR
-deriving instance Ord CAvsR
 deriving instance Ord SheetR
 deriving instance Ord SubmissionR
 deriving instance Ord MaterialR

src/Handler/Course.hs

@@ -11,7 +11,6 @@ import Import
 import qualified Database.Esqueleto.Legacy as E
 import qualified Database.Persist as P
 
-import Handler.Course.Avs as Handler.Course
 import Handler.Course.Communication as Handler.Course
 import Handler.Course.Delete as Handler.Course
 import Handler.Course.Edit as Handler.Course

src/Handler/Course/Avs.hs

@@ -1,53 +0,0 @@
--- SPDX-FileCopyrightText: 2022 Sarah Vaupel <sarah.vaupel@ifi.lmu.de>
---
--- SPDX-License-Identifier: AGPL-3.0-or-later
-
-module Handler.Course.Avs
-  ( getCAvsRegisterR, postCAvsRegisterR
-  ) where
-
-import Import
-
-import Handler.Utils
-
-import qualified Data.Set as Set
-import qualified Data.Text as Text
-import qualified Data.Time.Zones as TZ
-
-
-data CourseAvsRegisterForm = CourseAvsRegisterForm
-  { cavsregParticipants :: Set Text -- TODO: NonEmpty
-  , cavsregTutorial     :: Maybe Day
-  }
-  deriving (Eq, Ord, Show, Read, Generic, Typeable)
-
-makeLenses_ ''CourseAvsRegisterForm
-
-courseAvsRegisterForm :: Maybe CourseAvsRegisterForm -> AForm Handler CourseAvsRegisterForm
-courseAvsRegisterForm template = wFormToAForm $ do
-  today <- localDay . TZ.utcToLocalTimeTZ appTZ <$> liftIO getCurrentTime
-
-  let
-    cfCommaSeparatedSet :: forall m. Functor m => Field m Text -> Field m (Set Text)
-    cfCommaSeparatedSet = guardField (not . Set.null) . convertField (Set.fromList . mapMaybe (assertM' (not . Text.null) . Text.strip) . Text.splitOn ",") (Text.intercalate ", " . Set.toList)
-
-  aFormToWForm $ CourseAvsRegisterForm
-    <$> areq (textField & cfCommaSeparatedSet) (fslI MsgCourseAvsRegisterParticipants & setTooltip MsgCourseAvsRegisterParticipantsTip) (cavsregParticipants <$> template)
-    <*> optionalActionA
-        ( areq dayField (fslI MsgCourseAvsRegisterTutorialDay) (Just . fromMaybe today . join $ cavsregTutorial <$> template)
-        )
-        (fslI MsgCourseAvsRegisterCreateTutorial) ((is _Just . cavsregTutorial <$> template) <|> Just True)
-
-
-getCAvsRegisterR, postCAvsRegisterR :: TermId -> SchoolId -> CourseShorthand -> Handler Html
-getCAvsRegisterR = postCAvsRegisterR
-postCAvsRegisterR _tid _ssh _csh = do
-  ((_result, formView), formEnctype) <- runFormPost . renderAForm FormStandard $ courseAvsRegisterForm Nothing
-
-  -- TODO: process result
-
-  defaultLayout $ do
-    setTitleI MsgCourseAvsRegisterTitle
-    wrapForm formView def
-      { formEncoding = formEnctype
-      }

src/Handler/Course/ParticipantInvite.hs

@@ -1,4 +1,4 @@
--- SPDX-FileCopyrightText: 2022 Gregor Kleen <gregor.kleen@ifi.lmu.de>,Winnie Ros <winnie.ros@campus.lmu.de>
+-- SPDX-FileCopyrightText: 2022 Gregor Kleen <gregor.kleen@ifi.lmu.de>,Sarah Vaupel <sarah.vaupel@ifi.lmu.de>,Winnie Ros <winnie.ros@campus.lmu.de>
 --
 -- SPDX-License-Identifier: AGPL-3.0-or-later
 
@@ -16,25 +16,48 @@ module Handler.Course.ParticipantInvite
 
 import Import
 
-import Utils.Form
 import Handler.Utils
 import Handler.Utils.Invitations
 import Handler.Utils.Course
 
-import qualified Data.CaseInsensitive as CI
-
-import qualified Data.Set as Set
-import qualified Data.Map as Map
-
 import Jobs.Queue
 
-import Data.Aeson hiding (Result(..))
-
 import Control.Monad.Except (MonadError(..))
 
+import Data.Aeson hiding (Result(..))
+import qualified Data.CaseInsensitive as CI
+import qualified Data.HashSet as HashSet
+import qualified Data.Map as Map
+import qualified Data.Text as Text
+import qualified Data.Time.Zones as TZ
+import qualified Data.Set as Set
+
 import Generics.Deriving.Monoid (memptydefault, mappenddefault)
 
-import qualified Data.HashSet as HashSet
+
+data CourseAvsRegisterForm = CourseAvsRegisterForm
+  { cavsregParticipants :: Set Text -- TODO: NonEmpty
+  , cavsregTutorial     :: Maybe Day
+  }
+  deriving (Eq, Ord, Show, Read, Generic, Typeable)
+
+makeLenses_ ''CourseAvsRegisterForm
+
+-- TODO: merge to postCAddUserR
+_courseAvsRegisterForm :: Maybe CourseAvsRegisterForm -> AForm Handler CourseAvsRegisterForm
+_courseAvsRegisterForm template = wFormToAForm $ do
+  today <- localDay . TZ.utcToLocalTimeTZ appTZ <$> liftIO getCurrentTime
+
+  let
+    cfCommaSeparatedSet :: forall m. Functor m => Field m Text -> Field m (Set Text)
+    cfCommaSeparatedSet = guardField (not . Set.null) . convertField (Set.fromList . mapMaybe (assertM' (not . Text.null) . Text.strip) . Text.splitOn ",") (Text.intercalate ", " . Set.toList)
+
+  aFormToWForm $ CourseAvsRegisterForm
+    <$> areq (textField & cfCommaSeparatedSet) (fslI MsgCourseAvsRegisterParticipants & setTooltip MsgCourseAvsRegisterParticipantsTip) (cavsregParticipants <$> template)
+    <*> optionalActionA
+        ( areq dayField (fslI MsgCourseAvsRegisterTutorialDay) (Just . fromMaybe today . join $ cavsregTutorial <$> template)
+        )
+        (fslI MsgCourseAvsRegisterCreateTutorial) ((is _Just . cavsregTutorial <$> template) <|> Just True)
 
 
 -- Invitations for ordinary participants of this course
@@ -123,6 +146,7 @@ getCAddUserR, postCAddUserR :: TermId -> SchoolId -> CourseShorthand -> Handler
 getCAddUserR = postCAddUserR
 postCAddUserR tid ssh csh = do
     cid <- runDB . getKeyBy404 $ TermSchoolCourseShort tid ssh csh
+
     ((usersToEnlist,formWgt),formEncoding) <- runFormPost . renderWForm FormStandard $ do
       enlist <- wreq checkBoxField (fslI MsgCourseParticipantEnlistDirectly) (Just False)
 
@@ -138,7 +162,6 @@ postCAddUserR tid ssh csh = do
     formResultModal usersToEnlist (CourseR tid ssh csh CUsersR) $
       hoist runDBJobs . registerUsers' cid
 
-
     let heading = prependCourseTitle tid ssh csh MsgCourseParticipantsRegisterHeading
 
     siteLayoutMsg heading $ do
@@ -148,6 +171,7 @@ postCAddUserR tid ssh csh = do
         , formAction = Just . SomeRoute $ CourseR tid ssh csh CAddUserR
         }
 
+
 registerUsers :: CourseId -> Set (Either UserEmail UserId) -> WriterT [Message] (YesodJobDB UniWorX) ()
 registerUsers cid = registerUsers' cid . Map.fromSet (const Nothing)