chore(lms): add manual job execution buttons to qualifications page

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

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

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

templates/lms-all.hamlet

@@ -1 +1,4 @@
-^{lmsTable}
+<p> 
+  ^{btnForm}
+<p>
+  ^{lmsTable}

templates/qualification-all.hamlet

@@ -0,0 +1,2 @@
+<p>
+  ^{lmsTable}