diff --git a/src/Utils/Print.hs b/src/Utils/Print.hs index 58b0897f9..ca46799ed 100644 --- a/src/Utils/Print.hs +++ b/src/Utils/Print.hs @@ -42,7 +42,7 @@ import System.Process.Typed -- for calling pdftk for pdf encryption import Handler.Utils.Users import Handler.Utils.DateTime import Handler.Utils.Mail -import Handler.Utils.Widgets (nameHtml') +import Handler.Utils.Widgets (nameHtml') import Jobs.Handler.SendNotification.Utils -- import Model.Types.Markup -- TODO-QSV: should this module be moved accordingly? @@ -119,8 +119,8 @@ appMeta f (P.Pandoc m bs) = P.Pandoc (f m) bs applyMetas :: (P.HasMeta p, Foldable t, P.ToMetaValue a) => t (Text, Maybe a) -> p -> p applyMetas metas doc = Fold.foldr act doc metas where - act (_, Nothing) acc = acc - act (k, Just v ) acc = P.setMeta k v acc + act (k, Just v) acc | notNull k = P.setMeta k v acc + act _ acc = acc -- | Add meta to pandoc. Existing variables will be overwritten. @@ -377,7 +377,7 @@ data LetterRenewQualificationF = LetterRenewQualificationF , lmsPin :: Text , qualHolder :: UserDisplayName , qualExpiry :: Day - , qualId :: QualificationId + , qualId :: QualificationId , qualName :: Text , qualShort :: Text , qualDuration :: Maybe Int @@ -386,8 +386,8 @@ data LetterRenewQualificationF = LetterRenewQualificationF instance MDLetter LetterRenewQualificationF where getTemplate _ = templateRenewal - getMailSubject l = SomeMessage $ MsgMailSubjectQualificationRenewal $ qualShort l - getMailBody l = SomeMessage $ MsgMailBodyQualificationRenewal $ qualName l + getMailSubject l = SomeMessage $ MsgMailSubjectQualificationRenewal $ qualShort l + getMailBody l = SomeMessage $ MsgMailBodyQualificationRenewal $ qualName l letterMeta LetterRenewQualificationF{..} _lang DateTimeFormatter{ format } = mkMeta [ toMeta "login" lmsIdent , toMeta "pin" lmsPin diff --git a/test/PandocSpec.hs b/test/PandocSpec.hs index 1c6cc68a4..649d86313 100644 --- a/test/PandocSpec.hs +++ b/test/PandocSpec.hs @@ -24,13 +24,15 @@ newtype ArbitraryMeta = ArbitraryMeta { unArbitraryMeta :: Meta } newtype ArbitraryPandoc = ArbitraryPandoc { unArbitraryPandoc :: Pandoc } deriving newtype (Eq, Ord, Show, Read, Typeable) +newtype ArbitraryMapText a = ArbitraryMapText { unArbitraryMapText :: [(Text, a)] } + instance Arbitrary ArbitraryMeta where - arbitrary = do + arbitrary = do (x1 :: Inlines) <- arbitrary (x2 :: [Inlines]) <- filter (not . Fold.null) <$> arbitrary (x3 :: Inlines) <- arbitrary - (x4 :: [(Text, Text)]) <- filter (not . T.null . fst) <$> arbitrary - (x5 :: [(Text, Bool)]) <- filter (not . T.null . fst) <$> arbitrary + (x4 :: [(Text, Text)]) <- unArbitraryMapText <$> arbitrary + (x5 :: [(Text, Bool)]) <- unArbitraryMapText <$> arbitrary return $ ArbitraryMeta $ setMeta "title" x1 $ setMeta "author" x2 @@ -40,10 +42,19 @@ instance Arbitrary ArbitraryMeta where nullMeta instance Arbitrary ArbitraryPandoc where - arbitrary = do - meta <- arbitrary + arbitrary = do + meta <- arbitrary ArbitraryPandoc . Pandoc (unArbitraryMeta meta) <$> arbitrary +nonEmptyString :: Gen Text +nonEmptyString = T.pack <$> listOf1 arbitrary + +instance Arbitrary a => Arbitrary (ArbitraryMapText a) where + arbitrary = + let genKV = (,) <$> nonEmptyString <*> arbitrary + in ArbitraryMapText <$> listOf1 genKV + + -- For Lens Check _Meta required: --instance CoArbitrary Inline @@ -59,17 +70,19 @@ spec = do describe "applyMetas" $ do it "should actually set values" $ do - (metaList, apd) <- generate arbitrary - let + (metaList0, apd) <- generate arbitrary + let + metaList1 :: [(Text, Maybe MetaValue)] = second (Just . MetaString) <$> unArbitraryMapText metaList0 pd = unArbitraryPandoc apd - (Pandoc metaNew _) = applyMetas (second (Just . MetaString) <$> metaList) pd - mlKeys = Set.fromList $ fst <$> metaList - metaList' = [(k,t) | (k, MetaString t) <- mlist metaNew, Set.member k mlKeys] - metaList' `shouldMatchList` metaList + (Pandoc metaNew _) = applyMetas metaList1 pd + metaMap1 = Map.fromList metaList1 -- remove duplicate keys + keys1 = Map.keysSet metaMap1 + metaList' = [(k, Just t) | (k, t) <- mlist metaNew, k `Set.member` keys1] + metaList' `shouldMatchList` Map.toAscList metaMap1 - it "should preserve untouched settings" $ do + it "should preserve untouched settings" $ do (metaList, apd) <- generate arbitrary - let + let pd@(Pandoc metaOriginal _) = unArbitraryPandoc apd changedKeys = Set.fromList [k | (k, Just _) <- metaList] (Pandoc metaNew _) = applyMetas (second (fmap MetaString) <$> metaList) pd @@ -80,8 +93,8 @@ spec = do describe "addMeta" $ do it "should possibly overwrite existing settings" $ do (abMetaOverwrite, apd) <- generate arbitrary - let - metaOverwrite = unArbitraryMeta abMetaOverwrite + let + metaOverwrite = unArbitraryMeta abMetaOverwrite pd = unArbitraryPandoc apd (Pandoc newMeta _) = addMeta metaOverwrite pd (unMeta metaOverwrite `Map.isSubmapOf` unMeta newMeta) `shouldBe` True