feat(allocations): edit allocation-user and their applications

2021-06-10 12:29:25 +02:00 · 2021-06-10 12:29:25 +02:00 · 4daf33a1a0
commit 4daf33a1a0
parent b742731511
11 changed files with 266 additions and 102 deletions
--- a/messages/uniworx/categories/courses/allocation/de-de-formal.msg
+++ b/messages/uniworx/categories/courses/allocation/de-de-formal.msg
@ -13,6 +13,9 @@ AllocationAddUserTitle termText@Text ssh'@SchoolShorthand allocation@AllocationN
 AllocationAddUserShortTitle tid@TermId ssh@SchoolId ash@AllocationShorthand: #{tid}-#{ssh}-#{ash}: Bewerber:in hinzufügen
 AllocationAddUserUserAdded: Bewerber:in erfolgreich zur Zentralanmeldung hinzugefügt
 AllocationAddUserUserExists: Der/Die angegebene Benutzer/Benutzerin ist bereits ein/eine Bewerber/Bewerberin zur Zentralanmeldung
+AllocationEditUserUserEdited: Bewerber:in erfolgreich bearbeitet
+AllocationEditUserTitle termText@Text ssh@SchoolShorthand ash@AllocationShorthand userDisplayName@Text: #{termText} - #{ssh} - #{ash}, Bewerber:in bearbeiten: #{userDisplayName}
+AllocationEditUserShortTitle tid@TermId ssh@SchoolId ash@AllocationShorthand userDisplayName@Text !ident-ok: #{tid}-#{ssh}-#{ash}: #{userDisplayName}
 AllocationPriority: Priorität
 CourseAllocationCourseAcceptsSubstitutesUntil: Akzeptiert Nachrücker:innen bis
 CourseAllocationCourseAcceptsSubstitutesNever: Akzeptiert keine Nachrücker:innen
--- a/messages/uniworx/categories/courses/allocation/en-eu.msg
+++ b/messages/uniworx/categories/courses/allocation/en-eu.msg
@ -13,6 +13,9 @@ AllocationAddUserTitle termText ssh' allocation: #{termText} - #{ssh'} - #{alloc
 AllocationAddUserShortTitle tid@TermId ssh@SchoolId ash@AllocationShorthand: #{tid}-#{ssh}-#{ash}: Add applicant
 AllocationAddUserUserAdded: Successfully added applicant to central allocation
 AllocationAddUserUserExists: The specified user is already an applicant for the central allocation
+AllocationEditUserUserEdited: Successfully edited applicant
+AllocationEditUserTitle termText ssh ash userDisplayName: #{termText} - #{ssh} - #{ash}, Edit applicant: #{userDisplayName}
+AllocationEditUserShortTitle tid ssh ash userDisplayName !ident-ok: #{tid}-#{ssh}-#{ash}: #{userDisplayName}
 AllocationPriority: Priority
 CourseAllocationCourseAcceptsSubstitutesUntil: Accepts substitutes until
 CourseAllocationCourseAcceptsSubstitutesNever: Does not accept substitutes
--- a/messages/uniworx/utils/navigation/breadcrumbs/de-de-formal.msg
+++ b/messages/uniworx/utils/navigation/breadcrumbs/de-de-formal.msg
@ -73,6 +73,7 @@ BreadcrumbAllocationPriorities: Zentrale Dringlichkeiten
 BreadcrumbAllocationCompute: Platzvergabe berechnen
 BreadcrumbAllocationAccept: Platzvergabe akzeptieren
 BreadcrumbAllocationAddUser: Bewerber:in hinzufügen
+BreadcrumbAllocationEditUser: Bewerber:in bearbeiten
 BreadcrumbMessageHide: Verstecken
 BreadcrumbFaq !ident-ok: FAQ
 BreadcrumbSheetPersonalisedFiles: Personalisierte Dateien herunterladen
--- a/messages/uniworx/utils/navigation/breadcrumbs/en-eu.msg
+++ b/messages/uniworx/utils/navigation/breadcrumbs/en-eu.msg
@ -73,6 +73,7 @@ BreadcrumbAllocationPriorities: Central priorities
 BreadcrumbAllocationCompute: Compute allocation
 BreadcrumbAllocationAccept: Accept allocation
 BreadcrumbAllocationAddUser: Add applicant
