chore(admin): show active card colors on problem resolution page
This commit is contained in:
parent
c62a42d5c2
commit
48e86fa578
@ -29,4 +29,9 @@ RevokeUnknownLicencesFail: Nicht alle AVS Fahrberechtigungen unbekannter Fahrer
|
||||
AvsCommunicationError: AVS Schnittstelle lieferte einen unerwarteten Fehler.
|
||||
LicenceTableChangeAvs: Im AVS ändern
|
||||
LicenceTableGrantFDrive: In FRADrive erteilen
|
||||
LicenceTableRevokeFDrive: In FRADrive entziehen
|
||||
LicenceTableRevokeFDrive: In FRADrive entziehen
|
||||
TableAvsActiveCards: Gültige Ausweise
|
||||
AvsCardColorGreen: Grün
|
||||
AvsCardColorBlue: Blau
|
||||
AvsCardColorRed: Rot
|
||||
AvsCardColorYellow: Gelb
|
||||
@ -30,3 +30,8 @@ AvsCommunicationError: AVS interface returned an unexpected error.
|
||||
LicenceTableChangeAvs: Change in AVS
|
||||
LicenceTableGrantFDrive: Grant in FRADrive
|
||||
LicenceTableRevokeFDrive: Revoke in FRADrive
|
||||
TableAvsActiveCards: Valid Cards
|
||||
AvsCardColorGreen: Green
|
||||
AvsCardColorBlue: Blue
|
||||
AvsCardColorRed: Red
|
||||
AvsCardColorYellow: Yellow
|
||||
@ -251,6 +251,13 @@ embedRenderMessage ''UniWorX ''AvsLicence id -- required by UniWorXAvsMessages
|
||||
mkMessageAddition ''UniWorX "Qualification" "messages/uniworx/categories/qualification" "de-de-formal"
|
||||
mkMessageAddition ''UniWorX "Avs" "messages/uniworx/categories/avs" "de-de-formal"
|
||||
|
||||
instance RenderMessage UniWorX AvsDataCardColor where
|
||||
renderMessage _foundation _ls (AvsCardColorMisc t) = Text.cons '*' t
|
||||
renderMessage f ls AvsCardColorGrün = renderMessage f ls MsgAvsCardColorGreen
|
||||
renderMessage f ls AvsCardColorBlau = renderMessage f ls MsgAvsCardColorBlue
|
||||
renderMessage f ls AvsCardColorRot = renderMessage f ls MsgAvsCardColorRed
|
||||
renderMessage f ls AvsCardColorGelb = renderMessage f ls MsgAvsCardColorYellow
|
||||
|
||||
instance RenderMessage UniWorX TermIdentifier where
|
||||
renderMessage _foundation _ls = termToText -- TODO: respect user selected Datetime Format
|
||||
|
||||
|
||||
@ -51,11 +51,12 @@ getAdminProblemsR = do
|
||||
diffLics <- try retrieveDifferingLicences <&> \case
|
||||
-- (Left (UnsupportedContentType "text/html" resp)) -> Left $ text2widget "Html received"
|
||||
(Left e) -> Left $ text2widget $ tshow (e :: SomeException)
|
||||
(Right AvsLicenceDifferences{..}) -> Right ( Set.size avsLicenceDiffRevokeAll
|
||||
, Set.size avsLicenceDiffGrantVorfeld
|
||||
, Set.size avsLicenceDiffRevokeRollfeld
|
||||
, Set.size avsLicenceDiffGrantRollfeld
|
||||
)
|
||||
(Right AvsLicenceDifferences{..}) -> Right
|
||||
( Set.size avsLicenceDiffRevokeAll
|
||||
, Set.size avsLicenceDiffGrantVorfeld
|
||||
, Set.size avsLicenceDiffRevokeRollfeld
|
||||
, Set.size avsLicenceDiffGrantRollfeld
|
||||
)
|
||||
-- Attempt to format results in a nicer way failed, since rendering Html within a modal destroyed the page layout itself
|
||||
-- let procDiffLics (to0, to1, to2) = Right (Set.size to0, Set.size to1, Set.size to2)
|
||||
-- diffLics <- (procDiffLics <$> retrieveDifferingLicences) `catches`
|
||||
|
||||
@ -365,7 +365,8 @@ postProblemAvsSynchR = getProblemAvsSynchR
|
||||
getProblemAvsSynchR = do
|
||||
let catchAllAvs' r = flip catch (\err -> addMessageModal Error (i18n MsgAvsCommunicationError) (Right (text2widget $ tshow (err :: SomeException))) >> redirect r)
|
||||
catchAllAvs = catchAllAvs' ProblemAvsSynchR -- == current route; use only in conditions that are not repeated upon reload; do not call redirect within catchAllAvs actions!
|
||||
AvsLicenceDifferences{..} <- catchAllAvs' AdminR retrieveDifferingLicences
|
||||
(AvsLicenceDifferences{..}, apidStatus) <- catchAllAvs' AdminR retrieveDifferingLicencesStatus
|
||||
-- TODO: for all ids, uery PersonStatus and create a Map from AvsId to a List of all valid Cards
|
||||
|
||||
--
|
||||
unknownLicenceOwners' <- whenNonEmpty avsLicenceDiffRevokeAll $ \neZeros ->
|
||||
@ -421,10 +422,10 @@ getProblemAvsSynchR = do
|
||||
|
||||
-- licence differences
|
||||
((tres0,tb0),(tres1up,tb1up),(tres1down,tb1down),(tres2,tb2)) <- runDB $ (,,,)
|
||||
<$> mkLicenceTable "avsLicDiffRevokeVorfeld" AvsLicenceVorfeld avsLicenceDiffRevokeAll
|
||||
<*> mkLicenceTable "avsLicDiffGrantVorfeld" AvsNoLicence avsLicenceDiffGrantVorfeld
|
||||
<*> mkLicenceTable "avsLicDiffRevokeRollfeld" AvsLicenceRollfeld avsLicenceDiffRevokeRollfeld
|
||||
<*> mkLicenceTable "avsLicDiffGrantRollfeld" AvsNoLicence avsLicenceDiffGrantRollfeld
|
||||
<$> mkLicenceTable apidStatus "avsLicDiffRevokeVorfeld" AvsLicenceVorfeld avsLicenceDiffRevokeAll
|
||||
<*> mkLicenceTable apidStatus "avsLicDiffGrantVorfeld" AvsNoLicence avsLicenceDiffGrantVorfeld
|
||||
<*> mkLicenceTable apidStatus "avsLicDiffRevokeRollfeld" AvsLicenceRollfeld avsLicenceDiffRevokeRollfeld
|
||||
<*> mkLicenceTable apidStatus "avsLicDiffGrantRollfeld" AvsNoLicence avsLicenceDiffGrantRollfeld
|
||||
|
||||
now <- liftIO getCurrentTime
|
||||
let nowaday = utctDay now
|
||||
@ -510,8 +511,8 @@ instance HasUser LicenceTableData where
|
||||
hasUser = resultUser . _entityVal
|
||||
|
||||
|
||||
mkLicenceTable :: Text -> AvsLicence -> Set AvsPersonId -> DB (FormResult (LicenceTableActionData, Set AvsPersonId), Widget)
|
||||
mkLicenceTable dbtIdent aLic apids = do
|
||||
mkLicenceTable :: AvsPersonIdMapPersonCard -> Text -> AvsLicence -> Set AvsPersonId -> DB (FormResult (LicenceTableActionData, Set AvsPersonId), Widget)
|
||||
mkLicenceTable apidStatus dbtIdent aLic apids = do
|
||||
currentRoute <- fromMaybe (error "mkLicenceTable called from 404-handler") <$> liftHandler getCurrentRoute
|
||||
avsQualifications <- selectList [QualificationAvsLicence !=. Nothing] []
|
||||
now <- liftIO getCurrentTime
|
||||
@ -553,6 +554,7 @@ mkLicenceTable dbtIdent aLic apids = do
|
||||
, sortable (Just "first-held") (i18nCell MsgTableQualificationFirstHeld) $ \(preview $ resultQualUser . _entityVal . _qualificationUserFirstHeld -> d) -> cellMaybe dayCell d
|
||||
, sortable (Just "blocked-due") (i18nCell MsgTableQualificationBlockedDue & cellTooltip MsgTableQualificationBlockedTooltip
|
||||
) $ \(preview $ resultQualUser . _entityVal . _qualificationUserBlockedDue -> b) -> cellMaybe qualificationBlockedCell b
|
||||
, sortable Nothing (i18nCell MsgTableAvsActiveCards) $ \(view $ resultUserAvs . _userAvsPersonId -> apid) -> foldMap avsPersonCardCell $ Map.lookup apid apidStatus
|
||||
]
|
||||
dbtSorting = mconcat
|
||||
[ single $ sortUserNameLink queryUser
|
||||
|
||||
@ -14,11 +14,13 @@ module Handler.Utils.Avs
|
||||
-- , getLicence, getLicenceDB, getLicenceByAvsId -- not supported by interface
|
||||
, AvsLicenceDifferences(..)
|
||||
, setLicence, setLicenceAvs, setLicencesAvs
|
||||
, retrieveDifferingLicences, computeDifferingLicences
|
||||
, retrieveDifferingLicences, retrieveDifferingLicencesStatus
|
||||
, computeDifferingLicences
|
||||
, synchAvsLicences
|
||||
, lookupAvsUser, lookupAvsUsers
|
||||
, AvsException(..)
|
||||
, updateReceivers
|
||||
, AvsPersonIdMapPersonCard
|
||||
) where
|
||||
|
||||
import Import
|
||||
@ -178,6 +180,18 @@ data AvsLicenceDifferences = AvsLicenceDifferences
|
||||
}
|
||||
deriving (Show)
|
||||
|
||||
#ifdef DEVELOPMENT
|
||||
-- avsLicenceDifferences2LicenceIds is not used in DEVELOPMENT build
|
||||
#else
|
||||
avsLicenceDifferences2LicenceIds :: AvsLicenceDifferences -> Set AvsPersonId
|
||||
avsLicenceDifferences2LicenceIds AvsLicenceDifferences{..} = Set.unions
|
||||
[ avsLicenceDiffRevokeAll
|
||||
, avsLicenceDiffGrantVorfeld
|
||||
, avsLicenceDiffRevokeRollfeld
|
||||
, avsLicenceDiffGrantRollfeld
|
||||
]
|
||||
#endif
|
||||
|
||||
avsLicenceDifferences2personLicences :: AvsLicenceDifferences -> Set AvsPersonLicence
|
||||
avsLicenceDifferences2personLicences AvsLicenceDifferences{..} =
|
||||
Set.map (AvsPersonLicence AvsNoLicence) avsLicenceDiffRevokeAll
|
||||
@ -188,24 +202,50 @@ avsLicenceDifferences2personLicences AvsLicenceDifferences{..} =
|
||||
computeDifferingLicences :: AvsResponseGetLicences -> Handler (Set AvsPersonLicence)
|
||||
computeDifferingLicences = fmap avsLicenceDifferences2personLicences . getDifferingLicences
|
||||
|
||||
retrieveDifferingLicences :: Handler AvsLicenceDifferences
|
||||
retrieveDifferingLicences = do
|
||||
#ifdef DEVELOPMENT
|
||||
avsUsrs <- runDB $ selectList [] [LimitTo 444]
|
||||
getDifferingLicences $ AvsResponseGetLicences $ Set.fromList $
|
||||
[ AvsPersonLicence AvsLicenceVorfeld $ AvsPersonId 77 -- AVS:1 FD:2
|
||||
, AvsPersonLicence AvsLicenceRollfeld $ AvsPersonId 12345678 -- AVS:2 FD:1
|
||||
, AvsPersonLicence AvsLicenceVorfeld $ AvsPersonId 5 -- AVS:1 FD:0 (nichts)
|
||||
, AvsPersonLicence AvsLicenceVorfeld $ AvsPersonId 2 -- AVS:1 FD:0 (ungültig)
|
||||
-- , AvsPersonLicence AvsLicenceVorfeld $ AvsPersonId 4 -- AVS:1 FD:1
|
||||
] ++ [AvsPersonLicence AvsLicenceVorfeld avsid | Entity _ UserAvs{userAvsPersonId = avsid} <- avsUsrs]
|
||||
#else
|
||||
AvsQuery{..} <- maybeThrowM AvsInterfaceUnavailable $ getsYesod $ view _appAvsQuery
|
||||
allLicences <- throwLeftM avsQueryGetAllLicences
|
||||
getDifferingLicences allLicences
|
||||
#endif
|
||||
|
||||
type AvsPersonIdMapPersonCard = Map AvsPersonId (Set AvsDataPersonCard)
|
||||
|
||||
avsResponseStatusMap :: AvsResponseStatus -> AvsPersonIdMapPersonCard
|
||||
avsResponseStatusMap (AvsResponseStatus status) = Map.fromDistinctAscList [(avsStatusPersonID,avsStatusPersonCardStatus) | AvsStatusPerson{..}<- Set.toAscList status]
|
||||
|
||||
retrieveDifferingLicences :: Handler AvsLicenceDifferences
|
||||
retrieveDifferingLicences = fst <$> retrieveDifferingLicences' False
|
||||
|
||||
retrieveDifferingLicencesStatus :: Handler (AvsLicenceDifferences, AvsPersonIdMapPersonCard)
|
||||
retrieveDifferingLicencesStatus = retrieveDifferingLicences' True
|
||||
|
||||
retrieveDifferingLicences' :: Bool -> Handler (AvsLicenceDifferences, AvsPersonIdMapPersonCard)
|
||||
retrieveDifferingLicences' getStatus = do
|
||||
#ifdef DEVELOPMENT
|
||||
avsUsrs <- runDB $ selectList [] [LimitTo 444]
|
||||
let allLicences = AvsResponseGetLicences $ Set.fromList $
|
||||
[ AvsPersonLicence AvsLicenceVorfeld $ AvsPersonId 77 -- AVS:1 FD:2
|
||||
, AvsPersonLicence AvsLicenceRollfeld $ AvsPersonId 12345678 -- AVS:2 FD:1
|
||||
, AvsPersonLicence AvsLicenceVorfeld $ AvsPersonId 5 -- AVS:1 FD:0 (nichts)
|
||||
, AvsPersonLicence AvsLicenceVorfeld $ AvsPersonId 2 -- AVS:1 FD:0 (ungültig)
|
||||
-- , AvsPersonLicence AvsLicenceVorfeld $ AvsPersonId 4 -- AVS:1 FD:1
|
||||
] ++ [AvsPersonLicence AvsLicenceVorfeld avsid | Entity _ UserAvs{userAvsPersonId = avsid} <- avsUsrs]
|
||||
#else
|
||||
AvsQuery{..} <- maybeThrowM AvsInterfaceUnavailable $ getsYesod $ view _appAvsQuery
|
||||
allLicences <- throwLeftM avsQueryGetAllLicences
|
||||
#endif
|
||||
lDiff <- getDifferingLicences allLicences
|
||||
#ifdef DEVELOPMENT
|
||||
let mkAdpc valid color = AvsDataPersonCard valid Nothing Nothing color (Set.singleton 'F') Nothing Nothing Nothing Nothing (AvsCardNo "1234") "5"
|
||||
lStat = AvsResponseStatus $ bool mempty fakes getStatus -- not really needed, but avoids unused variable error
|
||||
fakes = Set.fromList $
|
||||
[ AvsStatusPerson (AvsPersonId 77 ) $ Set.singleton $ mkAdpc True AvsCardColorGelb
|
||||
, AvsStatusPerson (AvsPersonId 12345678) $ Set.fromList [mkAdpc False AvsCardColorGrün, mkAdpc True AvsCardColorGelb, mkAdpc False AvsCardColorBlau, mkAdpc True AvsCardColorRot, mkAdpc True $ AvsCardColorMisc "Violett"]
|
||||
, AvsStatusPerson (AvsPersonId 5 ) $ Set.fromList [mkAdpc True AvsCardColorGrün, mkAdpc False AvsCardColorGelb, mkAdpc True AvsCardColorBlau, mkAdpc False AvsCardColorRot, mkAdpc True $ AvsCardColorMisc "Pink"]
|
||||
, AvsStatusPerson (AvsPersonId 2 ) $ Set.singleton $ mkAdpc True AvsCardColorGrün
|
||||
] <>
|
||||
[ AvsStatusPerson avsid $ Set.singleton $ mkAdpc (even $ avsPersonId avsid) AvsCardColorGelb | Entity _ UserAvs{userAvsPersonId = avsid} <- avsUsrs ]
|
||||
#else
|
||||
let statQry = AvsQueryStatus $ avsLicenceDifferences2LicenceIds lDiff
|
||||
lStat <- if getStatus then throwLeftM $ avsQueryStatus statQry else return $ AvsResponseStatus mempty -- avoid unnecessary avs calls
|
||||
#endif
|
||||
return (lDiff, avsResponseStatusMap lStat)
|
||||
|
||||
|
||||
getDifferingLicences :: AvsResponseGetLicences -> Handler AvsLicenceDifferences
|
||||
getDifferingLicences (AvsResponseGetLicences licences) = do
|
||||
now <- liftIO getCurrentTime
|
||||
|
||||
@ -7,6 +7,7 @@ module Handler.Utils.Table.Cells where
|
||||
import Import hiding (link)
|
||||
|
||||
import Text.Blaze (ToMarkup(..))
|
||||
import qualified Data.Set as Set
|
||||
|
||||
import Handler.Utils.Table.Pagination
|
||||
import Handler.Utils.DateTime
|
||||
@ -381,3 +382,16 @@ qualificationBlockedCell (Just QualificationBlocked{..})
|
||||
|
||||
avsPersonNoCell :: (IsDBTable m c, HasUserAvs a) => a -> DBCell m c
|
||||
avsPersonNoCell = numCell . view _userAvsNoPerson
|
||||
|
||||
avsPersonCardCell :: (IsDBTable m c) => Set AvsDataPersonCard -> DBCell m c
|
||||
avsPersonCardCell cards = wgtCell
|
||||
[whamlet|
|
||||
$newline never
|
||||
<ul .list--iconless .list--inline .list--comma-separated>
|
||||
$forall c <- validColors
|
||||
<li>
|
||||
_{c}
|
||||
|]
|
||||
where
|
||||
validCards = Set.filter avsDataValid cards
|
||||
validColors = Set.toDescList $ Set.map avsDataCardColor validCards
|
||||
@ -281,12 +281,13 @@ licence2char AvsLicenceRollfeld = 'R'
|
||||
data AvsDataCardColor = AvsCardColorMisc Text | AvsCardColorGrün | AvsCardColorBlau | AvsCardColorRot | AvsCardColorGelb
|
||||
deriving (Eq, Ord, Read, Show, Generic)
|
||||
deriving anyclass (NFData)
|
||||
-- instance RenderMessage declared in Foundation.I18n
|
||||
|
||||
instance ToJSON AvsDataCardColor where
|
||||
toJSON AvsCardColorGrün = "Grün"
|
||||
toJSON AvsCardColorBlau = "Blau"
|
||||
toJSON AvsCardColorRot = "Rot"
|
||||
toJSON AvsCardColorGelb = "Gelb"
|
||||
toJSON AvsCardColorGrün = "Grün"
|
||||
toJSON AvsCardColorBlau = "Blau"
|
||||
toJSON AvsCardColorRot = "Rot"
|
||||
toJSON AvsCardColorGelb = "Gelb"
|
||||
toJSON (AvsCardColorMisc t) = String t
|
||||
|
||||
instance FromJSON AvsDataCardColor where
|
||||
|
||||
Loading…
Reference in New Issue
Block a user