test(pandoc): fix an occasionally erroneously failing test

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 | notNull k = P.setMeta k v acc
-    act (k, Just v ) acc = 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 
+  getMailSubject  l = SomeMessage $ MsgMailSubjectQualificationRenewal $ qualShort l
-  getMailBody     l = SomeMessage $ MsgMailBodyQualificationRenewal    $ qualName  l 
+  getMailBody     l = SomeMessage $ MsgMailBodyQualificationRenewal    $ qualName  l
   letterMeta LetterRenewQualificationF{..} _lang DateTimeFormatter{ format } = mkMeta
       [ toMeta "login"          lmsIdent
       , toMeta "pin"            lmsPin

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
+    (x4 :: [(Text, Text)]) <- unArbitraryMapText <$> arbitrary
-    (x5 :: [(Text, Bool)]) <- filter (not . T.null . fst) <$> 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 
+  arbitrary = do
-    meta  <- arbitrary    
+    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
+      (metaList0, apd) <- generate arbitrary
-      let        
+      let
+        metaList1 :: [(Text, Maybe MetaValue)] = second (Just . MetaString) <$> unArbitraryMapText metaList0
         pd = unArbitraryPandoc apd
-        (Pandoc metaNew _) = applyMetas (second (Just . MetaString) <$> metaList) pd
+        (Pandoc metaNew _) = applyMetas metaList1 pd
-        mlKeys = Set.fromList $ fst <$> metaList
+        metaMap1 = Map.fromList metaList1 -- remove duplicate keys
-        metaList' = [(k,t) | (k, MetaString t) <- mlist metaNew, Set.member k mlKeys]
+        keys1 = Map.keysSet metaMap1
-      metaList' `shouldMatchList` metaList
+        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        
+      let
-        metaOverwrite = unArbitraryMeta abMetaOverwrite        
+        metaOverwrite = unArbitraryMeta abMetaOverwrite
         pd = unArbitraryPandoc apd
         (Pandoc newMeta _) = addMeta metaOverwrite pd
       (unMeta metaOverwrite `Map.isSubmapOf` unMeta newMeta) `shouldBe` True