commit 1fe20bf3f899efe132e6df04d7b77339eb5aa5f0
parent 04139346bab015cea1de082cdd0cc59e476578fe
Author: krasjet
Date: 2020-03-17 08:51Z

include templates to pandoc output

Diffstat:

Mkarasu.cabal | 6+++++-


Mpackage.yaml | 1+


Msrc/Karasu/Handlers/ApiCreateDoc.hs | 2+-


Msrc/Karasu/Handlers/ApiPreviewDoc.hs | 9+++------


Asrc/Karasu/Pandoc/Options.hs | 15+++++++++++++++


Asrc/Karasu/Pandoc/Renderer.hs | 26++++++++++++++++++++++++++


Mstack.yaml | 17++++++++++++++++-


Atemplates/preview.html | 23+++++++++++++++++++++++


8 files changed, 90 insertions(+), 9 deletions(-)

diff --git a/karasu.cabal b/karasu.cabal
@@ -4,7 +4,7 @@ cabal-version: >=2.0
 --
 -- see: https://github.com/sol/hpack
 --
--- hash: 1c6146379423834387b558bd03ebccfc375815488f25cfa367445b5a4c94e74c
+-- hash: c09f0ffd457692af0c3349c28016c948186fea57a013b56eb67ed3df480eb53c
 
 name:           karasu
 version:        0.1.0.0
@@ -31,6 +31,8 @@ library
       Karasu.Handlers.ApiPreviewDoc
       Karasu.Handlers.Static
       Karasu.Models
+      Karasu.Pandoc.Options
+      Karasu.Pandoc.Renderer
       Karasu.Server
   other-modules:
       Paths_karasu
@@ -43,6 +45,7 @@ library
     , blaze-html
     , bytestring
     , directory
+    , doctemplates
     , dotenv
     , filepath
     , monad-logger
@@ -73,6 +76,7 @@ executable karasu
     , blaze-html
     , bytestring
     , directory
+    , doctemplates
     , dotenv
     , filepath
     , karasu
diff --git a/package.yaml b/package.yaml
@@ -18,6 +18,7 @@ dependencies:
 - blaze-html
 - bytestring
 - directory
+- doctemplates
 - dotenv
 - filepath
 - monad-logger
diff --git a/src/Karasu/Handlers/ApiCreateDoc.hs b/src/Karasu/Handlers/ApiCreateDoc.hs
@@ -72,5 +72,5 @@ createDoc docBody = do
   docDir <- asks envDocDir
   let mdFile = docDir </> dId <.> ".md"
   liftIO $ createDirectoryIfMissing True $ takeDirectory mdFile
-  liftIO $ TIO.writeFile mdFile $ T.pack $ "# " <> dId <> "\n"
+  liftIO $ TIO.writeFile mdFile $ T.pack $ "---\ntitle: " <> dId <> "\n---"
   return "The doc is up. Hooray!"
diff --git a/src/Karasu/Handlers/ApiPreviewDoc.hs b/src/Karasu/Handlers/ApiPreviewDoc.hs
@@ -9,6 +9,7 @@ module Karasu.Handlers.ApiPreviewDoc (PreviewDocApi, previewDoc) where
 import Karasu.Database
 import Karasu.Handler
 import Karasu.Models
+import Karasu.Pandoc.Renderer
 
 import qualified Data.ByteString.Lazy.Char8 as LB8
 
@@ -20,7 +21,6 @@ import GHC.Generics
 import Servant
 import Servant.HTML.Blaze
 import Text.Blaze.Html
