{-# LANGUAGE OverloadedStrings #-}
module Slick.Pandoc
( markdownToHTML
, markdownToHTML'
, markdownToHTMLWithOpts
, markdownToHTMLWithOpts'
, makePandocReader
, makePandocReader'
, PandocReader
, PandocWriter
, loadUsing
, loadUsing'
, defaultMarkdownOptions
, defaultHtml5Options
, convert
, flattenMeta
) where
import Data.Aeson
import Development.Shake
import Text.Pandoc
import Text.Pandoc.Highlighting
import Text.Pandoc.Shared
import Slick.Utils
import Data.HashMap.Strict as HM
import qualified Data.Text as T
type PandocReader textType = textType -> PandocIO Pandoc
type PandocWriter = Pandoc -> PandocIO T.Text
defaultMarkdownOptions :: ReaderOptions
defaultMarkdownOptions =
def { readerExtensions = exts }
where
exts = mconcat
[ extensionsFromList
[ Ext_yaml_metadata_block
, Ext_fenced_code_attributes
, Ext_auto_identifiers
]
, githubMarkdownExtensions
]
defaultHtml5Options :: WriterOptions
defaultHtml5Options =
def { writerHighlightStyle = Just tango
, writerExtensions = writerExtensions def
}
unPandocM :: PandocIO a -> Action a
unPandocM p = do
result <- liftIO $ runIO p
either (fail . show) return result
markdownToHTML :: T.Text
-> Action Value
markdownToHTML txt =
markdownToHTMLWithOpts defaultMarkdownOptions defaultHtml5Options txt
markdownToHTML' :: (FromJSON a)
=> T.Text
-> Action a
markdownToHTML' txt =
markdownToHTML txt >>= convert
markdownToHTMLWithOpts
:: ReaderOptions
-> WriterOptions
-> T.Text
-> Action Value
markdownToHTMLWithOpts rops wops txt =
loadUsing
(readMarkdown rops)
(writeHtml5String wops)
txt
markdownToHTMLWithOpts'
:: (FromJSON a)
=> ReaderOptions
-> WriterOptions
-> T.Text
-> Action a
markdownToHTMLWithOpts' rops wops txt =
markdownToHTMLWithOpts rops wops txt >>= convert
makePandocReader :: PandocReader textType
-> textType
-> Action (Pandoc, Value)
makePandocReader readerFunc text = do
pdoc@(Pandoc meta _) <- unPandocM $ readerFunc text
return (pdoc, flattenMeta meta)
makePandocReader' :: (FromJSON a) => PandocReader textType
-> textType
-> Action (Pandoc, a)
makePandocReader' readerFunc text = do
(pdoc, meta) <- makePandocReader readerFunc text
convertedMeta <- convert meta
return (pdoc, convertedMeta)
loadUsing :: PandocReader textType
-> PandocWriter
-> textType
-> Action Value
loadUsing reader writer text = do
(pdoc, meta) <- makePandocReader reader text
outText <- unPandocM $ writer pdoc
withContent <- case meta of
Object m -> return . Object $ HM.insert "content" (String outText) m
_ -> fail "Failed to parse metadata"
return withContent
loadUsing' :: (FromJSON a)
=> PandocReader textType
-> PandocWriter
-> textType
-> Action a
loadUsing' reader writer text =
loadUsing reader writer text >>= convert
flattenMeta :: Meta -> Value
flattenMeta (Meta meta) = toJSON $ fmap go meta
where
go :: MetaValue -> Value
go (MetaMap m) = toJSON $ fmap go m
go (MetaList m) = toJSONList $ fmap go m
go (MetaBool m) = toJSON m
go (MetaString m) = toJSON m
go (MetaInlines m) = toJSON $ stringify m
go (MetaBlocks m) = toJSON $ stringify m