diff --git a/messages/uniworx/categories/print/de-de-formal.msg b/messages/uniworx/categories/print/de-de-formal.msg index 4d1613955..e1d1cb4e1 100644 --- a/messages/uniworx/categories/print/de-de-formal.msg +++ b/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 diff --git a/messages/uniworx/categories/print/en-eu.msg b/messages/uniworx/categories/print/en-eu.msg index db5b04ca2..87e0bbb47 100644 --- a/messages/uniworx/categories/print/en-eu.msg +++ b/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 diff --git a/messages/uniworx/utils/buttons/de-de-formal.msg b/messages/uniworx/utils/buttons/de-de-formal.msg index 49d4bf8c1..fafba10cb 100644 --- a/messages/uniworx/utils/buttons/de-de-formal.msg +++ b/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 \ No newline at end of file +BtnFinishExam: Prüfungsergebnisse sichtbar schalten +BtnConfirm: Bestätigen \ No newline at end of file diff --git a/messages/uniworx/utils/buttons/en-eu.msg b/messages/uniworx/utils/buttons/en-eu.msg index 3f3e8d03f..cfae898ce 100644 --- a/messages/uniworx/utils/buttons/en-eu.msg +++ b/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 \ No newline at end of file +BtnFinishExam: Make results visible +BtnConfirm: Confirm \ No newline at end of file diff --git a/routes b/routes index f1c0adf0e..578be197f 100644 --- a/routes +++ b/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 diff --git a/src/Foundation/Navigation.hs b/src/Foundation/Navigation.hs index f4a95c6c3..78b787084 100644 --- a/src/Foundation/Navigation.hs +++ b/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 PrintSendR = i18nCrumb MsgMenuPrintSend $ Just PrintCenterR -breadcrumb (PrintDownloadR _) = i18nCrumb MsgMenuPrintDownload $ Just PrintCenterR +breadcrumb PrintCenterR = i18nCrumb MsgMenuApc Nothing +breadcrumb PrintSendR = i18nCrumb MsgMenuPrintSend $ 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 - [ NavPageActionPrimary - { navLink = NavLink - { navLabel = MsgMenuPrintSend - , navRoute = PrintSendR - , navAccess' = NavAccessTrue - , navType = NavTypeLink { navModal = False } - , navQuick' = mempty - , navForceActive = False - } - , navChildren = [] - } - ] +pageActions PrintCenterR = do + openDays <- useRunDB $ Ex.select $ do + pj <- Ex.from $ Ex.table @PrintJob + let pjDay = E.day $ pj Ex.^. PrintJobCreated + Ex.where_ $ Ex.isNothing (pj Ex.^. PrintJobAcknowledged) + Ex.groupBy pjDay + Ex.orderBy [ Ex.asc pjDay ] + pure (pjDay, Ex.countRows) + let toDayAck (Ex.unValue -> d, Ex.unValue -> n::Int) = do + dtxt <- formatTime SelFormatDate d + 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 diff --git a/src/Handler/PrintCenter.hs b/src/Handler/PrintCenter.hs index 784ce47a1..c72124c58 100644 --- a/src/Handler/PrintCenter.hs +++ b/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 - let setPJIds = Set.toList pjIds + (PJActAcknowledgeData, Set.toList -> pjIds) -> do 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 --} \ No newline at end of file +-} + + +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 + diff --git a/src/Handler/Utils/Form.hs b/src/Handler/Utils/Form.hs index 2c00f2317..72c2fab42 100644 --- a/src/Handler/Utils/Form.hs +++ b/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) diff --git a/src/Utils/Form.hs b/src/Utils/Form.hs index 13e9e703f..2c0c3e9c3 100644 --- a/src/Utils/Form.hs +++ b/src/Utils/Form.hs @@ -278,6 +278,7 @@ data FormIdentifier | FIDDBTableCsvImport Text | FIDDBTableCsvImportConfirm Text | FIDDelete + | FIDPrintAcknowledge | FIDCourseRegister | FIDuserRights | FIDUserSystemFunctions