chore(lpr): convenience buttons for print center

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

@@ -5,6 +5,7 @@ PrintJobId !ident-ok: Id
 PrintJobCreated: Gesendet
 PrintJobAcknowledged: Bestätigt
 PrintJobAcknowledge n@Int64: #{n} #{pluralDE n "Druckauftrag" "Druckaufräge"} als gedruckt und versendet bestätigt
+PrintJobAcknowledgeQuestion n@Int64 d@Text: #{n} #{pluralDE n "Druckauftrag" "Druckaufräge"} vom #{d} als gedruckt und versendet bestätigen?
 PrintRecipient: Empfänger
 PrintSender !ident-ok: Sender
 PrintCourse: Kurse

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

@@ -5,6 +5,7 @@ PrintJobId: Id
 PrintJobCreated: Created
 PrintJobAcknowledged: Acknowledged
 PrintJobAcknowledge n@Int64: #{n} #{pluralENs n "print-job"} marked as printed and mailed
+PrintJobAcknowledgeQuestion n d: Mark #{n} #{pluralENs n "print-job"} issued on #{d} as printed and mailed already?
 PrintRecipient: Recipient
 PrintSender: Sender
 PrintCourse: Course

messages/uniworx/utils/buttons/de-de-formal.msg

@@ -60,4 +60,5 @@ BtnNotifyNewCourseForceOn: Benachrichtigen
 BtnNotifyNewCourseForceOff: Nicht benachrichtigen
 BtnUserAssimilate: Assimilieren
 BtnCloseExam: Prüfung abschließen
-BtnFinishExam: Prüfungsergebnisse sichtbar schalten
+BtnFinishExam: Prüfungsergebnisse sichtbar schalten
+BtnConfirm: Bestätigen

messages/uniworx/utils/buttons/en-eu.msg

@@ -60,4 +60,5 @@ BtnNotifyNewCourseForceOn: Notify me
 BtnNotifyNewCourseForceOff: Do not notify me
 BtnUserAssimilate: Assimilate
 BtnCloseExam: Close exam
-BtnFinishExam: Make results visible
+BtnFinishExam: Make results visible
+BtnConfirm: Confirm

routes

@@ -65,6 +65,7 @@
 /admin/ldap                   AdminLdapR       GET POST 
 
 /print                        PrintCenterR     GET POST        !system-printer
+/print/acknowledge/#Day       PrintAcknowR     GET POST        !system-printer
 /print/send                   PrintSendR       GET POST
 /print/download/#CryptoUUIDPrintJob   PrintDownloadR    GET    !system-printer
 

src/Foundation/Navigation.hs

@@ -25,6 +25,7 @@ import Foundation.Routes
 import Foundation.I18n
 import Foundation.Authorization
 
+import Handler.Utils.DateTime
 import Handler.Utils.Memcached
 import Handler.Utils.ExamOffice.Course
 import Utils.Sheet
@@ -32,6 +33,7 @@ import Utils.Sheet
 import qualified Data.CaseInsensitive as CI
 import qualified Database.Esqueleto.Legacy as E
 import qualified Database.Esqueleto.Utils as E
+import qualified Database.Esqueleto.Experimental as Ex
 
 import Control.Monad.Trans.State (execStateT)
 
@@ -107,9 +109,10 @@ breadcrumb AdminCrontabR    = i18nCrumb MsgBreadcrumbAdminCrontab $ Just AdminR
 breadcrumb AdminAvsR        = i18nCrumb MsgMenuAvs              $ Just AdminR
 breadcrumb AdminLdapR       = i18nCrumb MsgMenuLdap             $ Just AdminR
 
