chore(log): display admin problem table with actions on admin problem view
This commit is contained in:
parent
08d2f8c2fc
commit
b51f8a454a
@ -1,4 +1,4 @@
|
||||
# SPDX-FileCopyrightText: 2022 Gregor Kleen <gregor.kleen@ifi.lmu.de>,Winnie Ros <winnie.ros@campus.lmu.de>
|
||||
# SPDX-FileCopyrightText: 2022-24 Gregor Kleen <gregor.kleen@ifi.lmu.de>,Winnie Ros <winnie.ros@campus.lmu.de>,Steffen Jost <s.jost@fraport.de>
|
||||
#
|
||||
# SPDX-License-Identifier: AGPL-3.0-or-later
|
||||
|
||||
@ -121,6 +121,15 @@ ProblemsAvsSynchHeading: Synchronisation AVS Fahrberechtigungen
|
||||
ProblemsAvsErrorHeading: Fehlermeldungen
|
||||
ProblemsInterfaceSince: Berücksichtigt werden nur Erfolge und Fehler seit
|
||||
|
||||
AdminProblemSolved: Erledigt
|
||||
AdminProblemSolver: Bearbeitet von
|
||||
AdminProblemCreated: Zeitpunkt
|
||||
AdminProblemInfo: Problembeschreibung
|
||||
AdminProblemsSolved n@Int: #{pluralDEeN n "Admin Probleme"} als erledigt markiert
|
||||
AdminProblemNewCompany: Neue Firma aus AVS automatisch erstellt; prüfen und ggf. Standardansprechpartner eintragen
|
||||
ProblemTableMarkSolved: Als erledigt markieren
|
||||
ProblemTableUnknownTodo: Unbekanntes ToDo Problem
|
||||
|
||||
InterfacesOk: Schnittstellen sind ok.
|
||||
InterfacesFail n@Int: #{pluralDEeN n "Schnittstellenproblem"}!
|
||||
InterfaceStatus !ident-ok: Status
|
||||
|
||||
@ -1,4 +1,4 @@
|
||||
# SPDX-FileCopyrightText: 2022 Sarah Vaupel <sarah.vaupel@ifi.lmu.de>,Winnie Ros <winnie.ros@campus.lmu.de>
|
||||
# SPDX-FileCopyrightText: 2022-24 Sarah Vaupel <sarah.vaupel@ifi.lmu.de>,Winnie Ros <winnie.ros@campus.lmu.de>,Steffen Jost <s.jost@fraport.de>
|
||||
#
|
||||
# SPDX-License-Identifier: AGPL-3.0-or-later
|
||||
|
||||
@ -121,6 +121,15 @@ ProblemsAvsSynchHeading: Synchronisation AVS Driving Licences
|
||||
ProblemsAvsErrorHeading: Error Log
|
||||
ProblemsInterfaceSince: Only considering successes and errors since
|
||||
|
||||
AdminProblemSolved: Done
|
||||
AdminProblemSolver: Solved by
|
||||
AdminProblemCreated: Creation time
|
||||
AdminProblemInfo: Problem
|
||||
AdminProblemsSolved n: #{pluralENsN n "admin problem"} marked as solved
|
||||
AdminProblemNewCompany: New company from AVS; verify and add default supervisors
|
||||
ProblemTableMarkSolved: Mark done
|
||||
ProblemTableUnknownTodo: Unknown todo problem
|
||||
|
||||
InterfacesOk: Interfaces are ok.
|
||||
InterfacesFail n: #{pluralENsN n "interface problem"}!
|
||||
InterfaceStatus: Status
|
||||
|
||||
@ -1,4 +1,4 @@
|
||||
-- SPDX-FileCopyrightText: 2022-23 Gregor Kleen <gregor.kleen@ifi.lmu.de>,Steffen Jost <s.jost@fraport.de>
|
||||
-- SPDX-FileCopyrightText: 2022-24 Gregor Kleen <gregor.kleen@ifi.lmu.de>,Steffen Jost <s.jost@fraport.de>
|
||||
--
|
||||
-- SPDX-License-Identifier: AGPL-3.0-or-later
|
||||
|
||||
|
||||
4
routes
4
routes
@ -1,4 +1,4 @@
|
||||
-- SPDX-FileCopyrightText: 2022 Gregor Kleen <gregor.kleen@ifi.lmu.de>,Sarah Vaupel <sarah.vaupel@ifi.lmu.de>,Steffen Jost <jost@tcs.ifi.lmu.de>,Wolfgang Witt <Wolfgang.Witt@campus.lmu.de>
|
||||
-- SPDX-FileCopyrightText: 2022-24 Gregor Kleen <gregor.kleen@ifi.lmu.de>,Sarah Vaupel <sarah.vaupel@ifi.lmu.de>,Steffen Jost <jost@tcs.ifi.lmu.de>,Wolfgang Witt <Wolfgang.Witt@campus.lmu.de>,Steffen Jost <s.jost@fraport.de>
|
||||
--
|
||||
-- SPDX-License-Identifier: AGPL-3.0-or-later
|
||||
|
||||
@ -70,7 +70,7 @@
|
||||
/admin/avs AdminAvsR GET POST
|
||||
/admin/avs/#CryptoUUIDUser AdminAvsUserR GET
|
||||
/admin/ldap AdminLdapR GET POST
|
||||
/admin/problems AdminProblemsR GET
|
||||
/admin/problems AdminProblemsR GET POST
|
||||
/admin/problems/no-contact ProblemUnreachableR GET
|
||||
/admin/problems/no-avs-id ProblemWithoutAvsId GET
|
||||
/admin/problems/r-without-f ProblemFbutNoR GET
|
||||
|
||||
@ -1,16 +1,18 @@
|
||||
-- SPDX-FileCopyrightText: 2022-23 Gregor Kleen <gregor.kleen@ifi.lmu.de>,Sarah Vaupel <vaupel.sarah@campus.lmu.de>,Steffen Jost <s.jost@fraport.de>
|
||||
-- SPDX-FileCopyrightText: 2022-24 Gregor Kleen <gregor.kleen@ifi.lmu.de>,Sarah Vaupel <vaupel.sarah@campus.lmu.de>,Steffen Jost <s.jost@fraport.de>
|
||||
--
|
||||
-- SPDX-License-Identifier: AGPL-3.0-or-later
|
||||
|
||||
module Audit.Types
|
||||
( Transaction(..)
|
||||
, AdminProblem(..)
|
||||
, decodeAdminProblem
|
||||
) where
|
||||
|
||||
import ClassyPrelude.Yesod hiding (derivePersistFieldJSON)
|
||||
import Model.Types.TH.JSON
|
||||
import Model
|
||||
|
||||
import Data.Aeson
|
||||
import Data.Aeson.TH
|
||||
import Utils.PathPiece
|
||||
|
||||
@ -264,6 +266,8 @@ data AdminProblem
|
||||
{ adminProblemCompany :: CompanyId
|
||||
}
|
||||
| AdminProblemUnknown -- placeholder to avoid hlint newtype suggestion while we have few problems yet
|
||||
{ adminProblemText :: Text
|
||||
}
|
||||
deriving (Eq, Ord, Read, Show, Generic)
|
||||
|
||||
deriveJSON defaultOptions
|
||||
@ -274,3 +278,8 @@ deriveJSON defaultOptions
|
||||
} ''AdminProblem
|
||||
|
||||
derivePersistFieldJSON ''AdminProblem
|
||||
|
||||
decodeAdminProblem :: Value -> AdminProblem
|
||||
decodeAdminProblem v = case fromJSON v of
|
||||
Error msg -> AdminProblemUnknown $ pack msg
|
||||
Success p -> p
|
||||
|
||||
@ -1,4 +1,4 @@
|
||||
-- SPDX-FileCopyrightText: 2022 Gregor Kleen <gregor.kleen@ifi.lmu.de>,Steffen Jost <jost@tcs.ifi.lmu.de>
|
||||
-- SPDX-FileCopyrightText: 2022-24 Gregor Kleen <gregor.kleen@ifi.lmu.de>,Steffen Jost <jost@tcs.ifi.lmu.de>,Steffen Jost <s.jost@fraport.de>
|
||||
--
|
||||
-- SPDX-License-Identifier: AGPL-3.0-or-later
|
||||
|
||||
@ -11,14 +11,17 @@ import Import
|
||||
import Jobs
|
||||
-- import Data.Either
|
||||
import qualified Data.Set as Set
|
||||
import qualified Data.Map as Map
|
||||
-- import qualified Data.Text.Lazy.Encoding as LBS
|
||||
|
||||
-- import qualified Control.Monad.Catch as Catch
|
||||
-- import Servant.Client (ClientError(..), ResponseF(..))
|
||||
-- import Text.Blaze.Html (preEscapedToHtml)
|
||||
|
||||
import Database.Persist.Sql (updateWhereCount)
|
||||
import Database.Esqueleto.Experimental ((:&)(..))
|
||||
import qualified Database.Esqueleto.Experimental as E
|
||||
import qualified Database.Esqueleto.Legacy as EL (on) -- needed for dbTable
|
||||
import qualified Database.Esqueleto.Utils as E
|
||||
|
||||
import Handler.Utils
|
||||
@ -33,12 +36,34 @@ import Handler.Admin.Crontab as Handler.Admin
|
||||
import Handler.Admin.Avs as Handler.Admin
|
||||
import Handler.Admin.Ldap as Handler.Admin
|
||||
|
||||
-- avoids repetition of local definitions
|
||||
single :: (k,a) -> Map k a
|
||||
single = uncurry Map.singleton
|
||||
|
||||
|
||||
-- Types and Template Haskell
|
||||
data ProblemTableAction = ProblemTableMarkSolved
|
||||
| ProblemTableUnknownTodo -- Placeholder, remove later, inculding associated Message
|
||||
deriving (Eq, Ord, Enum, Bounded, Read, Show, Generic)
|
||||
deriving anyclass (Universe, Finite)
|
||||
|
||||
nullaryPathPiece ''ProblemTableAction $ camelToPathPiece' 2
|
||||
embedRenderMessage ''UniWorX ''ProblemTableAction id
|
||||
|
||||
data ProblemTableActionData = ProblemTableMarkSolvedData
|
||||
| ProblemTableUnknownTodoData -- Placeholder, remove later
|
||||
deriving (Eq, Ord, Read, Show, Generic)
|
||||
|
||||
|
||||
-- Handlers
|
||||
getAdminR :: Handler Html
|
||||
getAdminR = redirect AdminProblemsR
|
||||
|
||||
getAdminProblemsR :: Handler Html
|
||||
getAdminProblemsR = do
|
||||
getAdminProblemsR, postAdminProblemsR :: Handler Html
|
||||
getAdminProblemsR = handleAdminProblems Nothing
|
||||
|
||||
handleAdminProblems :: Maybe Widget -> Handler Html
|
||||
handleAdminProblems mbProblemTable = do
|
||||
now <- liftIO getCurrentTime
|
||||
let nowaday = utctDay now
|
||||
cutOffOldDays = 1
|
||||
@ -55,15 +80,16 @@ getAdminProblemsR = do
|
||||
flagNonZero n | n <= 0 = flagError True
|
||||
| otherwise = messageTooltip =<< handlerToWidget (messageI Error (MsgProblemsDriverSynch n))
|
||||
|
||||
(usersAreReachable, driversHaveAvsIds, rDriversHaveFs, noStalePrintJobs, noBadAPCids, (interfaceOks, interfaceTable)) <- runDB $ (,,,,,)
|
||||
(usersAreReachable, driversHaveAvsIds, rDriversHaveFs, noStalePrintJobs, noBadAPCids, (interfaceOks, interfaceTable)) <- runDB $ (,,,,,)
|
||||
<$> areAllUsersReachable
|
||||
<*> allDriversHaveAvsId now
|
||||
<*> allRDriversHaveFs now
|
||||
<*> (not <$> exists [PrintJobAcknowledged ==. Nothing, PrintJobCreated <. cutOffOldTime])
|
||||
<*> (not <$> exists [PrintAcknowledgeProcessed ==. False])
|
||||
<*> mkInterfaceLogTable flagError mempty
|
||||
<*> mkInterfaceLogTable flagError mempty
|
||||
let interfacesBadNr = length $ filter (not . snd) interfaceOks
|
||||
-- interfacesOk = all snd interfaceOks
|
||||
|
||||
diffLics <- try retrieveDifferingLicences >>= \case
|
||||
-- (Left (UnsupportedContentType "text/html" resp)) -> Left $ text2widget "Html received"
|
||||
(Left e) -> return $ Left $ text2widget $ tshow (e :: SomeException)
|
||||
@ -86,11 +112,28 @@ getAdminProblemsR = do
|
||||
-- ]
|
||||
|
||||
rerouteMail <- getsYesod $ view _appMailRerouteTo
|
||||
problemLogTable <- maybeM (snd <$> runDB mkProblemLogTable) return $ return mbProblemTable -- formResult only processed in POST-Handler
|
||||
|
||||
siteLayoutMsg MsgProblemsHeading $ do
|
||||
setTitleI MsgProblemsHeading
|
||||
$(widgetFile "admin-problems")
|
||||
|
||||
postAdminProblemsR = do
|
||||
(problemLogRes, problemLogTable) <- runDB mkProblemLogTable
|
||||
let procProblems :: (ProblemTableActionData, Set ProblemLogId) -> Handler ()
|
||||
procProblems (ProblemTableMarkSolvedData, pids) = do
|
||||
mauid <- maybeAuthId
|
||||
now <- liftIO getCurrentTime
|
||||
(fromIntegral -> oks) <- runDB $ updateWhereCount [ProblemLogSolved ==. Nothing, ProblemLogId <-. toList pids]
|
||||
[ProblemLogSolved =. Just now, ProblemLogSolver =. mauid]
|
||||
let no_req = Set.size pids
|
||||
mkind = if oks < no_req || no_req < 0 then Warning else Success
|
||||
addMessageI mkind $ MsgAdminProblemsSolved oks
|
||||
when (oks > 0) $ redirect AdminProblemsR -- reload to update all tables
|
||||
procProblems (ProblemTableUnknownTodoData, _) = return () -- just a no-op
|
||||
formResult problemLogRes procProblems
|
||||
handleAdminProblems $ Just problemLogTable
|
||||
|
||||
|
||||
getProblemUnreachableR :: Handler Html
|
||||
getProblemUnreachableR = do
|
||||
@ -238,3 +281,84 @@ retrieveDriversRWithoutF now = do
|
||||
E.where_ $ E.exists (hasValidQual AvsLicenceRollfeld)
|
||||
E.&&. E.notExists (hasValidQual AvsLicenceVorfeld)
|
||||
return usr
|
||||
|
||||
|
||||
|
||||
type ProblemLogTableExpr = E.SqlExpr (Entity ProblemLog) `E.LeftOuterJoin` E.SqlExpr (Maybe (Entity User))
|
||||
queryProblem :: ProblemLogTableExpr -> E.SqlExpr (Entity ProblemLog)
|
||||
queryProblem = $(E.sqlLOJproj 2 1)
|
||||
|
||||
querySolver :: ProblemLogTableExpr -> E.SqlExpr (Maybe (Entity User))
|
||||
querySolver = $(E.sqlLOJproj 2 2)
|
||||
|
||||
type ProblemLogTableData = DBRow (Entity ProblemLog, Maybe (Entity User))
|
||||
resultProblem :: Lens' ProblemLogTableData (Entity ProblemLog)
|
||||
resultProblem = _dbrOutput . _1
|
||||
|
||||
resultSolver :: Traversal' ProblemLogTableData (Entity User)
|
||||
resultSolver = _dbrOutput . _2 . _Just
|
||||
|
||||
mkProblemLogTable :: DB (FormResult (ProblemTableActionData, Set ProblemLogId), Widget)
|
||||
mkProblemLogTable = over _1 postprocess <$> dbTable validator DBTable{..}
|
||||
where
|
||||
dbtIdent = "problem-log" :: Text
|
||||
dbtSQLQuery = \(problem `E.LeftOuterJoin` solver) -> do
|
||||
EL.on (problem E.^. ProblemLogSolver E.==. solver E.?. UserId)
|
||||
return (problem, solver)
|
||||
dbtRowKey = queryProblem >>> (E.^. ProblemLogId)
|
||||
dbtProj = dbtProjId
|
||||
dbtColonnade = formColonnade $ mconcat
|
||||
[ dbSelect (applying _2) id $ return . view (resultProblem . _entityKey)
|
||||
, sortable (Just "time") (i18nCell MsgAdminProblemCreated) $ \( view $ resultProblem . _entityVal . _problemLogTime -> t) -> dateTimeCell t
|
||||
, sortable (Just "info") (i18nCell MsgAdminProblemInfo) $ \( view $ resultProblem . _entityVal . _problemLogAdminProblem -> p) -> adminProblemCell p
|
||||
, sortable (Just "firm") (i18nCell MsgTableCompany) $ \(preview $ resultProblem . _entityVal . _problemLogAdminProblem . _adminProblemCompany -> c) -> cellMaybe companyIdCell c
|
||||
, sortable (Just "solved") (i18nCell MsgAdminProblemSolver) $ \( view $ resultProblem . _entityVal . _problemLogSolved -> t) -> cellMaybe dateTimeCell t
|
||||
, sortable (Just "solver") (i18nCell MsgAdminProblemSolver) $ \(preview resultSolver -> u) -> maybeCell u $ cellHasUserLink AdminUserR
|
||||
]
|
||||
dbtSorting = mconcat
|
||||
[ single ("time" , SortColumn $ queryProblem >>> (E.^. ProblemLogTime))
|
||||
, single ("info" , SortColumn $ queryProblem >>> (E.^. ProblemLogInfo))
|
||||
-- , single ("firm" , SortColumn ((E.->>. "company" ).(queryProblem >>> (E.^. ProblemLogInfo))))
|
||||
, single ("firm" , SortColumn $ \r -> queryProblem r E.^. ProblemLogInfo E.->>. "company")
|
||||
, single ("solved", SortColumn $ queryProblem >>> (E.^. ProblemLogSolved))
|
||||
, single ("solver", sortUserNameBareM querySolver)
|
||||
]
|
||||
dbtFilter = mconcat
|
||||
[ single ("solved" , FilterColumn . E.mkExactFilterLast $ views (to queryProblem) (E.isJust . (E.^. ProblemLogSolved)))
|
||||
]
|
||||
dbtFilterUI mPrev = mconcat
|
||||
[ prismAForm (singletonFilter "solved" . maybePrism _PathPiece) mPrev $ aopt (boolField . Just $ SomeMessage MsgBoolIrrelevant) (fslI MsgAdminProblemSolved)
|
||||
]
|
||||
acts :: Map ProblemTableAction (AForm Handler ProblemTableActionData)
|
||||
acts = mconcat
|
||||
[ singletonMap ProblemTableMarkSolved $ pure ProblemTableMarkSolvedData
|
||||
]
|
||||
dbtParams = DBParamsForm
|
||||
{ dbParamsFormMethod = POST
|
||||
, dbParamsFormAction = Nothing
|
||||
, dbParamsFormAttrs = []
|
||||
, dbParamsFormSubmit = FormSubmit
|
||||
, dbParamsFormAdditional
|
||||
= renderAForm FormStandard
|
||||
$ (, mempty) . First . Just
|
||||
<$> multiActionA acts (fslI MsgTableAction) (Just ProblemTableMarkSolved)
|
||||
, dbParamsFormEvaluate = liftHandler . runFormPost
|
||||
, dbParamsFormResult = id
|
||||
, dbParamsFormIdent = def
|
||||
}
|
||||
dbtCsvEncode = noCsvEncode
|
||||
dbtCsvDecode = Nothing
|
||||
dbtExtraReps = []
|
||||
dbtStyle = def { dbsFilterLayout = defaultDBSFilterLayout }
|
||||
validator = def & defaultSorting [SortAscBy "time"]
|
||||
& defaultFilter (singletonMap "solved" [toPathPiece False])
|
||||
postprocess :: FormResult (First ProblemTableActionData, DBFormResult ProblemLogId Bool ProblemLogTableData)
|
||||
-> FormResult ( ProblemTableActionData, Set ProblemLogId)
|
||||
postprocess inp = do
|
||||
(First (Just act), usrMap) <- inp
|
||||
let usrSet = Map.keysSet . Map.filter id $ getDBFormResult (const False) usrMap
|
||||
return (act, usrSet)
|
||||
|
||||
adminProblemCell :: IsDBTable m a => AdminProblem -> DBCell m a
|
||||
adminProblemCell AdminProblemNewCompany{} = i18nCell MsgAdminProblemNewCompany
|
||||
adminProblemCell AdminProblemUnknown{adminProblemText} = textCell $ "Problem: " <> adminProblemText
|
||||
|
||||
@ -1,4 +1,4 @@
|
||||
-- SPDX-FileCopyrightText: 2022 Felix Hamann <felix.hamann@campus.lmu.de>,Gregor Kleen <gregor.kleen@ifi.lmu.de>,Sarah Vaupel <vaupel.sarah@campus.lmu.de>,Steffen Jost <jost@tcs.ifi.lmu.de>,Winnie Ros <winnie.ros@campus.lmu.de>
|
||||
-- SPDX-FileCopyrightText: 2022-24 Felix Hamann <felix.hamann@campus.lmu.de>,Gregor Kleen <gregor.kleen@ifi.lmu.de>,Sarah Vaupel <vaupel.sarah@campus.lmu.de>,Steffen Jost <jost@tcs.ifi.lmu.de>,Winnie Ros <winnie.ros@campus.lmu.de>,Steffen Jost <s.jost@fraport.de>
|
||||
--
|
||||
-- SPDX-License-Identifier: AGPL-3.0-or-later
|
||||
|
||||
@ -79,6 +79,7 @@ ifCell decision cTrue cFalse x
|
||||
linkEmptyCell :: IsDBTable m a => Route UniWorX -> Widget -> DBCell m a
|
||||
linkEmptyCell = anchorCell
|
||||
|
||||
-- not to be confused with i18nCell
|
||||
msgCell :: (ToMessage t, IsDBTable m a) => t -> DBCell m a
|
||||
msgCell = textCell . toMessage
|
||||
|
||||
@ -356,14 +357,18 @@ courseCell Course{..} = anchorCell link name `mappend` desc
|
||||
|]
|
||||
|
||||
companyCell :: IsDBTable m a => CompanyShorthand -> CompanyName -> Bool -> DBCell m a
|
||||
companyCell cid cname isSupervisor = anchorCell link name
|
||||
companyCell csh cname isSupervisor = anchorCell link name
|
||||
where
|
||||
link = FirmUsersR cid
|
||||
link = FirmUsersR csh
|
||||
corg = ciOriginal cname
|
||||
name
|
||||
name
|
||||
| isSupervisor = text2markup (corg <> " ") <> icon IconSupervisor
|
||||
| otherwise = text2markup corg
|
||||
|
||||
companyIdCell :: IsDBTable m a => CompanyId -> DBCell m a
|
||||
companyIdCell cid = companyCell csh csh False
|
||||
where
|
||||
csh = unCompanyKey cid
|
||||
|
||||
qualificationCell :: (IsDBTable m c, HasQualification a) => a -> DBCell m c
|
||||
qualificationCell (view hasQualification -> Qualification{..}) = anchorCell link name
|
||||
|
||||
@ -1,4 +1,4 @@
|
||||
-- SPDX-FileCopyrightText: 2022-23 Felix Hamann <felix.hamann@campus.lmu.de>,Gregor Kleen <gregor.kleen@ifi.lmu.de>,Sarah Vaupel <sarah.vaupel@ifi.lmu.de>,Sarah Vaupel <vaupel.sarah@campus.lmu.de>,Steffen Jost <jost@cip.ifi.lmu.de>,Steffen Jost <jost@tcs.ifi.lmu.de>,Winnie Ros <winnie.ros@campus.lmu.de>,Steffen Jost <s.jost@fraport.de>
|
||||
-- SPDX-FileCopyrightText: 2022-24 Felix Hamann <felix.hamann@campus.lmu.de>,Gregor Kleen <gregor.kleen@ifi.lmu.de>,Sarah Vaupel <sarah.vaupel@ifi.lmu.de>,Sarah Vaupel <vaupel.sarah@campus.lmu.de>,Steffen Jost <jost@cip.ifi.lmu.de>,Steffen Jost <jost@tcs.ifi.lmu.de>,Winnie Ros <winnie.ros@campus.lmu.de>,Steffen Jost <s.jost@fraport.de>
|
||||
--
|
||||
-- SPDX-License-Identifier: AGPL-3.0-or-later
|
||||
|
||||
@ -1689,7 +1689,7 @@ widgetColonnade :: Colonnade h r (DBCell (HandlerFor UniWorX) x)
|
||||
-> Colonnade h r (DBCell (HandlerFor UniWorX) x)
|
||||
widgetColonnade = id
|
||||
|
||||
-- | force the column list type for tables that cotain forms, especially those constructed with dbSelect, avoids explicit type signatures
|
||||
-- | force the column list type for tables that contain forms, especially those constructed with dbSelect, avoids explicit type signatures
|
||||
formColonnade :: Colonnade h r (DBCell (RWST (Maybe (Env, FileEnv), UniWorX, [Lang]) Enctype Ints (HandlerFor UniWorX)) (FormResult a))
|
||||
-> Colonnade h r (DBCell (RWST (Maybe (Env, FileEnv), UniWorX, [Lang]) Enctype Ints (HandlerFor UniWorX)) (FormResult a))
|
||||
formColonnade = id
|
||||
|
||||
@ -1,4 +1,4 @@
|
||||
-- SPDX-FileCopyrightText: 2022 Gregor Kleen <gregor.kleen@ifi.lmu.de>,Sarah Vaupel <sarah.vaupel@ifi.lmu.de>,Sarah Vaupel <vaupel.sarah@campus.lmu.de>,Steffen Jost <jost@tcs.ifi.lmu.de>
|
||||
-- SPDX-FileCopyrightText: 2022-24 Gregor Kleen <gregor.kleen@ifi.lmu.de>,Sarah Vaupel <sarah.vaupel@ifi.lmu.de>,Sarah Vaupel <vaupel.sarah@campus.lmu.de>,Steffen Jost <jost@tcs.ifi.lmu.de>,Steffen Jost <s.jost@fraport.de>
|
||||
--
|
||||
-- SPDX-License-Identifier: AGPL-3.0-or-later
|
||||
|
||||
@ -13,7 +13,7 @@ import Model
|
||||
import Model.Rating
|
||||
import qualified ClassyPrelude.Yesod as Yesod (HasHttpManager(..))
|
||||
|
||||
import Audit.Types (AdminProblem(..))
|
||||
import Audit.Types (AdminProblem(..), decodeAdminProblem)
|
||||
|
||||
import Control.Lens as Utils.Lens
|
||||
hiding ( (<.>)
|
||||
@ -313,8 +313,11 @@ makeLenses_ ''AuthorshipStatementDefinition
|
||||
makeLenses_ ''PrintJob
|
||||
|
||||
makeLenses_ ''InterfaceLog
|
||||
makeLenses_ ''ProblemLog
|
||||
makeLenses_ ''AdminProblem
|
||||
makeLenses_ ''ProblemLog
|
||||
|
||||
_problemLogAdminProblem :: Getter ProblemLog AdminProblem
|
||||
_problemLogAdminProblem = _problemLogInfo . to decodeAdminProblem
|
||||
|
||||
--------------------------
|
||||
-- Fields for `UniWorX` --
|
||||
|
||||
@ -63,5 +63,10 @@ $# SPDX-License-Identifier: AGPL-3.0-or-later
|
||||
_{MsgInterfacesOk}
|
||||
^{interfaceTable}
|
||||
|
||||
<!-- section h2 {MsgProblemsHeadingMisc} -->
|
||||
<section>
|
||||
<h2>
|
||||
_{MsgProblemsHeadingMisc}
|
||||
<div>
|
||||
<p>
|
||||
^{problemLogTable}
|
||||
|
||||
|
||||
@ -1,4 +1,4 @@
|
||||
-- SPDX-FileCopyrightText: 2022 Gregor Kleen <gregor.kleen@ifi.lmu.de>,Sarah Vaupel <sarah.vaupel@ifi.lmu.de>,Steffen Jost <jost@cip.ifi.lmu.de>,Steffen Jost <jost@tcs.ifi.lmu.de>
|
||||
-- SPDX-FileCopyrightText: 2022-24 Gregor Kleen <gregor.kleen@ifi.lmu.de>,Sarah Vaupel <sarah.vaupel@ifi.lmu.de>,Steffen Jost <jost@cip.ifi.lmu.de>,Steffen Jost <jost@tcs.ifi.lmu.de>,Steffen Jost <s.jost@fraport.de>
|
||||
--
|
||||
-- SPDX-License-Identifier: AGPL-3.0-or-later
|
||||
|
||||
@ -785,6 +785,9 @@ fillDb = do
|
||||
void . insert $ PrintJob "TestJob9" "AckTestJob9" "job9" "No Text herein." (n_day' (-1)) Nothing (Just svaupel) Nothing Nothing Nothing (Just $ LmsIdent "abcdefg")
|
||||
void . insert $ PrintJob "TestJob0" "AckTestJob0" "job0" "No Text herein." (n_day' (-3)) Nothing Nothing Nothing Nothing Nothing (Just $ LmsIdent "hijklmn")
|
||||
|
||||
insert_ $ ProblemLog now (toJSON $ AdminProblemNewCompany fraportAg) Nothing Nothing
|
||||
insert_ $ ProblemLog now (toJSON $ AdminProblemNewCompany ffacil ) Nothing Nothing
|
||||
insert_ $ ProblemLog now (toJSON $ AdminProblemUnknown "This is a test problem only.") Nothing Nothing
|
||||
|
||||
let
|
||||
examLabels = Map.fromList
|
||||
|
||||
Loading…
Reference in New Issue
Block a user