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