-breadcrumb PrintCenterR       = i18nCrumb MsgMenuApc                Nothing
+breadcrumb PrintCenterR       = i18nCrumb MsgMenuApc              Nothing
-breadcrumb PrintSendR         = i18nCrumb MsgMenuPrintSend        $ Just PrintCenterR
+breadcrumb PrintSendR         = i18nCrumb MsgMenuPrintSend      $ Just PrintCenterR
-breadcrumb (PrintDownloadR _) = i18nCrumb MsgMenuPrintDownload    $ Just PrintCenterR           
+breadcrumb (PrintDownloadR _) = i18nCrumb MsgMenuPrintDownload  $ Just PrintCenterR           
+breadcrumb (PrintAcknowR   _) = i18nCrumb MsgMenuPrintSend      $ Just PrintCenterR
 
 breadcrumb SchoolListR      = i18nCrumb MsgMenuSchoolList       $ Just AdminR
 breadcrumb (SchoolR ssh sRoute) = case sRoute of
@@ -2510,19 +2513,41 @@ pageActions ApiDocsR = return
     , navChildren = []
     }
   ]
-pageActions PrintCenterR = return
+pageActions PrintCenterR = do
-  [ NavPageActionPrimary
+  openDays <- useRunDB $ Ex.select $ do    
-    { navLink = NavLink
+    pj <- Ex.from $ Ex.table @PrintJob
-      { navLabel       = MsgMenuPrintSend
+    let pjDay = E.day $ pj Ex.^. PrintJobCreated 
-      , navRoute       = PrintSendR
+    Ex.where_ $ Ex.isNothing (pj Ex.^. PrintJobAcknowledged)
-      , navAccess'     = NavAccessTrue
+    Ex.groupBy pjDay
-      , navType        = NavTypeLink { navModal = False }
+    Ex.orderBy [ Ex.asc pjDay ]
-      , navQuick'      = mempty
+    pure (pjDay, Ex.countRows)
-      , navForceActive = False
+  let toDayAck (Ex.unValue -> d, Ex.unValue -> n::Int) = do
-      }
+        dtxt <- formatTime SelFormatDate d
-    , navChildren = []
+        let msg = "#" <> tshow n <> ", " <> dtxt
-    }
+        return     NavPageActionPrimary
-  ]
+                    { navLink = NavLink
+                      { navLabel       = SomeMessage msg 
+                      , navRoute       = PrintAcknowR d
+                      , navAccess'     = NavAccessTrue
+                      , navType        = NavTypeLink { navModal = True }
+                      , navQuick'      = mempty
+                      , navForceActive = False
+                      }
+                    , navChildren = []
+                    }
+      manualSend = NavPageActionSecondary
+                    { navLink = NavLink
+                      { navLabel       = MsgMenuPrintSend
+                      , navRoute       = PrintSendR
+                      , navAccess'     = NavAccessTrue
+                      , navType        = NavTypeLink { navModal = False }
+                      , navQuick'      = mempty
+                      , navForceActive = False
+                      }
+                    }
+  dayLinks <- mapM toDayAck openDays             
+  return $ manualSend : take 8 dayLinks  
+
 pageActions _ = return []
 
 submissionList :: ( MonadIO m

src/Handler/PrintCenter.hs

@@ -2,6 +2,7 @@
 
 module Handler.PrintCenter
   ( getPrintCenterR, postPrintCenterR
+  , getPrintAcknowR, postPrintAcknowR
   , getPrintSendR  , postPrintSendR
   , getPrintDownloadR
   ) where
@@ -273,10 +274,9 @@ postPrintCenterR = do
   (pjRes, pjTable) <- runDB mkPJTable
 
   formResult pjRes $ \case
-   (PJActAcknowledgeData, pjIds) -> do
+   (PJActAcknowledgeData, Set.toList -> pjIds) -> do
-    let setPJIds = Set.toList pjIds
     now <- liftIO getCurrentTime
-    num <- runDB $ updateWhereCount  [PrintJobAcknowledged ==. Nothing, PrintJobId <-. setPJIds] [PrintJobAcknowledged =. Just now]
+    num <- runDB $ updateWhereCount  [PrintJobAcknowledged ==. Nothing, PrintJobId <-. pjIds] [PrintJobAcknowledged =. Just now]
     addMessageI Success $ MsgPrintJobAcknowledge num
     redirect currentRoute
 
@@ -348,4 +348,41 @@ getPrintDownloadR cupj = do
         E.where_ (pj E.^. PrintJobId E.==. E.val pjId)
         -- return file entity
         return pj
--}
+-}
+
+
+getPrintAcknowR,  postPrintAcknowR :: Day -> Handler Html
+getPrintAcknowR = postPrintAcknowR
+postPrintAcknowR ackDay = do
+  -- TODO: besser mit cryptoids arbeiten und an den Post Request hängen?!
+  ((ackRes, ackWgt), ackEnctype) <- runFormPost (identifyForm FIDPrintAcknowledge buttonForm :: Form ButtonConfirm)
+  let ackForm = wrapForm ackWgt def
+        { formAction   = Just $ SomeRoute $ PrintAcknowR ackDay
+        , formEncoding = ackEnctype
+        , formSubmit   = FormNoSubmit
+        }
+  formResult ackRes $ \BtnConfirm -> do
+    now <- liftIO getCurrentTime
+    num <- runDB $
+      E.updateCount $ \pj -> do
+        E.set pj [ PrintJobAcknowledged E.=. E.just (E.val now) ]
+        E.where_ $ E.isNothing (pj E.^. PrintJobAcknowledged)
+              E.&&. E.val ackDay E.==. E.day (pj E.^. PrintJobCreated)
+    --  Ex.updateCount $ do
+      --  pj <- Ex.from $ Ex.table @PrintJob
+      --  Ex.set pj [ PrintJobAcknowledged Ex.=. Ex.just (Ex.val now) ]
+      --  Ex.where_ $ Ex.isNothing (pj Ex.^. PrintJobAcknowledged)
+            -- Ex.&&. Ex.val ackDay Ex.==. E.day (pj Ex.^. PrintJobCreated)
+    addMessageI Success $ MsgPrintJobAcknowledge num
+    redirect PrintCenterR
+  ackNum' <- runDB $ Ex.select $ do
+      pj <- Ex.from $ Ex.table @PrintJob
+      Ex.where_ $ Ex.isNothing (pj Ex.^. PrintJobAcknowledged)
+            Ex.&&. Ex.val ackDay Ex.==. E.day (pj Ex.^. PrintJobCreated)
+      pure Ex.countRows
+  let ackNum = headDef 0 $ Ex.unValue <$> ackNum' 
+  ackDayText <- formatTime SelFormatDate ackDay
+  siteLayoutMsg 
+    (MsgPrintJobAcknowledgeQuestion ackNum ackDayText) 
+    ackForm
+

