From 166323cc867578a8f4c160e07dd8f4723f052365 Mon Sep 17 00:00:00 2001
From: Steffen Jost <jost@tcs.ifi.lmu.de>
Date: Tue, 26 Apr 2022 16:48:29 +0200
Subject: [PATCH] chore(lms): add manual job execution buttons to
 qualifications page

---
 routes                             |  2 +-
 src/Handler/LMS.hs                 | 36 +++++++++++++++++++++++++++---
 src/Handler/Qualification.hs       |  2 +-
 templates/lms-all.hamlet           |  5 ++++-
 templates/qualification-all.hamlet |  2 ++
 5 files changed, 41 insertions(+), 6 deletions(-)
 create mode 100644 templates/qualification-all.hamlet

diff --git a/routes b/routes
index 93b67e0b0..bec9e194d 100644
--- a/routes
+++ b/routes
@@ -259,7 +259,7 @@
 /qualification/#SchoolId                                QualificationSchoolR  GET       !free
 /qualification/#SchoolId/#QualificationShorthand        QualificationR        GET       !free -- must be logged in though
 -- OSIS CSV Export Demo
-/lms                                                    LmsAllR               GET 
+/lms                                                    LmsAllR               GET POST
 /lms/#SchoolId                                          LmsSchoolR            GET
 /lms/#SchoolId/#QualificationShorthand                  LmsR  				        GET POST
 /lms/#SchoolId/#QualificationShorthand/edit             LmsEditR			        GET POST
diff --git a/src/Handler/LMS.hs b/src/Handler/LMS.hs
index 9138a1cf4..5bb30b4b6 100644
--- a/src/Handler/LMS.hs
+++ b/src/Handler/LMS.hs
@@ -3,7 +3,7 @@
 {-# LANGUAGE TypeApplications #-}
 
 module Handler.LMS
-  ( getLmsAllR
+  ( getLmsAllR            , postLmsAllR
   , getLmsSchoolR
   , getLmsR               , postLmsR
   , getLmsEditR           , postLmsEditR
@@ -17,6 +17,7 @@ module Handler.LMS
 
 import Import
 
+import Jobs
 import Handler.Utils
 -- import Handler.Utils.Csv
 -- import Handler.Utils.LMS
@@ -37,11 +38,40 @@ import Handler.LMS.Result   as Handler.LMS
 single :: (k,a) -> Map k a
 single = uncurry Map.singleton
 
+-- Button only needed here 
+data ButtonManualLms = LmsEnqueue | LmsDequeue
+  deriving (Enum, Eq, Ord, Bounded, Read, Show, Generic, Typeable)
+instance Universe ButtonManualLms  
+instance Finite   ButtonManualLms
+
+nullaryPathPiece ''ButtonManualLms camelToPathPiece
+
+instance Button UniWorX ButtonManualLms where
+  btnLabel LmsEnqueue = "Enqeue"
+  btnLabel LmsDequeue = "Deqeue"  
+
+  btnClasses LmsEnqueue = [BCIsButton, BCPrimary]
+  btnClasses LmsDequeue = [BCIsButton, BCDefault]
+  
+
 getLmsSchoolR :: SchoolId -> Handler Html
 getLmsSchoolR ssh = redirect (LmsAllR, [("qualification-overview-school", toPathPiece ssh)])
 
-getLmsAllR :: Handler Html
-getLmsAllR = do
+getLmsAllR, postLmsAllR :: Handler Html
+getLmsAllR = postLmsAllR
+postLmsAllR = do
+  ((btnResult, btnWdgt), btnEnctype) <- runFormPost $ identifyForm ("buttons" :: Text) (buttonForm :: Form ButtonManualLms)
+  let btnForm = wrapForm btnWdgt def 
+        { formAction   = Just $ SomeRoute LmsAllR
+        , formEncoding = btnEnctype
+        , formSubmit   = FormNoSubmit
+        }
+  case btnResult of 
+    (FormSuccess LmsEnqueue) -> queueJob' JobLmsQualificationsEnqueue
+    (FormSuccess LmsDequeue) -> queueJob' JobLmsQualificationsDequeue
+    FormMissing -> return ()
+    _other -> addMessage Warning "Kein korrekter LMS Knopf erkannt"
+
   lmsTable <- runDB $ do
     view _2 <$> mkLmsAllTable  
   siteLayoutMsg MsgMenuQualifications $ do
diff --git a/src/Handler/Qualification.hs b/src/Handler/Qualification.hs
index d134c3ebd..edffe55e4 100644
--- a/src/Handler/Qualification.hs
+++ b/src/Handler/Qualification.hs
@@ -37,7 +37,7 @@ getQualificationAllR = do -- TODO just a stub
     view _2 <$> mkLmsAllTable  
   siteLayoutMsg MsgMenuQualifications $ do
     setTitleI MsgMenuQualifications
-    $(widgetFile "lms-all")
+    $(widgetFile "qualification-all")
 
 type AllQualificationTableData = DBRow (Entity Qualification, Ex.Value Word64, Ex.Value Word64)
 resultAllQualification :: Lens' AllQualificationTableData Qualification
diff --git a/templates/lms-all.hamlet b/templates/lms-all.hamlet
index ecfb928b8..02198178f 100644
--- a/templates/lms-all.hamlet
+++ b/templates/lms-all.hamlet
@@ -1 +1,4 @@
-^{lmsTable}
\ No newline at end of file
+<p> 
+  ^{btnForm}
+<p>
+  ^{lmsTable}
\ No newline at end of file
diff --git a/templates/qualification-all.hamlet b/templates/qualification-all.hamlet
new file mode 100644
index 000000000..80b484226
--- /dev/null
+++ b/templates/qualification-all.hamlet
@@ -0,0 +1,2 @@
+<p>
+  ^{lmsTable}
\ No newline at end of file