diff --git a/src/Handler/Admin/Avs.hs b/src/Handler/Admin/Avs.hs
index bf537f77c..6e6c51985 100644
--- a/src/Handler/Admin/Avs.hs
+++ b/src/Handler/Admin/Avs.hs
@@ -6,7 +6,7 @@
module Handler.Admin.Avs
( getAdminAvsR, postAdminAvsR
- , getProblemAvsSynchR, postProblemAvsSynchR
+ , getProblemAvsSynchR, postProblemAvsSynchR
) where
import Import
@@ -23,7 +23,7 @@ import Utils.Avs
import Database.Esqueleto.Experimental ((:&)(..))
import qualified Database.Esqueleto.Legacy as E
-import qualified Database.Esqueleto.Experimental as E hiding (from, on)
+import qualified Database.Esqueleto.Experimental as E hiding (from, on)
import qualified Database.Esqueleto.Experimental as X (from, on) -- needs TypeApplications Lang-Pragma
import qualified Database.Esqueleto.Utils as E
@@ -39,7 +39,7 @@ nullaryPathPiece ''ButtonAvsTest camelToPathPiece
instance Button UniWorX ButtonAvsTest where
btnLabel BtnCheckLicences = "Check all licences" -- could be msg
btnLabel BtnSynchLicences = "Synchronize all licences" -- could be msg
- btnClasses BtnCheckLicences = [BCIsButton, BCPrimary]
+ btnClasses BtnCheckLicences = [BCIsButton, BCPrimary]
btnClasses BtnSynchLicences = [BCIsButton, BCDanger]
-- END Button
@@ -57,9 +57,9 @@ makeAvsPersonForm tmpl = identifyForm FIDAvsQueryPerson . validateForm validateA
<*> aopt textField (fslI MsgAvsVersionNo) (avsPersonQueryVersionNo <$> tmpl)
<*> aopt textField (fslI MsgAvsFirstName) (avsPersonQueryFirstName <$> tmpl)
<*> aopt textField (fslI MsgAvsLastName) (avsPersonQueryLastName <$> tmpl)
- <*> aopt avsInternalPersonalNoField
+ <*> aopt avsInternalPersonalNoField
(fslI MsgAvsInternalPersonalNo) (avsPersonQueryInternalPersonalNo <$> tmpl)
-
+
validateAvsQueryPerson :: FormValidator AvsQueryPerson Handler ()
validateAvsQueryPerson = do
@@ -113,8 +113,12 @@ postAdminAvsR = do
addMessage Info $ text2Html $ "Query: " <> tshow (toJSON fr)
res <- avsQueryPerson fr
case res of
- Left err -> return . Just $ tshow err
- Right jsn -> return . Just $ Text.replace "},Avs" "},\n Avs" $ tshow jsn
+ Left err -> let msg = tshow err in return $ Just [whamlet|
Error:
#{msg}|]
+ Right (AvsResponsePerson pns) -> return $ Just [whamlet|
+
+ $forall p <- pns
+ - #{tshow p}
+ |]
mbPerson <- formResultMaybe presult procFormPerson
((sresult, swidget), senctype) <- runFormPost $ makeAvsStatusForm Nothing
@@ -122,8 +126,12 @@ postAdminAvsR = do
addMessage Info $ text2Html $ "Query: " <> tshow (toJSON fr)
res <- avsQueryStatus fr
case res of
- Left err -> return . Just $ tshow err
- Right jsn -> return . Just $ Text.replace "},Avs" "},\n Avs" $ tshow jsn
+ Left err -> let msg = tshow err in return $ Just [whamlet|
Error:
#{msg}|]
+ Right (AvsResponseStatus pns) -> return $ Just [whamlet|
+
+ $forall p <- pns
+ - #{tshow p}
+ |]
mbStatus <- formResultMaybe sresult procFormStatus
((crUsrRes, crUsrWgt), crUsrEnctype) <- runFormPost $ identifyForm FIDAvsCreateUser $ \html ->
@@ -144,17 +152,17 @@ postAdminAvsR = do
((getLicRes, getLicWgt), getLicEnctype) <- runFormPost $ identifyForm FIDAvsQueryLicence $ \html ->
flip (renderAForm FormStandard) html $ (,,) <$> aopt intField (fslI $ text2message "Min AvsPersonId") Nothing
- <*> aopt intField (fslI $ text2message "Max AvsPersonId") Nothing
+ <*> aopt intField (fslI $ text2message "Max AvsPersonId") Nothing
<*> aopt (selectField $ return avsLicenceOptions) (fslI MsgAvsLicence) Nothing
let procFormGetLic fr = do
res <- avsQueryGetAllLicences
case res of
- (Right (AvsResponseGetLicences lics)) -> do
+ (Right (AvsResponseGetLicences lics)) -> do
let flics = Set.toList $ Set.filter lfltr lics
lfltr = case fr of -- not pretty, but it'll do
(Just idmin, Just idmax, Just lic) -> \AvsPersonLicence{..} -> (avsLicenceRampLicence == lic) && (avsLicencePersonID `inBetween` (AvsPersonId idmin, AvsPersonId idmax))
- (Just idmin, Nothing, Just lic) -> \AvsPersonLicence{..} -> (avsLicenceRampLicence == lic) && (avsLicencePersonID == AvsPersonId idmin)
- (Nothing , Just idmax, Just lic) -> \AvsPersonLicence{..} -> (avsLicenceRampLicence == lic) && (avsLicencePersonID == AvsPersonId idmax)
+ (Just idmin, Nothing, Just lic) -> \AvsPersonLicence{..} -> (avsLicenceRampLicence == lic) && (avsLicencePersonID == AvsPersonId idmin)
+ (Nothing , Just idmax, Just lic) -> \AvsPersonLicence{..} -> (avsLicenceRampLicence == lic) && (avsLicencePersonID == AvsPersonId idmax)
(Nothing , Nothing, Just lic) -> \AvsPersonLicence{..} -> avsLicenceRampLicence == lic
(Just idmin, Just idmax, Nothing ) -> (`inBetween` (AvsPersonId idmin, AvsPersonId idmax)) . avsLicencePersonID
(Just idmin, Nothing, Nothing ) -> (== AvsPersonId idmin) . avsLicencePersonID
@@ -162,12 +170,12 @@ postAdminAvsR = do
(Nothing , Nothing, Nothing ) -> const True
addMessage Info $ text2Html $ "Query returned " <> tshow (length flics) <> " licences."
return $ Just [whamlet|
-
Success:
+ Success:
$forall AvsPersonLicence{..} <- flics
- #{tshow avsLicencePersonID}: #{licence2char avsLicenceRampLicence}
|]
-
+
(Left err) -> do
let msg = tshow err
return $ Just [whamlet|
Error:
#{msg}|]
@@ -192,14 +200,14 @@ postAdminAvsR = do
(qryLicForm, qryLicRes) <- runButtonForm FIDAvsQueryLicenceDiffs
- mbQryLic <- case qryLicRes of
+ mbQryLic <- case qryLicRes of
Nothing -> return Nothing
- (Just BtnCheckLicences) -> do
- res <- try $ do
+ (Just BtnCheckLicences) -> do
+ res <- try $ do
allLicences <- throwLeftM avsQueryGetAllLicences
computeDifferingLicences allLicences
- case res of
- (Right diffs) -> do
+ case res of
+ (Right diffs) -> do
let showLics l = Text.intercalate ", " $ fmap (tshow . avsLicencePersonID) $ Set.toList $ Set.filter ((l ==) . avsLicenceRampLicence) diffs
r_grant = showLics AvsLicenceRollfeld
f_set = showLics AvsLicenceVorfeld
@@ -212,7 +220,7 @@ postAdminAvsR = do
Set to F:
#{f_set}
-
Revoke licence:
+ Revoke licence:
#{revoke}
|]
@@ -228,7 +236,7 @@ postAdminAvsR = do
return $ Just [whamlet|
Error:
Licences could not be synchronized, see error log.|]
(Left e) -> do
let msg = tshow (e :: SomeException)
- return $ Just [whamlet|Licence synchronisation error:
#{msg}|]
+ return $ Just [whamlet|Licence synchronisation error:
#{msg}|]
actionUrl <- fromMaybe AdminAvsR <$> getCurrentRoute
siteLayoutMsg MsgMenuAvs $ do
@@ -238,7 +246,7 @@ postAdminAvsR = do
statusForm = wrapFormHere swidget senctype
crUsrForm = wrapFormHere crUsrWgt crUsrEnctype
getLicForm = wrapFormHere getLicWgt getLicEnctype
- setLicForm = wrapFormHere setLicWgt setLicEnctype
+ setLicForm = wrapFormHere setLicWgt setLicEnctype
-- TODO: use i18nWidgetFile instead if this is to become permanent
$(widgetFile "avs")
@@ -255,7 +263,7 @@ type SynchDBRow = (E.Value AvsPersonId, E.Value AvsLicence, Entity Qualification
-}
-data ButtonAvsSynch = BtnImportUnknownAvsIds | BtnRevokeAvsLicences
+data ButtonAvsSynch = BtnImportUnknownAvsIds | BtnRevokeAvsLicences
deriving (Enum, Eq, Ord, Bounded, Read, Show, Generic, Typeable)
instance Universe ButtonAvsSynch
instance Finite ButtonAvsSynch
@@ -263,27 +271,27 @@ instance Finite ButtonAvsSynch
nullaryPathPiece ''ButtonAvsSynch camelToPathPiece
embedRenderMessage ''UniWorX ''ButtonAvsSynch id
-instance Button UniWorX ButtonAvsSynch where
- btnClasses BtnImportUnknownAvsIds = [BCIsButton, BCPrimary]
+instance Button UniWorX ButtonAvsSynch where
+ btnClasses BtnImportUnknownAvsIds = [BCIsButton, BCPrimary]
btnClasses BtnRevokeAvsLicences = [BCIsButton, BCDanger]
postProblemAvsSynchR, getProblemAvsSynchR :: Handler Html
-postProblemAvsSynchR = getProblemAvsSynchR
-getProblemAvsSynchR = do
+postProblemAvsSynchR = getProblemAvsSynchR
+getProblemAvsSynchR = do
-- TODO: just for Testing
-- now <- liftIO getCurrentTime
-- let TimeOfDay hours minutes _seconds = timeToTimeOfDay (utctDayTime now)
-- setTo0 = Set.fromList [AvsPersonId hours, AvsPersonId minutes]
-
- (setTo0, _setTo1, _setTo2) <- try retrieveDifferingLicences >>= \case
+
+ (setTo0, _setTo1, _setTo2) <- try retrieveDifferingLicences >>= \case
Right res -> return res
Left err -> do addMessageModal Error (i18n MsgAvsCommunicationError) (Right (text2widget $ tshow (err :: SomeException)))
redirect AdminR
unknownLicenceOwners' <- whenNonEmpty setTo0 $ \neZeros ->
runDB $ E.select $ do
- (toZero :& usrAvs) <- X.from $
+ (toZero :& usrAvs) <- X.from $
E.toValues neZeros `E.leftJoin` E.table @UserAvs
`X.on` (\(toZero :& usrAvs) -> usrAvs E.?. UserAvsPersonId E.==. E.just toZero)
E.where_ $ E.isNothing (usrAvs E.?. UserAvsPersonId)
@@ -291,19 +299,19 @@ getProblemAvsSynchR = do
let unknownLicenceOwners = E.unValue <$> unknownLicenceOwners'
numUnknownLicenceOwners = length unknownLicenceOwners
(btnUnknownWgt, btnUnknownRes) <- runButtonFormHash unknownLicenceOwners FIDAbsUnknownLicences
- case btnUnknownRes of
+ case btnUnknownRes of
Nothing -> return ()
- (Just BtnImportUnknownAvsIds) -> do
- let procAid = fmap (Sum . maybe 0 (const 1)) <$> upsertAvsUserById
+ (Just BtnImportUnknownAvsIds) -> do
+ let procAid = fmap (Sum . maybe 0 (const 1)) <$> upsertAvsUserById
res <- try (getSum <$> foldMapM procAid unknownLicenceOwners)
- case res of
+ case res of
Right oks -> do
let ms = if oks == numUnknownLicenceOwners then Info else Warning
addMessageI ms $ MsgAvsImportIDs oks numUnknownLicenceOwners
redirect ProblemAvsSynchR
Left err -> addMessageModal Error (i18n MsgAvsCommunicationError) (Right (text2widget $ tshow (err :: SomeException)))
- (Just BtnRevokeAvsLicences) ->
- try (setLicencesAvs $ Set.map (AvsPersonLicence AvsNoLicence) $ Set.fromList unknownLicenceOwners)
+ (Just BtnRevokeAvsLicences) ->
+ try (setLicencesAvs $ Set.map (AvsPersonLicence AvsNoLicence) $ Set.fromList unknownLicenceOwners)
>>= \case
Right True -> addMessageI Info MsgRevokeUnknownLicencesOk
Right False -> addMessageI Error MsgRevokeUnknownLicencesFail
@@ -316,11 +324,10 @@ getProblemAvsSynchR = do
{- dbtSQLQuery = \(usrAvs `E.LeftOuterJoin` (qaul `E.InnerJoin` qualUser `E.InnerJoin` user)) -> do
E.on $ user E.^. UserId E.==. qualUser E.^. QualificationUserUser
E.on $ qual E.^. QualificationId E.==. qualUser E.^. QualificationUserQualification
- E.on $ user E.^. UserId E.==. usrAvs E.^ UserAvsUser
+ E.on $ user E.^. UserId E.==. usrAvs E.^ UserAvsUser
E.where_ $ E.isJust (qual E.^. QualificationAvsLicence)
-}
siteLayoutMsg MsgAvsTitleLicenceSynch $ do
- setTitleI MsgAvsTitleLicenceSynch
+ setTitleI MsgAvsTitleLicenceSynch
$(i18nWidgetFile "avs-synchronisation")
-
\ No newline at end of file
diff --git a/templates/avs.hamlet b/templates/avs.hamlet
index cd6cfa8e5..a755e172f 100644
--- a/templates/avs.hamlet
+++ b/templates/avs.hamlet
@@ -43,7 +43,7 @@ $# SPDX-License-Identifier: AGPL-3.0-or-later
$maybe answer <- mbPerson
Unverarbeitete Antwort: #
- #{answer}
+ ^{answer}
@@ -52,4 +52,4 @@ $# SPDX-License-Identifier: AGPL-3.0-or-later
$maybe answer <- mbStatus
Unverarbeitete Antwort: #
- #{answer}
\ No newline at end of file
+ ^{answer}
\ No newline at end of file