src/Handler/Utils/Form.hs

@@ -126,6 +126,21 @@ instance Button UniWorX ButtonHandIn where
   btnClasses BtnHandIn = [BCIsButton, BCPrimary]
 
 
+data ButtonConfirm = BtnConfirm
+  deriving (Enum, Eq, Ord, Bounded, Read, Show, Generic, Typeable)
+instance Universe ButtonConfirm
+instance Finite ButtonConfirm
+
+nullaryPathPiece ''ButtonConfirm $ camelToPathPiece' 1
+
+embedRenderMessage ''UniWorX ''ButtonConfirm id
+instance Button UniWorX ButtonConfirm where
+  btnClasses BtnConfirm = [BCIsButton, BCDanger]
+
+--confirmButton :: (Button (HandlerSite m) ButtonConfirm, MonadHandler m) => AForm m ()
+--confirmButton = combinedButtonFieldF_ (Proxy @ButtonConfirm) ""
+
+
 
 data ButtonRegister = BtnRegister | BtnDeregister
   deriving (Enum, Eq, Ord, Bounded, Read, Show, Generic, Typeable)

src/Utils/Form.hs

@@ -278,6 +278,7 @@ data FormIdentifier
   | FIDDBTableCsvImport Text
   | FIDDBTableCsvImportConfirm Text
   | FIDDelete
+  | FIDPrintAcknowledge
   | FIDCourseRegister
   | FIDuserRights
   | FIDUserSystemFunctions