+BreadcrumbAllocationEditUser: Edit applicant
 BreadcrumbMessageHide: Hide
 BreadcrumbFaq: FAQ
 BreadcrumbSheetPersonalisedFiles: Download personalised sheet files
--- a/3
+++ b/3
@ -161,7 +161,8 @@
  /register                                      ARegisterR         POST        !time
  /course/#CryptoUUIDCourse/apply                AApplyR            POST        !timeANDallocation-registered
  /users                                         AUsersR        GET POST        !allocation-admin
-  /users/add                                     AAddUserR      GET POST        !allocation-admin
+  /users/#CryptoUUIDUser                         AEditUserR     GET POST        !allocation-admin
+  !/users/add                                    AAddUserR      GET POST        !allocation-admin
  /priorities                                    APriosR        GET POST        !allocation-admin
  /compute                                       AComputeR      GET POST        !allocation-admin
  /accept                                        AAcceptR       GET POST        !allocation-admin
--- a/src/Foundation/Navigation.hs
+++ b/src/Foundation/Navigation.hs
@ -213,6 +213,11 @@ breadcrumb (AllocationR tid ssh ash sRoute) = case sRoute of
  AComputeR   -> i18nCrumb MsgBreadcrumbAllocationCompute . Just $ AllocationR tid ssh ash AUsersR
  AAcceptR    -> i18nCrumb MsgBreadcrumbAllocationAccept . Just $ AllocationR tid ssh ash AUsersR
  AAddUserR   -> i18nCrumb MsgBreadcrumbAllocationAddUser . Just $ AllocationR tid ssh ash AUsersR
+  AEditUserR cID -> useRunDB . maybeT (i18nCrumb MsgBreadcrumbAllocationEditUser . Just $ AllocationR tid ssh ash AUsersR) $ do
+    guardM . lift . hasReadAccessTo . AllocationR tid ssh ash $ AEditUserR cID
+    uid <- decrypt cID
+    User{..} <- MaybeT $ get uid
+    return (userDisplayName, Just $ AllocationR tid ssh ash AUsersR)

 breadcrumb ParticipantsListR      = i18nCrumb MsgBreadcrumbParticipantsList $ Just CourseListR
 breadcrumb (ParticipantsR _ _)    = i18nCrumb MsgBreadcrumbParticipants     $ Just ParticipantsListR
--- a/src/Handler/Allocation.hs
+++ b/src/Handler/Allocation.hs
@ -9,6 +9,7 @@ import Handler.Allocation.Register as Handler.Allocation
 import Handler.Allocation.List as Handler.Allocation
 import Handler.Allocation.Users as Handler.Allocation
 import Handler.Allocation.AddUser as Handler.Allocation
+import Handler.Allocation.EditUser as Handler.Allocation
 import Handler.Allocation.Prios as Handler.Allocation
 import Handler.Allocation.Compute as Handler.Allocation
 import Handler.Allocation.Accept as Handler.Allocation
--- a/src/Handler/Allocation/AddUser.hs
+++ b/src/Handler/Allocation/AddUser.hs
@ -4,46 +4,25 @@ module Handler.Allocation.AddUser

 import Import
 import Handler.Allocation.Application
+import Handler.Allocation.UserForm

 import Handler.Utils

-import qualified Data.Map as Map
+import qualified Data.Map.Strict as Map

 import qualified Data.Conduit.Combinators as C

-import qualified Database.Esqueleto as E
-
-
-data AllocationAddUserForm = AllocationAddUserForm
-  { aauUser :: UserId
-  , aauTotalCourses :: Word64
-  , aauPriority :: Maybe AllocationPriority
-  , aauApplications :: Map CourseId ApplicationForm
-  }
-  

 getAAddUserR, postAAddUserR :: TermId -> SchoolId -> AllocationShorthand -> Handler Html
 getAAddUserR = postAAddUserR
 postAAddUserR tid ssh ash = do
  (Entity _ Allocation{..}, (addUserAct, addUserForm, addUserEnctype)) <- runDB $ do
    alloc@(Entity aId _) <- getBy404 $ TermSchoolAllocationShort tid ssh ash
