chore(lms): wip actions for lms table

messages/uniworx/categories/qualification/de-de-formal.msg

@@ -45,3 +45,5 @@ LmsErrorNoRefreshElearning: Fehler: E-Lernen wird nicht automatisch gestartet, d
 MailSubjectQualificationRenewal qname@Text: Ihre Qualifikation #{qname} muss demnächst erneuert werden
 MailSubjectQualificationExpiry qname@Text: Ihre Qualifikation #{qname} läuft demnächst ab
 MailLmsRenewalBody: Sie müssen diese Qualifikaton demnächst durch einen E-Learning Kurs erneuern.
+LmsActNotify: Benachrichtigung E-Lernen erneut versenden
+LmsActRenewPin: Neue zufällig E-Lernen PIN setzen

messages/uniworx/categories/qualification/en-eu.msg

@@ -45,3 +45,5 @@ LmsErrorNoRefreshElearning: Error: E-learning will not be started automatically
 MailSubjectQualificationRenewal qname@Text: Your qualification #{qname} must be renewed shortly
 MailSubjectQualificationExpiry qname@Text: Your qualification #{qname} expires soon
 MailLmsRenewalBody: You will soon need to renew this qualficiation by completing an e-learning course.
+LmsActNotify: Send e-learning notification again
+LmsActRenewPin: Randomly replace e-learning PIN

src/Handler/LMS.hs

@@ -149,20 +149,6 @@ mkLmsAllTable = do
           ]
         dbtStyle =  def { dbsFilterLayout = defaultDBSFilterLayout }
         dbtParams = def
-            {-    = DBParamsForm
-          { dbParamsFormMethod = POST
-          , dbParamsFormAction = Just $ SomeRoute currentRoute
-          , dbParamsFormAttrs  = []
-          , dbParamsFormSubmit = FormSubmit
-          , dbParamsFormAdditional
-              = renderAForm FormStandard
-                   $  (, mempty) . First . Just
-                  <$> multiActionA acts (fslI MsgTableAction) Nothing
-          , dbParamsFormEvaluate = liftHandler . runFormPost
-          , dbParamsFormResult   = id
-          , dbParamsFormIdent    = def
-          }
-          -}
         dbtIdent :: Text
         dbtIdent = "qualification-overview"
         dbtCsvEncode = noCsvEncode
@@ -210,9 +196,25 @@ instance HasEntity LmsTableData User where
 instance HasUser LmsTableData where
   hasUser = resultUser . _entityVal
 
-mkLmsTable :: Entity Qualification -> DB (Any, Widget)
+data LmsTableAction = LmsActNotify
+                    | LmsActRenewPin
+  deriving (Eq, Ord, Enum, Bounded, Read, Show, Generic, Typeable)
+
+instance Universe LmsTableAction
+instance Finite LmsTableAction
+nullaryPathPiece ''LmsTableAction $ camelToPathPiece' 2
+embedRenderMessage ''UniWorX ''LmsTableAction id
+
+-- Not yet needed, since there is no additional data for now:
+data LmsTableActionData = LmsActNotifyData
+                        | LmsActRenewPinData
+  deriving (Eq, Ord, Read, Show, Generic, Typeable)
+
+
+mkLmsTable :: Entity Qualification -> DB (FormResult (LmsTableActionData, Set UserId), Widget)
 mkLmsTable (Entity qid quali) = do
   now <- liftIO getCurrentTime
+  currentRoute <- fromMaybe (error "mkLmsAllTable called from 404-handler") <$> liftHandler getCurrentRoute
   let
     nowaday = utctDay now
     mbRenewal = addGregorianDurationClip <$> qualificationRefreshWithin quali <*> Just nowaday
@@ -278,16 +280,39 @@ mkLmsTable (Entity qid quali) = do
             else prismAForm (singletonFilter "renewal-due" . maybePrism _PathPiece) mPrev $ aopt checkBoxField (fslI MsgFilterLmsRenewal)
           ]
         dbtStyle =  def { dbsFilterLayout = defaultDBSFilterLayout }
-        dbtParams = def
         dbtIdent :: Text
         dbtIdent = "qualification"
         dbtCsvEncode = noCsvEncode
         dbtCsvDecode = Nothing
         dbtExtraReps = []
+        dbtParams = DBParamsForm
+          { dbParamsFormMethod = POST
+          , dbParamsFormAction = Just $ SomeRoute currentRoute
+          , dbParamsFormAttrs  = []
+          , dbParamsFormSubmit = FormSubmit
+          , dbParamsFormAdditional
+              = renderAForm FormStandard
+                   $  (, mempty) . First . Just
+                  <$> multiActionA acts (fslI MsgTableAction) Nothing
+          , dbParamsFormEvaluate = liftHandler . runFormPost
+          , dbParamsFormResult   = id
+          , dbParamsFormIdent    = def
+          }
+
+        acts :: Map LmsTableAction (AForm Handler LmsTableActionData)
+        acts = mconcat
+          [ singletonMap LmsActNotify    $ pure LmsActNotifyData
+          , singletonMap LmsActRenewPin  $ pure LmsActRenewPinData
+          ]
+    postprocess :: FormResult (First LmsTableActionData, DBFormResult UserId Bool (DBRow (Entity User))) -> FormResult (LmsTableActionData, Set UserId)
+    postprocess inp = do
+        (First (Just act), usrMap) <- inp
+        let usrSet = Map.keysSet . Map.filter id $ getDBFormResult (const False) usrMap
+        return (act, usrSet)
 
     resultDBTableValidator = def
       -- & defaultSorting [SortAscBy csvLmsIdent]
-  dbTable resultDBTableValidator resultDBTable
+  over _1 postprocess <$> dbTable resultDBTableValidator resultDBTable
 
 getLmsR,  postLmsR :: SchoolId -> QualificationShorthand -> Handler Html
 getLmsR = postLmsR