diff --git a/src/Utils/Print.hs b/src/Utils/Print.hs index c34ee6ca7..96689199b 100644 --- a/src/Utils/Print.hs +++ b/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 diff --git a/test/PandocSpec.hs b/test/PandocSpec.hs index 7652022d9..d43579b00 100644 --- a/test/PandocSpec.hs +++ b/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 \ No newline at end of file