{-# LANGUAGE FlexibleContexts #-}
module SitePipe.Readers
(
markdownReader
, textReader
, mkPandocReader
, mkPandocReaderWith
, readMarkdown
, pandocToHTML
) where
import Control.Monad.Trans.Except
import Control.Monad.Trans.State
import Control.Monad.Catch
import Text.Pandoc
import Text.Pandoc.Options
import Text.Pandoc.Highlighting
import Data.Text (pack, unpack)
mkPandocReader :: (ReaderOptions -> String -> PandocIO Pandoc) -> String -> IO String
mkPandocReader :: (ReaderOptions -> String -> PandocIO Pandoc) -> String -> IO String
mkPandocReader ReaderOptions -> String -> PandocIO Pandoc
pReader = (ReaderOptions -> String -> PandocIO Pandoc)
-> (Pandoc -> PandocIO Pandoc)
-> (Pandoc -> PandocIO String)
-> String
-> IO String
mkPandocReaderWith ReaderOptions -> String -> PandocIO Pandoc
pReader Pandoc -> PandocIO Pandoc
forall (f :: * -> *) a. Applicative f => a -> f a
pure Pandoc -> PandocIO String
pandocToHTML
mkPandocReaderWith :: (ReaderOptions -> String -> PandocIO Pandoc) -> (Pandoc -> PandocIO Pandoc) -> (Pandoc -> PandocIO String) -> String -> IO String
mkPandocReaderWith :: (ReaderOptions -> String -> PandocIO Pandoc)
-> (Pandoc -> PandocIO Pandoc)
-> (Pandoc -> PandocIO String)
-> String
-> IO String
mkPandocReaderWith ReaderOptions -> String -> PandocIO Pandoc
pReader Pandoc -> PandocIO Pandoc
transformer Pandoc -> PandocIO String
writer String
content =
PandocIO String -> IO String
forall a. PandocIO a -> IO a
runPandoc (PandocIO String -> IO String) -> PandocIO String -> IO String
forall a b. (a -> b) -> a -> b
$ Pandoc -> PandocIO String
writer
(Pandoc -> PandocIO String) -> PandocIO Pandoc -> PandocIO String
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Pandoc -> PandocIO Pandoc
transformer
(Pandoc -> PandocIO Pandoc) -> PandocIO Pandoc -> PandocIO Pandoc
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< ReaderOptions -> String -> PandocIO Pandoc
pReader ReaderOptions
forall a. Default a => a
def{readerExtensions :: Extensions
readerExtensions = Extensions
githubMarkdownExtensions}
String
content
pandocToHTML :: Pandoc -> PandocIO String
pandocToHTML :: Pandoc -> PandocIO String
pandocToHTML Pandoc
p = (Text -> String) -> PandocIO Text -> PandocIO String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Text -> String
unpack (PandocIO Text -> PandocIO String)
-> PandocIO Text -> PandocIO String
forall a b. (a -> b) -> a -> b
$ WriterOptions -> Pandoc -> PandocIO Text
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Pandoc -> m Text
writeHtml5String WriterOptions
forall a. Default a => a
def{writerHighlightStyle :: Maybe Style
writerHighlightStyle = Style -> Maybe Style
forall a. a -> Maybe a
Just Style
pygments} Pandoc
p
runPandoc :: PandocIO a -> IO a
runPandoc :: PandocIO a -> IO a
runPandoc PandocIO a
m = do
Either PandocError a
z <- (StateT CommonState IO (Either PandocError a)
-> CommonState -> IO (Either PandocError a))
-> CommonState
-> StateT CommonState IO (Either PandocError a)
-> IO (Either PandocError a)
forall a b c. (a -> b -> c) -> b -> a -> c
flip StateT CommonState IO (Either PandocError a)
-> CommonState -> IO (Either PandocError a)
forall (m :: * -> *) s a. Monad m => StateT s m a -> s -> m a
evalStateT CommonState
forall a. Default a => a
def (StateT CommonState IO (Either PandocError a)
-> IO (Either PandocError a))
-> StateT CommonState IO (Either PandocError a)
-> IO (Either PandocError a)
forall a b. (a -> b) -> a -> b
$ ExceptT PandocError (StateT CommonState IO) a
-> StateT CommonState IO (Either PandocError a)
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT (ExceptT PandocError (StateT CommonState IO) a
-> StateT CommonState IO (Either PandocError a))
-> ExceptT PandocError (StateT CommonState IO) a
-> StateT CommonState IO (Either PandocError a)
forall a b. (a -> b) -> a -> b
$ PandocIO a -> ExceptT PandocError (StateT CommonState IO) a
forall a.
PandocIO a -> ExceptT PandocError (StateT CommonState IO) a
unPandocIO PandocIO a
m
case Either PandocError a
z of
Left PandocError
e -> PandocError -> IO a
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM PandocError
e
Right a
a -> a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
a
markdownReader :: String -> IO String
markdownReader :: String -> IO String
markdownReader = (ReaderOptions -> String -> PandocIO Pandoc) -> String -> IO String
mkPandocReader ((ReaderOptions -> String -> PandocIO Pandoc)
-> String -> IO String)
-> (ReaderOptions -> String -> PandocIO Pandoc)
-> String
-> IO String
forall a b. (a -> b) -> a -> b
$ \ReaderOptions
ro String
s -> ReaderOptions -> Text -> PandocIO Pandoc
forall (m :: * -> *) a.
(PandocMonad m, ToSources a) =>
ReaderOptions -> a -> m Pandoc
readMarkdown ReaderOptions
ro (Text -> PandocIO Pandoc) -> Text -> PandocIO Pandoc
forall a b. (a -> b) -> a -> b
$ String -> Text
pack String
s
textReader :: String -> PandocIO String
textReader :: String -> PandocIO String
textReader = String -> PandocIO String
forall (f :: * -> *) a. Applicative f => a -> f a
pure