chore(lpr): convenience buttons for print center
This commit is contained in:
Steffen Jost
parent
d75f741289
commit
a5173bdf22
@ -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
|
||||
|
||||
@ -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
|
||||
|
||||
@ -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
|
||||
@ -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
|
||||
1
routes
1
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
|
||||
|
||||
|
||||
@ -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
|
||||
|
||||
@ -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
|
||||
-}
|
||||
-}
|
||||
|
||||
|
||||
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
|
||||
|
||||
|
||||
@ -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)
|
||||
|
||||
@ -278,6 +278,7 @@ data FormIdentifier
|
||||
| FIDDBTableCsvImport Text
|
||||
| FIDDBTableCsvImportConfirm Text
|
||||
| FIDDelete
|
||||
| FIDPrintAcknowledge
|
||||
| FIDCourseRegister
|
||||
| FIDuserRights
|
||||
| FIDUserSystemFunctions
|
||||
|
||||
Loading…
Reference in New Issue
Block a user