diff --git a/package.yaml b/package.yaml index 4d2b09259..8ee999e89 100644 --- a/package.yaml +++ b/package.yaml @@ -147,6 +147,7 @@ dependencies: - extended-reals - rfc5051 - unidecode + - doctemplates - pandoc - pandoc-types - insert-ordered-containers diff --git a/src/Handler/Admin/Apc.hs b/src/Handler/Admin/Apc.hs index 0857cbf68..3f7d9d5d3 100644 --- a/src/Handler/Admin/Apc.hs +++ b/src/Handler/Admin/Apc.hs @@ -1,16 +1,21 @@ +{-# OPTIONS -Wno-unused-top-binds #-} -- TODO: remove me, for debugging only + module Handler.Admin.Apc ( getAdminApcR , postAdminApcR ) where import Import +import qualified Text.Pandoc as P +import qualified Text.Pandoc.Builder as P +-- import Utils.Print -- import qualified Control.Monad.State.Class as State -- import Data.Aeson (encode) -- import qualified Data.Text as Text -- import qualified Data.Set as Set -- import Handler.Utils -{- + data MetaPinRenewal = MetaPinRenewal { mppOpening :: Maybe Text , mppClosing :: Maybe Text @@ -19,13 +24,29 @@ data MetaPinRenewal = MetaPinRenewal , mppLogin :: Text , mppPin :: Text , mppRecipient :: Text - , mppAdress :: [Text] + , mppAddress :: [Text] , mppLang :: Text , mppIsDe :: Bool } deriving (Eq, Ord, Read, Show, Generic, Typeable) +formToMetaValues :: MetaPinRenewal -> P.Meta +formToMetaValues MetaPinRenewal{..} = P.Meta . mconcat $ catMaybes + [ toMeta "opening" <$> mppOpening + , toMeta "closing" <$> mppClosing + , toMeta "date" <$> mppDate + , toMeta "url" <$> mppURL + , toMeta "login" mppLogin & pure + , toMeta "pin" mppPin & pure + , toMeta "recipient" mppRecipient & pure + , toMeta "address" mppAddress & pure + , toMeta "lang" mppLang & pure + , toMeta "is-de" mppIsDe & pure + ] + where + toMeta k = singletonMap k . P.toMetaValue +{- makePrintForm :: Maybe MetaPinRenewal -> Form MetaPinRenewal makePrintForm tmpl = identifyForm FIDLmsLetter . validateForm validateMetaPinRenewal $ \html -> flip (renderAForm FormStandard) html $ MetaPinRenewal diff --git a/src/Handler/Admin/Test.hs b/src/Handler/Admin/Test.hs index bc5368c76..6a91b308d 100644 --- a/src/Handler/Admin/Test.hs +++ b/src/Handler/Admin/Test.hs @@ -4,8 +4,8 @@ module Handler.Admin.Test , getAdminTestPdfR ) where -import Import hiding (embedFile) -import Data.FileEmbed (embedFile) +import Import +import Utils.Print import Handler.Utils import Jobs @@ -279,17 +279,16 @@ postAdminTestR = do getAdminTestPdfR :: Handler TypedContent getAdminTestPdfR = do + -- uUser <- maybeAuth -- to determine language for test templates <- liftIO $ do - let letter_md = decodeUtf8 $(Data.FileEmbed.embedFile "templates/letter/fraport_renewal.md") - letter_tp <- P.compileTemplate "" letter_md - let din5008_tex = decodeUtf8 $(Data.FileEmbed.embedFile "templates/letter/din5008.latex") - din5008 <- P.compileTemplate "" din5008_tex + letter_tp <- P.compileTemplate "" templateRenewal + din5008 <- P.compileTemplate "" templateDIN5008 now <- getCurrentTime - return (now, letter_md, letter_tp, din5008) + return (now, letter_tp, din5008) case templates of - (_,_,Left err,_) -> sendResponseStatus internalServerError500 $ tshow err - (_,_,_,Left err) -> sendResponseStatus internalServerError500 $ tshow err - (now, md, Right templ, Right latex) -> do + (_,Left err,_) -> sendResponseStatus internalServerError500 $ tshow err + (_,_,Left err) -> sendResponseStatus internalServerError500 $ tshow err + (now, Right templ, Right latex) -> do content <- liftIO . P.runIO $ do let texopts = [] readeropts = def { P.readerExtensions = P.pandocExtensions } @@ -297,7 +296,7 @@ getAdminTestPdfR = do writeropts2 = def { P.writerTemplate = Just latex } -- https://github.com/jgm/pandoc/issues/1950 -- using markdown as a template for itself for interpolation: - doc1 <- P.readMarkdown readeropts md + doc1 <- P.readMarkdown readeropts templateRenewal doc2 <- P.writeMarkdown writeropts1 doc1 doc3 <- P.readMarkdown readeropts doc2 P.makePDF "lualatex" texopts P.writeLaTeX writeropts2 $ diff --git a/src/Utils/Print.hs b/src/Utils/Print.hs new file mode 100644 index 000000000..b31b963ca --- /dev/null +++ b/src/Utils/Print.hs @@ -0,0 +1,65 @@ +module Utils.Print where + +import Import.NoModel +import qualified Data.Foldable as Fold +-- hiding (foldr) import Data.Foldable (foldr) + +import Control.Monad.Except +import Import hiding (embedFile) +import Data.FileEmbed (embedFile) + +import qualified Text.DocTemplates as P +import qualified Text.Pandoc as P +-- import qualified Text.Pandoc.PDF as P +import qualified Text.Pandoc.Builder as P + +-- import Model.Types.Markup -- TODO-QSV: should this module be moved accordingly? + +templateRenewal :: Text +templateRenewal = decodeUtf8 $(Data.FileEmbed.embedFile "templates/letter/fraport_renewal.md") + +templateDIN5008 :: Text +templateDIN5008 = decodeUtf8 $(Data.FileEmbed.embedFile "templates/letter/din5008.latex") + + +-- setMeta :: (HasMeta a, ToMetaValue b) => Text -> b -> a -> a + +-- foldr :: forall b. (Element mono0 -> b -> b) -> b -> mono0 -> b + + +applyMetas :: (P.HasMeta p, Foldable t, P.ToMetaValue a) => t (Text, a) -> p -> p +applyMetas metas doc = Fold.foldr (uncurry P.setMeta) doc metas + +addMeta :: P.Meta -> P.Pandoc -> P.Pandoc +addMeta m p = meta <> p + where meta = P.Pandoc m mempty + + +-- reTemplateLetter :: (P.PandocMonad m, P.TemplateMonad m, Foldable t, P.ToMetaValue a) => t (Text, a) -> StoredMarkup -> m Text +reTemplateLetter :: (P.TemplateMonad m, P.PandocMonad m) => P.Meta -> StoredMarkup -> m Text +reTemplateLetter meta StoredMarkup{..} = do + let strictMarkupInput = toStrict markupInput + mdTemplate <- P.compileTemplate "" strictMarkupInput + case mdTemplate of + (Left err) -> throwError . P.PandocTemplateError $ pack err + (Right templ) -> do + let readeropts = def { P.readerExtensions = P.pandocExtensions } + writeropts = def { P.writerTemplate = Just templ } + -- reader :: (P.PandocMonad m, P.ToSources a) => P.ReaderOptions -> a -> m P.Pandoc + areader = case markupInputFormat of + MarkupHtml -> P.readHtml + MarkupMarkdown -> P.readMarkdown + MarkupPlaintext -> P.readMarkdown + doc1 <- areader readeropts strictMarkupInput + P.writeMarkdown writeropts $ addMeta meta doc1 -- should we apply metas here? + + +{- + +renewalLetter :: (Foldable t, ToMetaValue b, PandocMonad m) => t (Text, b) -> PandocMonad m -> Text +renewalLetter + +pdfDIN5008 :: MetaPinRenewal -> IO (Either ByteString ByteString) +pdfDIN5008 + +-} \ No newline at end of file diff --git a/templates/letter/din5008.latex b/templates/letter/din5008.latex index 6f863c761..5cfdf8224 100644 --- a/templates/letter/din5008.latex +++ b/templates/letter/din5008.latex @@ -6,8 +6,9 @@ fromphone=true, % show phone number fromemail=true, % show email fromlogo=false, % don't show logo in letter head - version=last % latest version of KOMA letter - pagenumber=botright % show pagenumbers on bottom right + version=last, % latest version of KOMA letter + pagenumber=botright, % show pagenumbers on bottom right + firstfoot=true ]{scrlttr2} \PassOptionsToPackage{hyphens}{url}