{-# LANGUAGE FlexibleContexts #-}

module SitePipe.Readers
  (
  -- * Built-in readers
    markdownReader
  , textReader

  -- * Reader Generators
  , mkPandocReader
  , mkPandocReaderWith
  , readMarkdown

  -- * Pandoc Writers
  , 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)

-- | Given any standard pandoc reader (see "Text.Pandoc"; e.g. 'readMarkdown', 'readDocX')
-- makes a resource reader compatible with 'SitePipe.Files.resourceLoader'.
--
-- > docs <- resourceLoader (mkPandocReader readDocX) ["docs/*.docx"]
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

-- | Like `mkPandocReader`, but allows you to provide both a @'Pandoc' -> 'Pandoc'@ transformation,
-- which is great for things like relativizing links or running transforms over specific document elements.
-- See https://hackage.haskell.org/package/pandoc-lens for some useful tranformation helpers. You also specify
-- the tranformation from @Pandoc -> String@ which allows you to pick the output format of the reader.
-- If you're unsure what to use in this slot, the pandocToHTML function is a good choice.
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

-- | A simple helper which renders pandoc to HTML; good for use with 'mkPandocReaderWith'
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

-- | Runs the Pandoc reader handling errors.
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

-- | Reads markdown files into html
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

-- | Reads text files without processing
textReader :: String -> PandocIO String
textReader :: String -> PandocIO String
textReader = String -> PandocIO String
forall (f :: * -> *) a. Applicative f => a -> f a
pure