-import Text.Pandoc
 
 data PreviewDocBody = PreviewDocBody {
   docId      :: DocId,
@@ -48,13 +48,10 @@ previewDoc prevBody = do
     Just (Entity _ doc) ->
       -- yes, no accessCode doesn't mean no protection
       when (docInfoAccCode doc /= accessCode prevBody) $
-        throwError err403 { errBody = "Nope, try again." }
+        throwError err403 { errBody = "Access denied. Try again." }
   -- now, start rendering the markdown file (TODO lift to a Pandoc package)
   let md = markdown prevBody
-
-  let out = runPure $ do
-              pandoc <- readMarkdown def md
-              writeHtml5 def pandoc
+  out <- liftIO $ renderPreview md
   case out of
     Left err   -> throwError err400 { errBody = LB8.pack $ show err }
     Right html -> return $ preEscapedToMarkup html
diff --git a/src/Karasu/Pandoc/Options.hs b/src/Karasu/Pandoc/Options.hs
@@ -0,0 +1,15 @@
+-- | Pandoc options
+module Karasu.Pandoc.Options (defKarasuReaderOptions, defKarasuWriterOptions) where
+
+import Text.Pandoc
+
+-- | Default reader options for Karasu
+defKarasuReaderOptions :: ReaderOptions
+defKarasuReaderOptions= def
+    { readerExtensions = enableExtension Ext_smart pandocExtensions }
+
+
+-- | Default writer options for Karasu
+defKarasuWriterOptions :: WriterOptions
+defKarasuWriterOptions = def
+    { writerExtensions = enableExtension Ext_smart pandocExtensions }
diff --git a/src/Karasu/Pandoc/Renderer.hs b/src/Karasu/Pandoc/Renderer.hs
@@ -0,0 +1,26 @@
+{-# LANGUAGE OverloadedStrings #-}
+
+-- | The renderer for markdown -> html conversion
+module Karasu.Pandoc.Renderer (renderPreview) where
+
+import Karasu.Pandoc.Options
+
+import qualified Data.Text as T
+
+import Control.Monad.Except   (throwError)
+import Control.Monad.IO.Class (liftIO)
+import Data.Text              (Text)
+import System.FilePath        ((<.>), (</>))
+import Text.Blaze.Html
+import Text.DocTemplates
+import Text.Pandoc
+
+renderPreview :: Text -> IO (Either PandocError Html)
+renderPreview md = runIO $ do
+  pandoc <- readMarkdown defKarasuReaderOptions md
+  res <- liftIO $ compileTemplateFile $ "templates" </> "preview" <.> "html"
+  case res of
+    Left e -> throwError $ PandocTemplateError (T.pack e)
+    Right template -> do
+      let wOpts = defKarasuWriterOptions { writerTemplate = Just template }
+      writeHtml5 wOpts pandoc
diff --git a/stack.yaml b/stack.yaml
@@ -3,5 +3,20 @@ resolver: lts-14.27
 packages:
 - .
 
-extra-deps: []
+# several APIs about templates has changed since 2.7, so we need to use the
+# latest version
+extra-deps:
+- pandoc-2.9.2
+- HsYAML-0.2.1.0
+- doclayout-0.3
+- doctemplates-0.8.1
+- emojis-0.1
+- haddock-library-1.8.0
+- jira-wiki-markup-1.0.0
+- pandoc-types-1.20
+- skylighting-0.8.3.2
+- skylighting-core-0.8.3.2
+- texmath-0.12.0.1
+- regex-pcre-builtin-0.95.1.1.8.43
+- regex-base-0.94.0.0
 
diff --git a/templates/preview.html b/templates/preview.html
@@ -0,0 +1,23 @@
+<!DOCTYPE html>
+<html lang="en">
+<head>
+<title>$if(pagetitle)$$pagetitle$$else$$title$$endif$</title>
+<meta charset="utf-8" />
+<meta name="viewport" content="width=device-width, initial-scale=1" />
+<meta name="robots" content="noindex" />
+<meta name="referrer" content="no-referrer" />
+<link href="/styles/reset.css" rel="stylesheet" />
+<link href="/styles/doc/main.css" rel="stylesheet" />
+<link href="/fonts/fonts.css" rel="stylesheet" />
+<link href="/styles/doc/syntax.css" rel="stylesheet" />
+</head>
+<body>
+<header>
+<h1>$title$</h1>$if(author)$
+<div class="author sc">by $author$</div>$endif$
+</header>
+<main>
+$body$
+</main>
+</body>
+</html>