chore(pandoc): improved tests for helper functions like addMeta

src/Utils/Print.hs

@@ -1,10 +1,10 @@
 module Utils.Print where
 
 -- import Import.NoModel
--- import qualified Data.Foldable as Fold
--- hiding (foldr) import Data.Foldable (foldr)
+import qualified Data.Foldable as Fold
+import qualified Data.Text as T
+import qualified Data.CaseInsensitive as CI
 
--- import qualified Data.Text as T
 import qualified Data.ByteString.Lazy as LBS
 import Control.Monad.Except
 import Import hiding (embedFile)
@@ -67,8 +67,8 @@ appMeta f (P.Pandoc m bs) = P.Pandoc (f m) bs
 -- appMeta f = _Meta %~ f -- lens version. Not sure this is better
 
 -- Add tests for applyMetas, if ever needed
--- applyMetas :: (P.HasMeta p, Foldable t, P.ToMetaValue a) => t (Text, a) -> p -> p
--- applyMetas metas doc = Fold.foldr (uncurry P.setMeta) doc metas
+applyMetas :: (P.HasMeta p, Foldable t, P.ToMetaValue a) => t (Text, a) -> p -> p
+applyMetas metas doc = Fold.foldr (uncurry P.setMeta) doc metas
 
 -- | Add meta to pandoc. Existing variables will be overwritten.
 addMeta :: P.Meta -> P.Pandoc -> P.Pandoc
@@ -221,11 +221,19 @@ pdfRenewal' meta = do
 -- PrintJobs --
 ---------------
 
-sendLetter :: Text -> LBS.ByteString -> Maybe UserId -> Maybe UserId -> Maybe CourseId -> Maybe QualificationId -> DB ()
+sendLetter :: Text -> LBS.ByteString -> Maybe UserId -> Maybe UserId -> Maybe CourseId -> Maybe QualificationId -> DB FilePath
 sendLetter printJobName pdf printJobRecipient printJobSender printJobCourse printJobQualification = do 
+  recipient <- fmap userDisplayName . join <$> mapM get printJobRecipient
+  sender    <- fmap userDisplayName . join <$> mapM get printJobRecipient
+  course    <- fmap (CI.original . courseShorthand       ) . join <$> mapM get printJobCourse
+  quali     <- fmap (CI.original . qualificationShorthand) . join <$> mapM get printJobQualification
   let printJobAcknowledged = Nothing
-  printJobFile <- sinkFileDB True $ yield $ LBS.toStrict pdf -- sinkFileDB: Boolean Field problematic? Hashing?
+      printJobFilename = unpack . T.intercalate "_" . catMaybes $ [Just printJobName, quali, course, sender, recipient]
+      -- printJobFile <- sinkFileDB True $ yield $ LBS.toStrict pdf -- for PrintJobFile :: FileContentReference use this code
+      printJobFile = LBS.toStrict pdf
+  -- TODO: system call to lpr here!
   printJobCreated <- liftIO getCurrentTime
   insert_ PrintJob {..}
+  return printJobFilename
 
 

test/PandocSpec.hs

@@ -4,39 +4,79 @@ import TestImport
 
 import Utils.Print
 
+import qualified Data.Set as Set
 import qualified Data.Map.Lazy as Map
+import qualified Data.Foldable as Fold
 
 import Text.Pandoc
+import Text.Pandoc.Builder
 import Text.Pandoc.Arbitrary ()
 
+-- Instance Arbitrary Meta is somewhat useless, as it always generates the same 3 keys.
+newtype ArbitraryMeta = ArbitraryMeta { unArbitraryMeta :: Meta }
+  deriving newtype (Eq, Ord, Semigroup, Monoid, Show, Read)
+
+instance Arbitrary ArbitraryMeta where
+        arbitrary
+          = do (x1 :: Inlines) <- arbitrary
+               (x2 :: [Inlines]) <- filter (not . Fold.null) <$> arbitrary
+               (x3 :: Inlines) <- arbitrary
+               (x4 :: [(Text, Text)]) <- arbitrary
+               (x5 :: [(Text, Bool)]) <- arbitrary
+               return $ ArbitraryMeta
+                      $ setMeta "title" x1
+                      $ setMeta "author" x2
+                      $ setMeta "date" x3
+                      $ applyMetas x4
+                      $ applyMetas x5
+                        nullMeta
+
+
 -- For Lens Check _Meta required:
 --instance CoArbitrary Inline
 --instance CoArbitrary MetaValue
 --instance CoArbitrary Meta
 --instance Function Inline
 --instance Function MetaValue
---instance Function Meta 
+--instance Function Meta
 
 spec :: Spec
-spec = -- do 
+spec = do
+  let mlist = Map.toList . unMeta
+
+  describe "applyMetas" $ do
+    it "should actually set values" $ do
+      (ml, pd) <- generate arbitrary
+      let
+        mlKeys = Set.fromList $ fst <$> ml
+        (Pandoc newMeta _) = applyMetas (fmap MetaString <$> ml) pd
+        ml' = [(k,t) | (k, MetaString t) <- mlist newMeta, Set.member k mlKeys]
+      ml `shouldMatchList` ml'
+
   describe "addMeta" $ do
-    it "should overwrite existing settings" $ do
-      (metaOverwrite, pd) <- generate arbitrary            
-      let (Pandoc newMeta _) = addMeta metaOverwrite pd
-      Map.toList (unMeta newMeta) `shouldContain` Map.toList (unMeta metaOverwrite)
+    it "should possibly overwrite existing settings" $ do
+      (abMetaOverwrite, abMetaOriginal, blocks) <- generate arbitrary
+      let
+        metaOverwrite = unArbitraryMeta abMetaOverwrite
+        metaOriginal  = unArbitraryMeta abMetaOriginal
+        pd = Pandoc metaOriginal blocks
+        (Pandoc newMeta _) = addMeta metaOverwrite pd
+      mlist newMeta `shouldContain` mlist metaOverwrite
 
     it "should preserve untouched settings" $ do
-      (metaOverwrite, pd) <- generate arbitrary
+      (abMetaOverwrite, abMetaOriginal, blocks) <- generate arbitrary
       let
-        (Pandoc keptMeta _) = pd
+        metaOverwrite = unArbitraryMeta abMetaOverwrite
+        metaOriginal  = unArbitraryMeta abMetaOriginal
+        pd = Pandoc metaOriginal blocks
         (Pandoc newMeta  _) = addMeta metaOverwrite pd
-      Map.toList (unMeta newMeta) `shouldContain` Map.toList (unMeta keptMeta `Map.difference` unMeta metaOverwrite)
+      mlist newMeta `shouldContain` Map.toList (unMeta metaOriginal `Map.difference` unMeta metaOverwrite)
 
-    it "should preserve document block" $ do
-        (metaOverwrite, pd) <- generate arbitrary        
+    it "should preserve document blocks" $ do
+        (metaOverwrite, pd) <- generate arbitrary
         let
           (Pandoc _ oldBlocks) = pd
-          (Pandoc _ newBlocks) = addMeta metaOverwrite pd
+          (Pandoc _ newBlocks) = addMeta (unArbitraryMeta metaOverwrite) pd
         oldBlocks `shouldBe` newBlocks
-      
+
   -- describe "_Meta" . it "is a lens" . property $ isLens _Meta