Adjust to Pandoc API changes

src/Action.hs

@@ -21,7 +21,7 @@ import Control.Exception
 import Data.IORef
 import Data.List as List
 import Data.List (isInfixOf)
-import Data.List.Extra as List
+import qualified Data.List.Extra as List
 import Data.Maybe
 import qualified Data.Yaml as Y
 import Development.Shake
@@ -101,7 +101,7 @@ calcSource targetSuffix srcSuffix target = do
 
 -- | Removes the last suffix from a filename
 dropSuffix :: String -> String -> String
-dropSuffix s t = fromMaybe t (stripSuffix s t)
+dropSuffix s t = fromMaybe t (List.stripSuffix s t)
 
 replaceSuffix :: String -> String -> String -> String
 replaceSuffix srcSuffix targetSuffix filename =

src/Context.hs

@@ -23,7 +23,7 @@ import Data.Dynamic
 import qualified Data.HashMap.Lazy as HashMap
 import Data.IORef
 import Data.Maybe (fromMaybe)
-import Data.Typeable ()
+import Data.Typeable (TypeRep, typeOf)
 import Development.Shake as Shake
 import Project
 import Server

src/Embed.hs

@@ -17,7 +17,7 @@ module Embed
 import qualified Data.ByteString.Char8 as B
 import Data.FileEmbed
 import Data.List
-import Data.List.Extra
+-- import Data.List.Extra
 import Data.Maybe
 
 deckerExampleDir :: [(FilePath, B.ByteString)]
@@ -35,14 +35,20 @@ defaultTemplate path = snd <$> find (\(k, _) -> k == path) deckerTemplateDir
 defaultTemplateString :: FilePath -> Maybe String
 defaultTemplateString path = B.unpack <$> defaultTemplate path
 
+deckerHelpText :: String
 deckerHelpText = fromJust $ defaultTemplateString "help-page.md"
 
+deckTemplate :: String
 deckTemplate = fromJust $ defaultTemplateString "deck.html"
 
+pageTemplate :: String
 pageTemplate = fromJust $ defaultTemplateString "page.html"
 
+pageLatexTemplate :: String
 pageLatexTemplate = fromJust $ defaultTemplateString "page.tex"
 
+handoutTemplate :: String
 handoutTemplate = fromJust $ defaultTemplateString "handout.html"
 
+handoutLatexTemplate :: String
 handoutLatexTemplate = fromJust $ defaultTemplateString "handout.tex"

src/Meta.hs

@@ -33,10 +33,15 @@ toMustacheMeta (MetaList a) = MT.Array $ Vec.fromList $ map toMustacheMeta a
 toMustacheMeta (MetaBool bool) = MT.Bool bool
 toMustacheMeta (MetaString string) = MT.String $ T.pack string
 toMustacheMeta (MetaInlines inlines) =
-  MT.String $
-  T.pack $ writeMarkdown def (Pandoc (Meta Map.empty) [Plain inlines])
+  MT.String $ writeMarkdownText def (Pandoc (Meta Map.empty) [Plain inlines])
 toMustacheMeta (MetaBlocks blocks) =
-  MT.String $ T.pack $ writeMarkdown def (Pandoc (Meta Map.empty) blocks)
+  MT.String $ writeMarkdownText def (Pandoc (Meta Map.empty) blocks)
+
+writeMarkdownText :: WriterOptions -> Pandoc -> T.Text 
+writeMarkdownText options pandoc =
+  case runPure $ writeMarkdown options pandoc of
+    Right text -> text
+    Left err -> throw $ PandocException $ show err
 
 mergePandocMeta :: MetaValue -> MetaValue -> MetaValue
 mergePandocMeta (MetaMap meta1) (MetaMap meta2) =

src/Render.hs

@@ -9,12 +9,12 @@ import CRC32
 import Common
 import Context
 import Control.Monad.State
+import Control.Monad.Extra
 import Data.List
 import Data.List.Extra
 import qualified Data.Map.Lazy as Map
 import Data.Maybe
 import qualified Data.Set as Set
-import Extra
 import Project
 import System.Directory (createDirectoryIfMissing, doesFileExist)
 import System.FilePath.Posix

src/Utilities.hs

@@ -36,8 +36,8 @@ import Data.IORef
 import Data.List as List
 import Data.List.Extra as List
 import qualified Data.Map.Lazy as Map
-import qualified Data.Set as Set
 import qualified Data.Text as T
+import qualified Data.Text.IO as T
 import qualified Data.Text.Encoding as E
 import qualified Data.Yaml as Y
 import Development.Shake
@@ -51,7 +51,6 @@ import Render
 import Resources
 import Server
 import qualified System.Directory as Dir