-    allocCourses <- E.select . E.from $ \(course `E.InnerJoin` allocationCourse) -> do
-      E.on $ allocationCourse E.^. AllocationCourseCourse E.==. course E.^. CourseId
-      E.where_ $ allocationCourse E.^. AllocationCourseAllocation E.==. E.val aId
-      return ( course
-             , E.exists . E.from $ \courseAppInstructionFile ->
-                 E.where_ $ courseAppInstructionFile E.^. CourseAppInstructionFileCourse E.==. course E.^. CourseId
-             , allocationCourse
-             )

-    MsgRenderer mr <- getMsgRenderer
-    ((addUserRes, addUserForm), addUserEnctype) <- liftHandler . runFormPost . renderAForm FormStandard $ AllocationAddUserForm
-      <$> areq (checkMap (first $ const MsgAllocationAddUserUserNotFound) Right $ userField False Nothing) (fslpI MsgAllocationAddUserUser (mr MsgAllocationAddUserUserPlaceholder)) Nothing
-      <*> areq (posIntFieldI MsgAllocationAddUserTotalCoursesLessThanOne) (fslI MsgAllocationAddUserTotalCourses) (Just 1)
-      <*> optionalActionA (allocationPriorityForm (fslI MsgAllocationAddUserPriority) Nothing) (fslI MsgAllocationAddUserSetPriority) (Just True)
-      <*> allocationApplicationsForm aId (Map.fromList [ (cId, (course, allocationCourse, hasTemplate)) | (Entity cId course, E.Value hasTemplate, Entity _ allocationCourse) <- allocCourses ]) (fslI MsgAllocationAddUserApplications) False
+    ((addUserRes, addUserForm), addUserEnctype) <- runFormPost . renderAForm FormStandard $ 
+      allocationUserForm aId Nothing

-    addUserAct <- formResultMaybe addUserRes $ \AllocationAddUserForm{..} -> Just <$> do
+    addUserAct <- formResultMaybe addUserRes $ \AllocationUserForm{..} -> Just <$> do
      now <- liftIO getCurrentTime
      
      didInsert <- is _Just <$> insertUnique AllocationUser
@ -57,6 +36,7 @@ postAAddUserR tid ssh ash = do
        | didInsert -> do
            oldApps <- selectList [CourseApplicationUser ==. aauUser, CourseApplicationAllocation ==. Just aId] []
            forM_ oldApps $ \(Entity appId CourseApplication{..}) -> do
+              deleteWhere [ CourseApplicationFileApplication ==. appId ]
              delete appId
              unless (courseApplicationCourse `Map.member` aauApplications) $ 
                audit $ TransactionCourseApplicationDeleted courseApplicationCourse courseApplicationUser appId
@ -103,77 +83,3 @@ postAAddUserR tid ssh ash = do
      , formAnchor = Nothing :: Maybe Text
      }

