From df1a816d839b119de5aebe2912aad061e8a5c72c Mon Sep 17 00:00:00 2001
From: Steffen Jost <jost@tcs.ifi.lmu.de>
Date: Wed, 14 Dec 2022 16:05:03 +0100
Subject: [PATCH] chore(avs): minor improve avs debugging printout

---
 src/Handler/Admin/Avs.hs | 87 ++++++++++++++++++++++------------------
 templates/avs.hamlet     |  4 +-
 2 files changed, 49 insertions(+), 42 deletions(-)

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|<h2>Error:</h2> #{msg}|]
+              Right (AvsResponsePerson pns) -> return $ Just [whamlet|
+                  <ul>
+                    $forall p <- pns 
+                      <li>#{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|<h2>Error:</h2> #{msg}|]
+              Right (AvsResponseStatus pns) -> return $ Just [whamlet|
+                  <ul>
+                    $forall p <- pns 
+                      <li>#{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|
-                    <h2>Success:</h2> 
+                    <h2>Success:</h2>
                     <ul>
                       $forall AvsPersonLicence{..} <- flics
                         <li> #{tshow avsLicencePersonID}: #{licence2char avsLicenceRampLicence}
                   |]
-              
+
               (Left err) -> do
                 let msg = tshow err
                 return $ Just [whamlet|<h2>Error:</h2> #{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
                   <h3>Set to F:
                   <p>
                     #{f_set}
-                  <h3>Revoke licence:                      
+                  <h3>Revoke licence:
                   <p>
                     #{revoke}
                 |]
@@ -228,7 +236,7 @@ postAdminAvsR = do
               return $ Just [whamlet|<h2>Error:</h2> Licences could not be synchronized, see error log.|]
             (Left e) -> do
               let msg = tshow (e :: SomeException)
-              return $ Just [whamlet|<h2>Licence synchronisation error:</h2> #{msg}|]    
+              return $ Just [whamlet|<h2>Licence synchronisation error:</h2> #{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
     <p>
       Unverarbeitete Antwort: #
-      #{answer}
+      ^{answer}
 
 <section>
   <p> 
@@ -52,4 +52,4 @@ $# SPDX-License-Identifier: AGPL-3.0-or-later
   $maybe answer <- mbStatus
     <p>
       Unverarbeitete Antwort: #
-      #{answer}
\ No newline at end of file
+      ^{answer}
\ No newline at end of file