From a398580b3f95c0ef67671cfbf5f50f28f7a844ae Mon Sep 17 00:00:00 2001 From: Sarah Vaupel Date: Thu, 14 Jul 2022 18:03:48 +0200 Subject: [PATCH 1/4] chore(print-center): work on dbtable contd --- src/Handler/PrintCenter.hs | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/src/Handler/PrintCenter.hs b/src/Handler/PrintCenter.hs index abf6f785b..606e8bfad 100644 --- a/src/Handler/PrintCenter.hs +++ b/src/Handler/PrintCenter.hs @@ -172,7 +172,7 @@ pjTableQuery (printJob `E.LeftOuterJoin` recipient E.on $ printJob E.^. PrintJobQualification E.==. quali E.?. QualificationId return (printJob, recipient, sender, course, quali) -mkPJTable :: DB (FormResult (PJTableAction, Set PrintJobId), Widget) +mkPJTable :: DB (FormResult (PJTableActionData, Set PrintJobId), Widget) mkPJTable = do now <- liftIO getCurrentTime currentRoute <- fromMaybe (error "mkPJTable called from 404-handler") <$> liftHandler getCurrentRoute -- albeit we do know the route here @@ -233,8 +233,8 @@ mkPJTable = do , dbParamsFormResult = id , dbParamsFormIdent = def } - postprocess :: FormResult (First PJTableAction, DBFormResult PrintJobId Bool PJTableData) - -> FormResult ( PJTableAction, Set PrintJobId) + postprocess :: FormResult (First PJTableActionData, DBFormResult PrintJobId Bool PJTableData) + -> FormResult ( PJTableActionData, Set PrintJobId) postprocess inp = do (First (Just act), jobMap) <- inp let jobSet = Map.keysSet . Map.filter id $ getDBFormResult (const False) jobMap From 79253ff48cd4740fe5f2dc2743c5fa0e9f489baa Mon Sep 17 00:00:00 2001 From: Sarah Vaupel Date: Thu, 14 Jul 2022 18:10:20 +0200 Subject: [PATCH 2/4] chore(print-center): work on dbtable contd --- src/Handler/PrintCenter.hs | 7 +++---- 1 file changed, 3 insertions(+), 4 deletions(-) diff --git a/src/Handler/PrintCenter.hs b/src/Handler/PrintCenter.hs index 606e8bfad..9d7cf0cd1 100644 --- a/src/Handler/PrintCenter.hs +++ b/src/Handler/PrintCenter.hs @@ -174,7 +174,6 @@ pjTableQuery (printJob `E.LeftOuterJoin` recipient mkPJTable :: DB (FormResult (PJTableActionData, Set PrintJobId), Widget) mkPJTable = do - now <- liftIO getCurrentTime currentRoute <- fromMaybe (error "mkPJTable called from 404-handler") <$> liftHandler getCurrentRoute -- albeit we do know the route here let dbtSQLQuery = pjTableQuery @@ -183,11 +182,11 @@ mkPJTable = do dbtColonnade = mconcat [ dbSelectIf (applying _2) id (return . view (resultPrintJob . _entityKey)) (\r -> isNothing $ r ^? resultPrintJob . _entityVal . _printJobAcknowledged) , sortable (Just "pj-name") (i18nCell MsgPrintJobName) $ \( view $ resultPrintJob . _entityVal . _printJobName -> n) -> textCell n - , sortable (Just "pj-id") (i18nCell MsgPrintJobId) $ \( view $ resultPrintJob . _entityKey -> k) -> numCell k + , sortable (Just "pj-id") (i18nCell MsgPrintJobId) $ \( view $ resultPrintJob . _entityKey -> k) -> textCell (tshow k) , sortable (Just "pj-created") (i18nCell MsgPrintJobCreated) $ \( view $ resultPrintJob . _entityVal . _printJobCreated -> t) -> dateTimeCell t , sortable (Just "pj-acknowledged") (i18nCell MsgPrintJobAcknowledged) $ \( view $ resultPrintJob . _entityVal . _printJobAcknowledged -> t) -> maybeDateTimeCell t - , sortable (Just "pj-recipient") (i18nCell MsgPrintRecipient) $ \(preview $ resultRecipient . _entityVal -> u) -> maybeCell u $ cellHasUserLink AdminUserR - , sortable (Just "pj-sender") (i18nCell MsgPrintSender) $ \(preview $ resultSender . _entityVal -> u) -> maybeCell u $ cellHasUserLink AdminUserR + , sortable (Just "pj-recipient") (i18nCell MsgPrintRecipient) $ \(preview $ resultRecipient -> u) -> maybeCell u $ cellHasUserLink AdminUserR + , sortable (Just "pj-sender") (i18nCell MsgPrintSender) $ \(preview $ resultSender -> u) -> maybeCell u $ cellHasUserLink AdminUserR , sortable (Just "pj-course") (i18nCell MsgPrintCourse) $ \(preview $ resultCourse . _entityVal -> c) -> maybeCell c courseCell , sortable (Just "pj-qualification")(i18nCell MsgPrintQualification) $ \(preview $ resultQualification . _entityVal -> q) -> maybeCell q qualificationCell ] From b0be3ec6a68132d32ed717d8cfb3d8d7417c17d3 Mon Sep 17 00:00:00 2001 From: Sarah Vaupel Date: Thu, 14 Jul 2022 18:17:36 +0200 Subject: [PATCH 3/4] chore(tests): fix pandoc tests --- test/PandocSpec.hs | 14 +++++++------- 1 file changed, 7 insertions(+), 7 deletions(-) diff --git a/test/PandocSpec.hs b/test/PandocSpec.hs index ba43aeda5..3cc74da6e 100644 --- a/test/PandocSpec.hs +++ b/test/PandocSpec.hs @@ -7,21 +7,21 @@ import Utils.Print import qualified Data.Map.Lazy as Map import Text.Pandoc -import Text.Pandoc.Arbitrary +import Text.Pandoc.Arbitrary () spec :: Spec spec = describe "addMeta" $ do it "should overwrite existing settings" $ do - metaOverwrite <- arbitrary - pd <- arbitrary + metaOverwrite <- generate arbitrary + pd <- generate arbitrary let (Pandoc newMeta _) = addMeta metaOverwrite pd - Map.toList newMeta `shouldContain` Map.toList metaOverwrite + Map.toList (unMeta newMeta) `shouldContain` Map.toList (unMeta metaOverwrite) it "should preserve untouched settings" $ do - metaOverwrite <- arbitrary - pd <- arbitrary + metaOverwrite <- generate arbitrary + pd <- generate arbitrary let (Pandoc keptMeta _) = pd (Pandoc newMeta _) = addMeta metaOverwrite pd - Map.toList newMeta `shouldContain` Map.toList (keptMeta `Map.difference` metaOverwrite) + Map.toList (unMeta newMeta) `shouldContain` Map.toList ((unMeta keptMeta) `Map.difference` (unMeta metaOverwrite)) From 246cf4f64643f4ad514451f7efc17e37e6f302e6 Mon Sep 17 00:00:00 2001 From: Sarah Vaupel Date: Thu, 14 Jul 2022 18:18:43 +0200 Subject: [PATCH 4/4] chore: hlint --- src/Handler/PrintCenter.hs | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/Handler/PrintCenter.hs b/src/Handler/PrintCenter.hs index 9d7cf0cd1..451e54690 100644 --- a/src/Handler/PrintCenter.hs +++ b/src/Handler/PrintCenter.hs @@ -185,8 +185,8 @@ mkPJTable = do , sortable (Just "pj-id") (i18nCell MsgPrintJobId) $ \( view $ resultPrintJob . _entityKey -> k) -> textCell (tshow k) , sortable (Just "pj-created") (i18nCell MsgPrintJobCreated) $ \( view $ resultPrintJob . _entityVal . _printJobCreated -> t) -> dateTimeCell t , sortable (Just "pj-acknowledged") (i18nCell MsgPrintJobAcknowledged) $ \( view $ resultPrintJob . _entityVal . _printJobAcknowledged -> t) -> maybeDateTimeCell t - , sortable (Just "pj-recipient") (i18nCell MsgPrintRecipient) $ \(preview $ resultRecipient -> u) -> maybeCell u $ cellHasUserLink AdminUserR - , sortable (Just "pj-sender") (i18nCell MsgPrintSender) $ \(preview $ resultSender -> u) -> maybeCell u $ cellHasUserLink AdminUserR + , sortable (Just "pj-recipient") (i18nCell MsgPrintRecipient) $ \(preview resultRecipient -> u) -> maybeCell u $ cellHasUserLink AdminUserR + , sortable (Just "pj-sender") (i18nCell MsgPrintSender) $ \(preview resultSender -> u) -> maybeCell u $ cellHasUserLink AdminUserR , sortable (Just "pj-course") (i18nCell MsgPrintCourse) $ \(preview $ resultCourse . _entityVal -> c) -> maybeCell c courseCell , sortable (Just "pj-qualification")(i18nCell MsgPrintQualification) $ \(preview $ resultQualification . _entityVal -> q) -> maybeCell q qualificationCell ]