-import System.IO as S
 import Text.CSL.Pandoc
 import qualified Text.Mustache as M
 import qualified Text.Mustache.Types as MT
@@ -60,6 +59,7 @@ import Text.Pandoc.Builder
 import Text.Pandoc.PDF
 import Text.Pandoc.Shared
 import Text.Pandoc.Walk
+import Text.Pandoc.Highlighting
 import Watch
 
 runShakeInContext :: ActionContext -> ShakeOptions -> Rules () -> IO ()
@@ -156,15 +156,10 @@ markdownToHtmlDeck markdownFile out = do
         pandocWriterOpts
         { writerSlideLevel = Just 1
         , writerTemplate = Just template
-        -- , writerStandalone = True
-        , writerHighlight = True
-        -- , writerHighlightStyle = pygments
+        , writerHighlightStyle = Just pygments
         , writerHTMLMathMethod =
             MathJax
               (supportDirRel </> "MathJax-2.7/MathJax.js?config=TeX-AMS_HTML")
-        -- ,writerHTMLMathMethod =
-        --    KaTeX (supportDirRel </> "katex-0.6.0/katex.min.js")
-        --          (supportDirRel </> "katex-0.6.0/katex.min.css")
         , writerVariables =
             [ ("revealjs-url", supportDirRel </> "reveal.js-3.5.0")
             , ("decker-support-dir", supportDirRel)
@@ -172,16 +167,17 @@ markdownToHtmlDeck markdownFile out = do
         , writerCiteMethod = Citeproc
         }
   readAndProcessMarkdown markdownFile (Disposition Deck Html) >>=
-    writePandocString "revealjs" options out
-
--- | Selects a matching pandoc string writer for the format string, or throws an
--- exception.
-getPandocWriter :: String -> StringWriter
-getPandocWriter fmt =
-  case getWriter fmt of
-    Right (PureStringWriter w) -> w
-    Left e -> throw $ PandocException e
-    _ -> throw $ PandocException $ "No writer for format: " ++ fmt
+    writePandocFile "revealjs" options out
+
+writePandocFile :: String -> WriterOptions -> FilePath -> Pandoc -> Action ()
+writePandocFile fmt options out pandoc =
+  liftIO $ do
+    case getWriter fmt of
+      Right (TextWriter writePandoc, _) -> do
+        runIO (writePandoc options pandoc) >>= handleError >>= T.writeFile out
+      Right (ByteStringWriter writePandoc, _) -> do
+        runIO (writePandoc options pandoc) >>= handleError >>= LB.writeFile out
+      Left e -> throw $ PandocException e
 
 versionCheck :: Meta -> Action ()
 versionCheck meta =
@@ -290,9 +286,8 @@ markdownToHtmlPage markdownFile out = do
   template <- getTemplate "page.html"
   let options =
         pandocWriterOpts
-        { writerHtml5 = True
-        , writerTemplate = Just template
-        , writerHighlight = True
+        { writerTemplate = Just template
+        , writerHighlightStyle = Just pygments
         , writerHTMLMathMethod =
             MathJax
               (supportDir </> "MathJax-2.7/MathJax.js?config=TeX-AMS_HTML")
@@ -300,7 +295,7 @@ markdownToHtmlPage markdownFile out = do
         , writerCiteMethod = Citeproc
         }
   readAndProcessMarkdown markdownFile (Disposition Page Html) >>=
-    writePandocString "html5" options out
+    writePandocFile "html5" options out
 
 -- | Write a markdown file to a PDF file using the handout template.
 markdownToPdfPage :: FilePath -> FilePath -> Action ()
@@ -310,7 +305,7 @@ markdownToPdfPage markdownFile out = do
   let options =
         pandocWriterOpts
         { writerTemplate = Just template
-        , writerHighlight = True
+        , writerHighlightStyle = Just pygments
         , writerCiteMethod = Citeproc
         }
   readAndProcessMarkdown markdownFile (Disposition Page Pdf) >>=
@@ -318,10 +313,11 @@ markdownToPdfPage markdownFile out = do
 
 pandocMakePdf :: WriterOptions -> FilePath -> Pandoc -> Action ()
 pandocMakePdf options out pandoc = do
-  result <- liftIO $ makePDF "pdflatex" writeLaTeX options pandoc
-  case result of
-    Left errMsg -> throw $ PandocException (show errMsg)
-    Right pdf -> liftIO $ LB.writeFile out pdf
+  liftIO $ do
+    result <- runIO (makePDF "pdflatex" [] writeLaTeX options pandoc) >>= handleError
+    case result of
+      Left errMsg -> throw $ PandocException (show errMsg)
+      Right pdf -> liftIO $ LB.writeFile out pdf
 
 -- | Write a markdown file to a HTML file using the handout template.
 markdownToHtmlHandout :: FilePath -> FilePath -> Action ()
@@ -331,9 +327,8 @@ markdownToHtmlHandout markdownFile out = do
   template <- getTemplate "handout.html"
   let options =
         pandocWriterOpts
-        { writerHtml5 = True
-        , writerTemplate = Just template
-        , writerHighlight = True
+        { writerTemplate = Just template
+        , writerHighlightStyle = Just pygments
         , writerHTMLMathMethod =
             MathJax
               (supportDir </> "MathJax-2.7/MathJax.js?config=TeX-AMS_HTML")
@@ -341,7 +336,7 @@ markdownToHtmlHandout markdownFile out = do
         , writerCiteMethod = Citeproc
         }
   readAndProcessMarkdown markdownFile (Disposition Handout Html) >>=
-    writePandocString "html5" options out
+    writePandocFile "html5" options out
 
 -- | Write a markdown file to a PDF file using the handout template.
 markdownToPdfHandout :: FilePath -> FilePath -> Action ()
@@ -351,7 +346,7 @@ markdownToPdfHandout markdownFile out = do
   let options =
         pandocWriterOpts
         { writerTemplate = Just template
-        , writerHighlight = True
+        , writerHighlightStyle = Just pygments
         , writerCiteMethod = Citeproc
         }
   readAndProcessMarkdown markdownFile (Disposition Handout Pdf) >>=
@@ -366,18 +361,18 @@ readMetaMarkdown markdownFile = do
   -- read external meta data for this directory
   externalMeta <- readMetaDataForDir (takeDirectory markdownFile)
   -- extract embedded meta data from the document
-  markdown <- liftIO $ S.readFile markdownFile
+  markdown <- liftIO $ T.readFile markdownFile
   let Pandoc meta _ = readMarkdownOrThrow pandocReaderOpts markdown
   let documentMeta = MetaMap $ unMeta meta
   -- combine the meta data with preference on the embedded data
   let combinedMeta = mergePandocMeta documentMeta (toPandocMeta externalMeta)
   let mustacheMeta = toMustacheMeta combinedMeta
    -- use mustache to substitute
-  let substituted = substituteMetaData (T.pack markdown) mustacheMeta
+  let substituted = substituteMetaData markdown mustacheMeta
   -- read markdown with substitutions again
   let Pandoc _ blocks =
-        readMarkdownOrThrow pandocReaderOpts $ T.unpack substituted
-  case combinedMeta of 
+        readMarkdownOrThrow pandocReaderOpts substituted
+  case combinedMeta of
     (MetaMap m) -> do
       versionCheck (Meta m)
       let pandoc = Pandoc (Meta m) blocks
@@ -398,17 +393,17 @@ urlToFilePathIfLocal base uri = do
               else absBase </> filePath
       return absPath
 
-readMarkdownOrThrow :: ReaderOptions -> String -> Pandoc
-readMarkdownOrThrow opts string =
-  case readMarkdown opts string of
+readMarkdownOrThrow :: ReaderOptions -> T.Text -> Pandoc
+readMarkdownOrThrow opts markdown =
+  case runPure (readMarkdown opts markdown) of
     Right pandoc -> pandoc
     Left errMsg -> throw $ PandocException (show errMsg)
 
 -- Remove automatic identifier creation for headers. It does not work well with
 -- the current include mechanism if slides have duplicate titles in separate
 -- include files.
-deckerPandocExtensions :: Set.Set Extension
-deckerPandocExtensions = Set.delete Ext_auto_identifiers pandocExtensions
+deckerPandocExtensions :: Extensions
+deckerPandocExtensions = disableExtension Ext_auto_identifiers pandocExtensions
 
 pandocReaderOpts :: ReaderOptions
 pandocReaderOpts = def {readerExtensions = deckerPandocExtensions}
@@ -546,13 +541,6 @@ processCitesWithDefault pandoc@(Pandoc meta blocks) =
            _ -> return pandoc
     liftIO $ processCites' document
 
-type StringWriter = WriterOptions -> Pandoc -> String
-
-writePandocString :: String -> WriterOptions -> FilePath -> Pandoc -> Action ()
-writePandocString fmt options out pandoc = do
-  let writer = getPandocWriter fmt
-  writeFile' out (writer options pandoc)
-
 writeExampleProject :: Action ()
 writeExampleProject = do
   liftIO $ writeResourceFiles "example" "."

stack.yaml

@@ -2,4 +2,4 @@ flags: {}
 packages:
 - '.'
 extra-deps:
-resolver: lts-9.18
+resolver: lts-10.8