{-# LANGUAGE OverloadedStrings #-}
module Slick.Pandoc
( markdownToHTML
, markdownToHTML'
, markdownToHTMLWithOpts
, markdownToHTMLWithOpts'
, orgModeToHTML
, orgModeToHTML'
, orgModeToHTMLWithOpts
, orgModeToHTMLWithOpts'
, makePandocReader
, makePandocReader'
, makePandocReaderWithMetaWriter
, makePandocReaderWithMetaWriter'
, PandocReader
, PandocWriter
, loadUsing
, loadUsing'
, loadUsingMeta
, defaultMarkdownOptions
, defaultOrgModeOptions
, defaultHtml5Options
, convert
, flattenMeta
) where
import Data.Aeson
import qualified Data.Aeson.KeyMap as KM
import Development.Shake
import Text.Pandoc
import Text.Pandoc.Highlighting
import Slick.Utils
import qualified Data.Text as T
type PandocReader textType = textType -> PandocIO Pandoc
type PandocWriter = Pandoc -> PandocIO T.Text
defaultMarkdownOptions :: ReaderOptions
defaultMarkdownOptions :: ReaderOptions
defaultMarkdownOptions =
forall a. Default a => a
def { readerExtensions :: Extensions
readerExtensions = Extensions
exts }
where
exts :: Extensions
exts = forall a. Monoid a => [a] -> a
mconcat
[ [Extension] -> Extensions
extensionsFromList
[ Extension
Ext_yaml_metadata_block
, Extension
Ext_fenced_code_attributes
, Extension
Ext_auto_identifiers
, Extension
Ext_footnotes
]
, Extensions
githubMarkdownExtensions
]
defaultHtml5Options :: WriterOptions
defaultHtml5Options :: WriterOptions
defaultHtml5Options =
forall a. Default a => a
def { writerHighlightStyle :: Maybe Style
writerHighlightStyle = forall a. a -> Maybe a
Just Style
tango
, writerExtensions :: Extensions
writerExtensions = WriterOptions -> Extensions
writerExtensions forall a. Default a => a
def
}
defaultOrgModeOptions :: ReaderOptions
defaultOrgModeOptions :: ReaderOptions
defaultOrgModeOptions =
forall a. Default a => a
def { readerExtensions :: Extensions
readerExtensions = Extensions
exts }
where
exts :: Extensions
exts = forall a. Monoid a => [a] -> a
mconcat
[ [Extension] -> Extensions
extensionsFromList
[ Extension
Ext_fenced_code_attributes
, Extension
Ext_auto_identifiers
]
]
unPandocM :: PandocIO a -> Action a
unPandocM :: forall a. PandocIO a -> Action a
unPandocM PandocIO a
p = do
Either PandocError a
result <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall a. PandocIO a -> IO (Either PandocError a)
runIO PandocIO a
p
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (forall (m :: * -> *) a. MonadFail m => String -> m a
fail forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> String
show) forall (m :: * -> *) a. Monad m => a -> m a
return Either PandocError a
result
markdownToHTML :: T.Text
-> Action Value
markdownToHTML :: Text -> Action Value
markdownToHTML Text
txt =
ReaderOptions -> WriterOptions -> Text -> Action Value
markdownToHTMLWithOpts ReaderOptions
defaultMarkdownOptions WriterOptions
defaultHtml5Options Text
txt
markdownToHTML' :: (FromJSON a)
=> T.Text
-> Action a
markdownToHTML' :: forall a. FromJSON a => Text -> Action a
markdownToHTML' Text
txt =
Text -> Action Value
markdownToHTML Text
txt forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall a b. (FromJSON a, ToJSON a, FromJSON b) => a -> Action b
convert
markdownToHTMLWithOpts
:: ReaderOptions
-> WriterOptions
-> T.Text
-> Action Value
markdownToHTMLWithOpts :: ReaderOptions -> WriterOptions -> Text -> Action Value
markdownToHTMLWithOpts ReaderOptions
rops WriterOptions
wops Text
txt =
forall textType.
PandocReader textType -> PandocWriter -> textType -> Action Value
loadUsing
(forall (m :: * -> *) a.
(PandocMonad m, ToSources a) =>
ReaderOptions -> a -> m Pandoc
readMarkdown ReaderOptions
rops)
(forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Pandoc -> m Text
writeHtml5String WriterOptions
wops)
Text
txt
markdownToHTMLWithOpts'
:: (FromJSON a)
=> ReaderOptions
-> WriterOptions
-> T.Text
-> Action a
markdownToHTMLWithOpts' :: forall a.
FromJSON a =>
ReaderOptions -> WriterOptions -> Text -> Action a
markdownToHTMLWithOpts' ReaderOptions
rops WriterOptions
wops Text
txt =
ReaderOptions -> WriterOptions -> Text -> Action Value
markdownToHTMLWithOpts ReaderOptions
rops WriterOptions
wops Text
txt forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall a b. (FromJSON a, ToJSON a, FromJSON b) => a -> Action b
convert
orgModeToHTML :: T.Text
-> Action Value
orgModeToHTML :: Text -> Action Value
orgModeToHTML Text
txt =
ReaderOptions -> WriterOptions -> Text -> Action Value
orgModeToHTMLWithOpts ReaderOptions
defaultOrgModeOptions WriterOptions
defaultHtml5Options Text
txt
orgModeToHTML' :: (FromJSON a)
=> T.Text
-> Action a
orgModeToHTML' :: forall a. FromJSON a => Text -> Action a
orgModeToHTML' Text
txt =
Text -> Action Value
orgModeToHTML Text
txt forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall a b. (FromJSON a, ToJSON a, FromJSON b) => a -> Action b
convert
orgModeToHTMLWithOpts
:: ReaderOptions
-> WriterOptions
-> T.Text
-> Action Value
orgModeToHTMLWithOpts :: ReaderOptions -> WriterOptions -> Text -> Action Value
orgModeToHTMLWithOpts ReaderOptions
rops WriterOptions
wops Text
txt =
forall textType.
PandocReader textType -> PandocWriter -> textType -> Action Value
loadUsing
(forall (m :: * -> *) a.
(PandocMonad m, ToSources a) =>
ReaderOptions -> a -> m Pandoc
readOrg ReaderOptions
rops)
(forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Pandoc -> m Text
writeHtml5String WriterOptions
wops)
Text
txt
orgModeToHTMLWithOpts'
:: (FromJSON a)
=> ReaderOptions
-> WriterOptions
-> T.Text
-> Action a
orgModeToHTMLWithOpts' :: forall a.
FromJSON a =>
ReaderOptions -> WriterOptions -> Text -> Action a
orgModeToHTMLWithOpts' ReaderOptions
rops WriterOptions
wops Text
txt =
ReaderOptions -> WriterOptions -> Text -> Action Value
orgModeToHTMLWithOpts ReaderOptions
rops WriterOptions
wops Text
txt forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall a b. (FromJSON a, ToJSON a, FromJSON b) => a -> Action b
convert
makePandocReader :: PandocReader textType
-> textType
-> Action (Pandoc, Value)
makePandocReader :: forall textType.
PandocReader textType -> textType -> Action (Pandoc, Value)
makePandocReader PandocReader textType
readerFunc textType
text =
forall textType.
PandocReader textType
-> PandocWriter -> textType -> Action (Pandoc, Value)
makePandocReaderWithMetaWriter PandocReader textType
readerFunc (forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Pandoc -> m Text
writePlain forall a. Default a => a
def) textType
text
makePandocReaderWithMetaWriter
:: PandocReader textType
-> PandocWriter
-> textType
-> Action (Pandoc, Value)
makePandocReaderWithMetaWriter :: forall textType.
PandocReader textType
-> PandocWriter -> textType -> Action (Pandoc, Value)
makePandocReaderWithMetaWriter PandocReader textType
readerFunc PandocWriter
writerFunc textType
text = do
pdoc :: Pandoc
pdoc@(Pandoc Meta
meta [Block]
_) <- forall a. PandocIO a -> Action a
unPandocM forall a b. (a -> b) -> a -> b
$ PandocReader textType
readerFunc textType
text
Value
meta' <- PandocWriter -> Meta -> Action Value
flattenMeta PandocWriter
writerFunc Meta
meta
forall (m :: * -> *) a. Monad m => a -> m a
return (Pandoc
pdoc, Value
meta')
makePandocReader'
:: (FromJSON a)
=> PandocReader textType
-> textType
-> Action (Pandoc, a)
makePandocReader' :: forall a textType.
FromJSON a =>
PandocReader textType -> textType -> Action (Pandoc, a)
makePandocReader' PandocReader textType
readerFunc textType
text =
forall a textType.
FromJSON a =>
PandocReader textType
-> PandocWriter -> textType -> Action (Pandoc, a)
makePandocReaderWithMetaWriter' PandocReader textType
readerFunc (forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Pandoc -> m Text
writePlain forall a. Default a => a
def) textType
text
makePandocReaderWithMetaWriter'
:: (FromJSON a)
=> PandocReader textType
-> PandocWriter
-> textType
-> Action (Pandoc, a)
makePandocReaderWithMetaWriter' :: forall a textType.
FromJSON a =>
PandocReader textType
-> PandocWriter -> textType -> Action (Pandoc, a)
makePandocReaderWithMetaWriter' PandocReader textType
readerFunc PandocWriter
writerFunc textType
text = do
(Pandoc
pdoc, Value
meta) <- forall textType.
PandocReader textType
-> PandocWriter -> textType -> Action (Pandoc, Value)
makePandocReaderWithMetaWriter PandocReader textType
readerFunc PandocWriter
writerFunc textType
text
a
convertedMeta <- forall a b. (FromJSON a, ToJSON a, FromJSON b) => a -> Action b
convert Value
meta
forall (m :: * -> *) a. Monad m => a -> m a
return (Pandoc
pdoc, a
convertedMeta)
loadUsingMeta :: PandocReader textType
-> PandocWriter
-> PandocWriter
-> textType
-> Action Value
loadUsingMeta :: forall textType.
PandocReader textType
-> PandocWriter -> PandocWriter -> textType -> Action Value
loadUsingMeta PandocReader textType
reader PandocWriter
writer PandocWriter
metaWriter textType
text = do
(Pandoc
pdoc, Value
meta) <- forall textType.
PandocReader textType
-> PandocWriter -> textType -> Action (Pandoc, Value)
makePandocReaderWithMetaWriter PandocReader textType
reader PandocWriter
metaWriter textType
text
Text
outText <- forall a. PandocIO a -> Action a
unPandocM forall a b. (a -> b) -> a -> b
$ PandocWriter
writer Pandoc
pdoc
Value
withContent <- case Value
meta of
Object Object
m -> forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. Object -> Value
Object forall a b. (a -> b) -> a -> b
$ forall v. Key -> v -> KeyMap v -> KeyMap v
KM.insert Key
"content" (Text -> Value
String Text
outText) Object
m
Value
_ -> forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Failed to parse metadata"
forall (m :: * -> *) a. Monad m => a -> m a
return Value
withContent
loadUsing :: PandocReader textType
-> PandocWriter
-> textType
-> Action Value
loadUsing :: forall textType.
PandocReader textType -> PandocWriter -> textType -> Action Value
loadUsing PandocReader textType
reader PandocWriter
writer textType
text = forall textType.
PandocReader textType
-> PandocWriter -> PandocWriter -> textType -> Action Value
loadUsingMeta PandocReader textType
reader PandocWriter
writer PandocWriter
writer textType
text
loadUsing' :: (FromJSON a)
=> PandocReader textType
-> PandocWriter
-> textType
-> Action a
loadUsing' :: forall a textType.
FromJSON a =>
PandocReader textType -> PandocWriter -> textType -> Action a
loadUsing' PandocReader textType
reader PandocWriter
writer textType
text =
forall textType.
PandocReader textType -> PandocWriter -> textType -> Action Value
loadUsing PandocReader textType
reader PandocWriter
writer textType
text forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall a b. (FromJSON a, ToJSON a, FromJSON b) => a -> Action b
convert
flattenMeta :: PandocWriter -> Meta -> Action Value
flattenMeta :: PandocWriter -> Meta -> Action Value
flattenMeta PandocWriter
writer (Meta Map Text MetaValue
meta) = forall a. ToJSON a => a -> Value
toJSON forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse MetaValue -> Action Value
go Map Text MetaValue
meta
where
go :: MetaValue -> Action Value
go :: MetaValue -> Action Value
go (MetaMap Map Text MetaValue
m) = forall a. ToJSON a => a -> Value
toJSON forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse MetaValue -> Action Value
go Map Text MetaValue
m
go (MetaList [MetaValue]
m) = forall a. ToJSON a => [a] -> Value
toJSONList forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse MetaValue -> Action Value
go [MetaValue]
m
go (MetaBool Bool
m) = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a. ToJSON a => a -> Value
toJSON Bool
m
go (MetaString Text
m) = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a. ToJSON a => a -> Value
toJSON Text
m
go (MetaInlines [Inline]
m) = forall a. ToJSON a => a -> Value
toJSON forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall a. PandocIO a -> Action a
unPandocM forall b c a. (b -> c) -> (a -> b) -> a -> c
. PandocWriter
writer forall b c a. (b -> c) -> (a -> b) -> a -> c
. Meta -> [Block] -> Pandoc
Pandoc forall a. Monoid a => a
mempty forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a. a -> [a] -> [a]
:[]) forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Inline] -> Block
Plain forall a b. (a -> b) -> a -> b
$ [Inline]
m)
go (MetaBlocks [Block]
m) = forall a. ToJSON a => a -> Value
toJSON forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall a. PandocIO a -> Action a
unPandocM forall b c a. (b -> c) -> (a -> b) -> a -> c
. PandocWriter
writer forall b c a. (b -> c) -> (a -> b) -> a -> c
. Meta -> [Block] -> Pandoc
Pandoc forall a. Monoid a => a
mempty forall a b. (a -> b) -> a -> b
$ [Block]
m)