-allocationApplicationsForm :: AllocationId
-                           -> Map CourseId (Course, AllocationCourse, Bool)
-                           -> FieldSettings UniWorX
-                           -> Bool
-                           -> AForm Handler (Map CourseId ApplicationForm)
-allocationApplicationsForm aId courses FieldSettings{..} fvRequired = formToAForm $ do
-  now <- liftIO getCurrentTime
-  
-  let afmApplicant = True
-      afmApplicantEdit = True
-      afmLecturer = True
-
-  appsRes' <- iforM courses $ \cId (course, allocCourse, hasApplicationTemplate) -> do
-    mApplicationTemplate <- runMaybeT $ do
-      guard hasApplicationTemplate
-      let Course{..} = course
-      toTextUrl $ CourseR courseTerm courseSchool courseShorthand CRegisterTemplateR
-    over _2 (course, allocCourse, mApplicationTemplate, ) <$> applicationForm (Just aId) cId Nothing ApplicationFormMode{..} Nothing
-  let appsRes = sequenceA $ view _1 <$> appsRes'
-      appsViews = view _2 <$> appsRes'
-  
-  let fvInput =
-        [whamlet|
-          $newline never
-          <div .allocation__courses>
-            $forall (Course{courseTerm, courseSchool, courseShorthand, courseName, courseApplicationsInstructions}, AllocationCourse{allocationCourseAcceptSubstitutes}, mApplicationTemplate, ApplicationFormView{afvPriority, afvForm}) <- Map.elems appsViews
-              <div .allocation-course>
-                <div .allocation-course__priority-label .allocation__label>
-                  _{MsgAllocationPriority}
-                <div .allocation-course__priority>
-                  $maybe prioView <- afvPriority
-                    ^{fvWidget prioView}
-                <a .allocation-course__name href=@{CourseR courseTerm courseSchool courseShorthand CShowR} target="_blank">
-                  #{courseName}
-                <div .allocation-course__admin-info>
-                  <p>
-                    $maybe deadline <- allocationCourseAcceptSubstitutes
-                      _{MsgCourseAllocationCourseAcceptsSubstitutesUntil}: #
-                      ^{formatTimeW SelFormatDateTime deadline}
-                    $nothing
-                      _{MsgCourseAllocationCourseAcceptsSubstitutesNever}
-                    $if allocationCourseAcceptSubstitutes >= Just now
-                      \ ^{iconOK}
-                $if is _Just mApplicationTemplate || is _Just courseApplicationsInstructions
-                  <div .allocation-course__instructions-label .allocation__label>
-                    _{MsgCourseAllocationApplicationInstructionsApplication}
-                  <div .allocation-course__instructions>
-                    $maybe aInst <- courseApplicationsInstructions
-                      <p>
-                        #{aInst}
-                    $maybe templateUrl <- mApplicationTemplate
-                      <p>
-                        <a href=#{templateUrl}>
-                          #{iconRegisterTemplate} _{MsgCourseAllocationApplicationTemplateApplication}
-                <div .allocation-course__application-label .interactive-fieldset__target .allocation__label uw-interactive-fieldset data-conditional-input=#{maybe "" fvId afvPriority} data-conditional-value="" data-conditional-negated>
-                  _{MsgCourseApplication}
-                <div .allocation-course__application .interactive-fieldset__target uw-interactive-fieldset data-conditional-input=#{maybe "" fvId afvPriority} data-conditional-value="" data-conditional-negated>
-                  ^{renderFieldViews FormStandard afvForm}
-        |]
-  MsgRenderer mr <- getMsgRenderer
-  let fvLabel = toHtml $ mr fsLabel
-      fvTooltip = toHtml . mr <$> fsTooltip
-      fvErrors = case appsRes of
-        FormFailure errs -> Just
-          [shamlet|
-            $newline never
-            <ul>
-              $forall err <- errs
-                <li>#{err}
-          |]
-        _other -> Nothing
-  fvId <- maybe newIdent return fsId
-  
-  return (appsRes, pure FieldView{..})
--- a/src/Handler/Allocation/EditUser.hs
+++ b/src/Handler/Allocation/EditUser.hs
@ -0,0 +1,90 @@
+module Handler.Allocation.EditUser
+  ( getAEditUserR, postAEditUserR
+  ) where
+
+import Import
+import Handler.Allocation.Application
+import Handler.Allocation.UserForm
+
+import Handler.Utils
+
+import qualified Data.Map.Strict as Map
+
+import qualified Data.Conduit.Combinators as C
+
+
+getAEditUserR, postAEditUserR :: TermId -> SchoolId -> AllocationShorthand -> CryptoUUIDUser -> Handler Html
+getAEditUserR = postAEditUserR
+postAEditUserR tid ssh ash cID = do
+  (Entity _ Allocation{..}, User{..}, (editUserAct, editUserForm, editUserEnctype)) <- runDB $ do
+    uid <- decrypt cID
+    user <- get404 uid
+    alloc@(Entity aId _) <- getBy404 $ TermSchoolAllocationShort tid ssh ash
+    Entity auId AllocationUser{..} <- getBy404 $ UniqueAllocationUser aId uid
+
+    ((editUserRes, editUserForm), editUserEnctype) <- runFormPost . renderAForm FormStandard $ 
+      allocationUserForm aId $ Just AllocationUserForm
+        { aauUser = uid
+        , aauTotalCourses = allocationUserTotalCourses
+        , aauPriority = allocationUserPriority
+        , aauApplications = Map.empty -- form collects existing applications itself
+        }
+
+    editUserAct <- formResultMaybe editUserRes $ \AllocationUserForm{..} -> Just <$> do
+      now <- liftIO getCurrentTime
+      
+      replace auId AllocationUser
+        { allocationUserAllocation = aId
+        , allocationUserUser = aauUser
+        , allocationUserTotalCourses = aauTotalCourses
+        , allocationUserPriority = aauPriority
+        }
+
+      oldApps <- selectList [CourseApplicationUser ==. aauUser, CourseApplicationAllocation ==. Just aId] []
+      forM_ oldApps $ \(Entity appId CourseApplication{..}) -> do
+        deleteWhere [ CourseApplicationFileApplication ==. appId ]
+        delete appId
+        unless (courseApplicationCourse `Map.member` aauApplications) $ 
+          audit $ TransactionCourseApplicationDeleted courseApplicationCourse courseApplicationUser appId
+
+      iforM_ aauApplications $ \cId ApplicationForm{..} -> maybeT_ $ do
+        prio <- hoistMaybe afPriority
+        let rated = afRatingVeto || is _Just afRatingPoints
+        appId <- lift $ insert CourseApplication
+          { courseApplicationCourse = cId
+          , courseApplicationUser = aauUser
+          , courseApplicationText = afText
+          , courseApplicationRatingVeto = afRatingVeto
+          , courseApplicationRatingPoints = afRatingPoints
+          , courseApplicationRatingComment = afRatingComment
+          , courseApplicationAllocation = Just aId
+          , courseApplicationAllocationPriority = Just prio
+          , courseApplicationTime = now
+          , courseApplicationRatingTime = guardOn rated now
+          }
+        lift . runConduit $ transPipe liftHandler (sequence_ afFiles) .| C.mapM_ (insert_ . review _FileReference . (, CourseApplicationFileResidual appId))
+        lift . audit $ TransactionCourseApplicationEdit cId aauUser appId
+
+      return $ do
+        addMessageI Success MsgAllocationEditUserUserEdited
+        redirect $ AllocationR tid ssh ash AUsersR
+
+    return (alloc, user, (editUserAct, editUserForm, editUserEnctype))
+
+  sequence_ editUserAct
+
+  MsgRenderer mr <- getMsgRenderer
+  let title = MsgAllocationEditUserTitle (mr . ShortTermIdentifier $ unTermKey allocationTerm) (unSchoolKey allocationSchool) allocationShorthand userDisplayName
+      shortTitle = MsgAllocationEditUserShortTitle allocationTerm allocationSchool allocationShorthand userDisplayName
+
+  siteLayoutMsg title $ do
+    setTitleI shortTitle
+    wrapForm editUserForm FormSettings
+      { formMethod = POST
+      , formAction = Just . SomeRoute . AllocationR tid ssh ash $ AEditUserR cID
+      , formEncoding = editUserEnctype
+      , formAttrs = []
+      , formSubmit = FormSubmit
+      , formAnchor = Nothing :: Maybe Text
+      }
+
--- a/src/Handler/Allocation/UserForm.hs
+++ b/src/Handler/Allocation/UserForm.hs
@ -0,0 +1,149 @@
+module Handler.Allocation.UserForm
+  ( AllocationUserForm(..)
+  , allocationUserForm
+  ) where
+
+import Import
+import Handler.Allocation.Application
+
+import Handler.Utils
+
+import qualified Database.Esqueleto as E
+import qualified Data.Map.Strict as Map
+
+import Text.Blaze (toMarkup)
+
+
+data AllocationUserForm = AllocationUserForm
+  { aauUser :: UserId
+  , aauTotalCourses :: Word64
+  , aauPriority :: Maybe AllocationPriority
+  , aauApplications :: Map CourseId ApplicationForm
+  }
+
+
+allocationUserForm :: forall m backend.
+                      ( MonadHandler m, HandlerSite m ~ UniWorX
+                      , E.SqlBackendCanRead backend, IsSqlBackend backend
+                      )
+                   => AllocationId
+                   -> Maybe AllocationUserForm
+                   -> AForm (ReaderT backend m) AllocationUserForm
+allocationUserForm aId mTemplate = wFormToAForm $ do
+  allocCourses <- lift . lift . E.select . E.from $ \(course `E.InnerJoin` allocationCourse) -> do
+    E.on $ allocationCourse E.^. AllocationCourseCourse E.==. course E.^. CourseId
+    E.where_ $ allocationCourse E.^. AllocationCourseAllocation E.==. E.val aId
+    return ( course
+           , E.exists . E.from $ \courseAppInstructionFile ->
+               E.where_ $ courseAppInstructionFile E.^. CourseAppInstructionFileCourse E.==. course E.^. CourseId
+           , allocationCourse
+           )
+  
+  MsgRenderer mr <- getMsgRenderer
+  
+  userRes <- case aauUser <$> mTemplate of
+    Just u -> do
+      User{..} <- lift . lift $ get404 u
+      fvId <- newIdent
+      lift . tell $ pure FieldView
+        { fvLabel = toMarkup $ mr MsgAllocationAddUserUser
+        , fvTooltip = Nothing
+        , fvId
+        , fvInput = nameWidget userDisplayName userSurname
+        , fvErrors = Nothing
+        , fvRequired = False
+        }
+      return $ FormSuccess u
+    Nothing -> wreq (checkMap (first $ const MsgAllocationAddUserUserNotFound) Right $ userField False Nothing) (fslpI MsgAllocationAddUserUser (mr MsgAllocationAddUserUserPlaceholder)) Nothing
+
+  totalCoursesRes <- wreq (posIntFieldI MsgAllocationAddUserTotalCoursesLessThanOne) (fslI MsgAllocationAddUserTotalCourses) ((aauTotalCourses <$> mTemplate) <|> Just 1)
+
+  priorityRes <- hoist (hoist liftHandler) $ optionalActionW (allocationPriorityForm (fslI MsgAllocationAddUserPriority) $ aauPriority =<< mTemplate) (fslI MsgAllocationAddUserSetPriority) ((is _Just . aauPriority <$> mTemplate) <|> Just True)
+
+  applicationsRes <- aFormToWForm $ allocationApplicationsForm aId (aauUser <$> mTemplate) (Map.fromList [ (cId, (course, allocationCourse, hasTemplate)) | (Entity cId course, E.Value hasTemplate, Entity _ allocationCourse) <- allocCourses ]) (fslI MsgAllocationAddUserApplications) False
+
+  return $ AllocationUserForm
+    <$> userRes
+    <*> totalCoursesRes
+    <*> priorityRes
+    <*> applicationsRes
+
+
+allocationApplicationsForm :: forall m.
+                              ( MonadHandler m, HandlerSite m ~ UniWorX
+                              )
+                           => AllocationId
+                           -> Maybe UserId
+                           -> Map CourseId (Course, AllocationCourse, Bool)
+                           -> FieldSettings UniWorX
+                           -> Bool
+                           -> AForm m (Map CourseId ApplicationForm)
+allocationApplicationsForm aId muid courses FieldSettings{..} fvRequired  = formToAForm . hoist liftHandler $ do
+  now <- liftIO getCurrentTime
+  
+  let afmApplicant = True
+      afmApplicantEdit = True
+      afmLecturer = True
+
+  appsRes' <- iforM courses $ \cId (course, allocCourse, hasApplicationTemplate) -> do
+    mApplicationTemplate <- runMaybeT $ do
+      guard hasApplicationTemplate
+      let Course{..} = course
+      toTextUrl $ CourseR courseTerm courseSchool courseShorthand CRegisterTemplateR
+    over _2 (course, allocCourse, mApplicationTemplate, ) <$> applicationForm (Just aId) cId muid ApplicationFormMode{..} Nothing
+  let appsRes = sequenceA $ view _1 <$> appsRes'
+      appsViews = view _2 <$> appsRes'
+  
+  let fvInput =
+        [whamlet|
+          $newline never
+          <div .allocation__courses>
+            $forall (Course{courseTerm, courseSchool, courseShorthand, courseName, courseApplicationsInstructions}, AllocationCourse{allocationCourseAcceptSubstitutes}, mApplicationTemplate, ApplicationFormView{afvPriority, afvForm}) <- Map.elems appsViews
+              <div .allocation-course>
+                <div .allocation-course__priority-label .allocation__label>
+                  _{MsgAllocationPriority}
+                <div .allocation-course__priority>
+                  $maybe prioView <- afvPriority
+                    ^{fvWidget prioView}
+                <a .allocation-course__name href=@{CourseR courseTerm courseSchool courseShorthand CShowR} target="_blank">
+                  #{courseName}
+                <div .allocation-course__admin-info>
+                  <p>
+                    $maybe deadline <- allocationCourseAcceptSubstitutes
+                      _{MsgCourseAllocationCourseAcceptsSubstitutesUntil}: #
+                      ^{formatTimeW SelFormatDateTime deadline}
+                    $nothing
+                      _{MsgCourseAllocationCourseAcceptsSubstitutesNever}
+                    $if allocationCourseAcceptSubstitutes >= Just now
+                      \ ^{iconOK}
+                $if is _Just mApplicationTemplate || is _Just courseApplicationsInstructions
+                  <div .allocation-course__instructions-label .allocation__label>
+                    _{MsgCourseAllocationApplicationInstructionsApplication}
+                  <div .allocation-course__instructions>
+                    $maybe aInst <- courseApplicationsInstructions
+                      <p>
+                        #{aInst}
+                    $maybe templateUrl <- mApplicationTemplate
+                      <p>
+                        <a href=#{templateUrl}>
+                          #{iconRegisterTemplate} _{MsgCourseAllocationApplicationTemplateApplication}
+                <div .allocation-course__application-label .interactive-fieldset__target .allocation__label uw-interactive-fieldset data-conditional-input=#{maybe "" fvId afvPriority} data-conditional-value="" data-conditional-negated>
+                  _{MsgCourseApplication}
+                <div .allocation-course__application .interactive-fieldset__target uw-interactive-fieldset data-conditional-input=#{maybe "" fvId afvPriority} data-conditional-value="" data-conditional-negated>
+                  ^{renderFieldViews FormStandard afvForm}
+        |]
+  MsgRenderer mr <- getMsgRenderer
+  let fvLabel = toHtml $ mr fsLabel
+      fvTooltip = toHtml . mr <$> fsTooltip
+      fvErrors = case appsRes of
+        FormFailure errs -> Just
+          [shamlet|
+            $newline never
+            <ul>
+              $forall err <- errs
+                <li>#{err}
+          |]
+        _other -> Nothing
+  fvId <- maybe newIdent return fsId
+  
+  return (appsRes, pure FieldView{..})
--- a/src/Handler/Allocation/Users.hs
+++ b/src/Handler/Allocation/Users.hs
@ -194,7 +194,11 @@ postAUsersR tid ssh ash = do
              <$> view _1 <*> pure feats <*> view _2 <*> view (_3 . _Value) <*> view (_4 . _Value) <*> view (_5 . _Value)
          dbtColonnade :: Colonnade Sortable _ _
          dbtColonnade = mconcat . catMaybes $
-            [ pure $ colUserDisplayName (resultUser . _entityVal . $(multifocusL 2) _userDisplayName _userSurname)
+            [ pure . sortable (Just "user-name") (i18nCell MsgUserDisplayName) $ \(view resultUser -> Entity uid User{..})
+                -> let mkUrl = do
+                         cID <- encrypt uid
+                         return . AllocationR tid ssh ash $ AEditUserR cID
+                    in anchorCellM mkUrl (nameWidget userDisplayName userSurname)
            , pure $ colUserMatriculation (resultUser . _entityVal . _userMatrikelnummer)
            , pure $ colStudyFeatures resultStudyFeatures
            , pure $ colAllocationRequested (resultAllocationUser . _entityVal . _allocationUserTotalCourses . _Integral)