--------------------------------------------------------------------------------
-- | Module exporting convenient pandoc bindings
module Hakyll.Web.Pandoc
    ( -- * The basic building blocks
      readPandoc
    , readPandocWith
    , writePandoc
    , writePandocWith
    , renderPandoc
    , renderPandocWith
    , renderPandocWithTransform
    , renderPandocWithTransformM

      -- * Derived compilers
    , pandocCompiler
    , pandocCompilerWith
    , pandocCompilerWithTransform
    , pandocCompilerWithTransformM

      -- * Default options
    , defaultHakyllReaderOptions
    , defaultHakyllWriterOptions
    ) where


--------------------------------------------------------------------------------
import qualified Data.Text                  as T
import           Text.Pandoc
import           Text.Pandoc.Highlighting   (pygments)


--------------------------------------------------------------------------------
import           Hakyll.Core.Compiler
import           Hakyll.Core.Item
import           Hakyll.Web.Pandoc.FileType


--------------------------------------------------------------------------------
-- | Read a string using pandoc, with the default options
readPandoc
    :: Item String             -- ^ String to read
    -> Compiler (Item Pandoc)  -- ^ Resulting document
readPandoc :: Item String -> Compiler (Item Pandoc)
readPandoc = ReaderOptions -> Item String -> Compiler (Item Pandoc)
readPandocWith ReaderOptions
defaultHakyllReaderOptions


--------------------------------------------------------------------------------
-- | Read a string using pandoc, with the supplied options
readPandocWith
    :: ReaderOptions           -- ^ Parser options
    -> Item String             -- ^ String to read
    -> Compiler (Item Pandoc)  -- ^ Resulting document
readPandocWith :: ReaderOptions -> Item String -> Compiler (Item Pandoc)
readPandocWith ReaderOptions
ropt Item String
item =
    case PandocPure (Item Pandoc) -> Either PandocError (Item Pandoc)
forall a. PandocPure a -> Either PandocError a
runPure (PandocPure (Item Pandoc) -> Either PandocError (Item Pandoc))
-> PandocPure (Item Pandoc) -> Either PandocError (Item Pandoc)
forall a b. (a -> b) -> a -> b
$ (Text -> PandocPure Pandoc)
-> Item Text -> PandocPure (Item Pandoc)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (ReaderOptions -> FileType -> Text -> PandocPure Pandoc
forall (m :: * -> *).
PandocMonad m =>
ReaderOptions -> FileType -> Text -> m Pandoc
reader ReaderOptions
ropt (Item String -> FileType
forall a. Item a -> FileType
itemFileType Item String
item)) ((String -> Text) -> Item String -> Item Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap String -> Text
T.pack Item String
item) of
        Left PandocError
err    -> String -> Compiler (Item Pandoc)
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Compiler (Item Pandoc))
-> String -> Compiler (Item Pandoc)
forall a b. (a -> b) -> a -> b
$
            String
"Hakyll.Web.Pandoc.readPandocWith: parse failed: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ PandocError -> String
forall a. Show a => a -> String
show PandocError
err
        Right Item Pandoc
item' -> Item Pandoc -> Compiler (Item Pandoc)
forall (m :: * -> *) a. Monad m => a -> m a
return Item Pandoc
item'
  where
    reader :: ReaderOptions -> FileType -> Text -> m Pandoc
reader ReaderOptions
ro FileType
t = case FileType
t of
        FileType
DocBook            -> ReaderOptions -> Text -> m Pandoc
forall (m :: * -> *).
PandocMonad m =>
ReaderOptions -> Text -> m Pandoc
readDocBook ReaderOptions
ro
        FileType
Html               -> ReaderOptions -> Text -> m Pandoc
forall (m :: * -> *).
PandocMonad m =>
ReaderOptions -> Text -> m Pandoc
readHtml ReaderOptions
ro
        FileType
LaTeX              -> ReaderOptions -> Text -> m Pandoc
forall (m :: * -> *).
PandocMonad m =>
ReaderOptions -> Text -> m Pandoc
readLaTeX ReaderOptions
ro
        LiterateHaskell FileType
t' -> ReaderOptions -> FileType -> Text -> m Pandoc
reader (ReaderOptions -> Extension -> ReaderOptions
addExt ReaderOptions
ro Extension
Ext_literate_haskell) FileType
t'
        FileType
Markdown           -> ReaderOptions -> Text -> m Pandoc
forall (m :: * -> *).
PandocMonad m =>
ReaderOptions -> Text -> m Pandoc
readMarkdown ReaderOptions
ro
        FileType
MediaWiki          -> ReaderOptions -> Text -> m Pandoc
forall (m :: * -> *).
PandocMonad m =>
ReaderOptions -> Text -> m Pandoc
readMediaWiki ReaderOptions
ro
        FileType
OrgMode            -> ReaderOptions -> Text -> m Pandoc
forall (m :: * -> *).
PandocMonad m =>
ReaderOptions -> Text -> m Pandoc
readOrg ReaderOptions
ro
        FileType
Rst                -> ReaderOptions -> Text -> m Pandoc
forall (m :: * -> *).
PandocMonad m =>
ReaderOptions -> Text -> m Pandoc
readRST ReaderOptions
ro
        FileType
Textile            -> ReaderOptions -> Text -> m Pandoc
forall (m :: * -> *).
PandocMonad m =>
ReaderOptions -> Text -> m Pandoc
readTextile ReaderOptions
ro
        FileType
_                  -> String -> Text -> m Pandoc
forall a. HasCallStack => String -> a
error (String -> Text -> m Pandoc) -> String -> Text -> m Pandoc
forall a b. (a -> b) -> a -> b
$
            String
"Hakyll.Web.readPandocWith: I don't know how to read a file of " String -> String -> String
forall a. [a] -> [a] -> [a]
++
            String
"the type " String -> String -> String
forall a. [a] -> [a] -> [a]
++ FileType -> String
forall a. Show a => a -> String
show FileType
t String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" for: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Identifier -> String
forall a. Show a => a -> String
show (Item String -> Identifier
forall a. Item a -> Identifier
itemIdentifier Item String
item)

    addExt :: ReaderOptions -> Extension -> ReaderOptions
addExt ReaderOptions
ro Extension
e = ReaderOptions
ro {readerExtensions :: Extensions
readerExtensions = Extension -> Extensions -> Extensions
enableExtension Extension
e (Extensions -> Extensions) -> Extensions -> Extensions
forall a b. (a -> b) -> a -> b
$ ReaderOptions -> Extensions
readerExtensions ReaderOptions
ro}


--------------------------------------------------------------------------------
-- | Write a document (as HTML) using pandoc, with the default options
writePandoc :: Item Pandoc  -- ^ Document to write
            -> Item String  -- ^ Resulting HTML
writePandoc :: Item Pandoc -> Item String
writePandoc = WriterOptions -> Item Pandoc -> Item String
writePandocWith WriterOptions
defaultHakyllWriterOptions


--------------------------------------------------------------------------------
-- | Write a document (as HTML) using pandoc, with the supplied options
writePandocWith :: WriterOptions  -- ^ Writer options for pandoc
                -> Item Pandoc    -- ^ Document to write
                -> Item String    -- ^ Resulting HTML
writePandocWith :: WriterOptions -> Item Pandoc -> Item String
writePandocWith WriterOptions
wopt (Item Identifier
itemi Pandoc
doc) =
    case PandocPure Text -> Either PandocError Text
forall a. PandocPure a -> Either PandocError a
runPure (PandocPure Text -> Either PandocError Text)
-> PandocPure Text -> Either PandocError Text
forall a b. (a -> b) -> a -> b
$ WriterOptions -> Pandoc -> PandocPure Text
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Pandoc -> m Text
writeHtml5String WriterOptions
wopt Pandoc
doc of
        Left PandocError
err    -> String -> Item String
forall a. HasCallStack => String -> a
error (String -> Item String) -> String -> Item String
forall a b. (a -> b) -> a -> b
$ String
"Hakyll.Web.Pandoc.writePandocWith: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ PandocError -> String
forall a. Show a => a -> String
show PandocError
err
        Right Text
item' -> Identifier -> String -> Item String
forall a. Identifier -> a -> Item a
Item Identifier
itemi (String -> Item String) -> String -> Item String
forall a b. (a -> b) -> a -> b
$ Text -> String
T.unpack Text
item'


--------------------------------------------------------------------------------
-- | Render the resource using pandoc
renderPandoc :: Item String -> Compiler (Item String)
renderPandoc :: Item String -> Compiler (Item String)
renderPandoc =
    ReaderOptions
-> WriterOptions -> Item String -> Compiler (Item String)
renderPandocWith ReaderOptions
defaultHakyllReaderOptions WriterOptions
defaultHakyllWriterOptions


--------------------------------------------------------------------------------
-- | Render the resource using pandoc
renderPandocWith
    :: ReaderOptions -> WriterOptions -> Item String -> Compiler (Item String)
renderPandocWith :: ReaderOptions
-> WriterOptions -> Item String -> Compiler (Item String)
renderPandocWith ReaderOptions
ropt WriterOptions
wopt Item String
item =
    WriterOptions -> Item Pandoc -> Item String
writePandocWith WriterOptions
wopt (Item Pandoc -> Item String)
-> Compiler (Item Pandoc) -> Compiler (Item String)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ReaderOptions -> Item String -> Compiler (Item Pandoc)
readPandocWith ReaderOptions
ropt Item String
item


--------------------------------------------------------------------------------
-- | An extension of `renderPandocWith`, which allows you to specify a custom
-- Pandoc transformation on the input `Item`.
-- Useful if you want to do your own transformations before running 
-- custom Pandoc transformations, e.g. using a `funcField` to transform raw content.
renderPandocWithTransform :: ReaderOptions -> WriterOptions
                    -> (Pandoc -> Pandoc)
                    -> Item String
                    -> Compiler (Item String)
renderPandocWithTransform :: ReaderOptions
-> WriterOptions
-> (Pandoc -> Pandoc)
-> Item String
-> Compiler (Item String)
renderPandocWithTransform ReaderOptions
ropt WriterOptions
wopt Pandoc -> Pandoc
f = 
    ReaderOptions
-> WriterOptions
-> (Pandoc -> Compiler Pandoc)
-> Item String
-> Compiler (Item String)
renderPandocWithTransformM ReaderOptions
ropt WriterOptions
wopt (Pandoc -> Compiler Pandoc
forall (m :: * -> *) a. Monad m => a -> m a
return (Pandoc -> Compiler Pandoc)
-> (Pandoc -> Pandoc) -> Pandoc -> Compiler Pandoc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Pandoc -> Pandoc
f) 


--------------------------------------------------------------------------------
-- | Similar to `renderPandocWithTransform`, but the Pandoc transformation is
-- monadic. This is useful when you want the pandoc
-- transformation to use the `Compiler` information such as routes,
-- metadata, etc. along with your own transformations beforehand.
renderPandocWithTransformM :: ReaderOptions -> WriterOptions
                    -> (Pandoc -> Compiler Pandoc)
                    -> Item String
                    -> Compiler (Item String)
renderPandocWithTransformM :: ReaderOptions
-> WriterOptions
-> (Pandoc -> Compiler Pandoc)
-> Item String
-> Compiler (Item String)
renderPandocWithTransformM ReaderOptions
ropt WriterOptions
wopt Pandoc -> Compiler Pandoc
f Item String
i = 
    WriterOptions -> Item Pandoc -> Item String
writePandocWith WriterOptions
wopt (Item Pandoc -> Item String)
-> Compiler (Item Pandoc) -> Compiler (Item String)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((Pandoc -> Compiler Pandoc)
-> Item Pandoc -> Compiler (Item Pandoc)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse Pandoc -> Compiler Pandoc
f (Item Pandoc -> Compiler (Item Pandoc))
-> Compiler (Item Pandoc) -> Compiler (Item Pandoc)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< ReaderOptions -> Item String -> Compiler (Item Pandoc)
readPandocWith ReaderOptions
ropt Item String
i) 


--------------------------------------------------------------------------------
-- | Read a page render using pandoc
pandocCompiler :: Compiler (Item String)
pandocCompiler :: Compiler (Item String)
pandocCompiler =
    ReaderOptions -> WriterOptions -> Compiler (Item String)
pandocCompilerWith ReaderOptions
defaultHakyllReaderOptions WriterOptions
defaultHakyllWriterOptions


--------------------------------------------------------------------------------
-- | A version of 'pandocCompiler' which allows you to specify your own pandoc
-- options
pandocCompilerWith :: ReaderOptions -> WriterOptions -> Compiler (Item String)
pandocCompilerWith :: ReaderOptions -> WriterOptions -> Compiler (Item String)
pandocCompilerWith ReaderOptions
ropt WriterOptions
wopt =
    String -> Compiler (Item String) -> Compiler (Item String)
forall a.
(Binary a, Typeable a) =>
String -> Compiler a -> Compiler a
cached String
"Hakyll.Web.Pandoc.pandocCompilerWith" (Compiler (Item String) -> Compiler (Item String))
-> Compiler (Item String) -> Compiler (Item String)
forall a b. (a -> b) -> a -> b
$
        ReaderOptions
-> WriterOptions -> (Pandoc -> Pandoc) -> Compiler (Item String)
pandocCompilerWithTransform ReaderOptions
ropt WriterOptions
wopt Pandoc -> Pandoc
forall a. a -> a
id


--------------------------------------------------------------------------------
-- | An extension of 'pandocCompilerWith' which allows you to specify a custom
-- pandoc transformation for the content
pandocCompilerWithTransform :: ReaderOptions -> WriterOptions
                            -> (Pandoc -> Pandoc)
                            -> Compiler (Item String)
pandocCompilerWithTransform :: ReaderOptions
-> WriterOptions -> (Pandoc -> Pandoc) -> Compiler (Item String)
pandocCompilerWithTransform ReaderOptions
ropt WriterOptions
wopt Pandoc -> Pandoc
f =
    ReaderOptions
-> WriterOptions
-> (Pandoc -> Compiler Pandoc)
-> Compiler (Item String)
pandocCompilerWithTransformM ReaderOptions
ropt WriterOptions
wopt (Pandoc -> Compiler Pandoc
forall (m :: * -> *) a. Monad m => a -> m a
return (Pandoc -> Compiler Pandoc)
-> (Pandoc -> Pandoc) -> Pandoc -> Compiler Pandoc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Pandoc -> Pandoc
f)


--------------------------------------------------------------------------------
-- | Similar to 'pandocCompilerWithTransform', but the transformation
-- function is monadic. This is useful when you want the pandoc
-- transformation to use the 'Compiler' information such as routes,
-- metadata, etc
pandocCompilerWithTransformM :: ReaderOptions -> WriterOptions
                    -> (Pandoc -> Compiler Pandoc)
                    -> Compiler (Item String)
pandocCompilerWithTransformM :: ReaderOptions
-> WriterOptions
-> (Pandoc -> Compiler Pandoc)
-> Compiler (Item String)
pandocCompilerWithTransformM ReaderOptions
ropt WriterOptions
wopt Pandoc -> Compiler Pandoc
f = 
    Compiler (Item String)
getResourceBody Compiler (Item String)
-> (Item String -> Compiler (Item String))
-> Compiler (Item String)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ReaderOptions
-> WriterOptions
-> (Pandoc -> Compiler Pandoc)
-> Item String
-> Compiler (Item String)
renderPandocWithTransformM ReaderOptions
ropt WriterOptions
wopt Pandoc -> Compiler Pandoc
f


--------------------------------------------------------------------------------
-- | The default reader options for pandoc parsing in hakyll
defaultHakyllReaderOptions :: ReaderOptions
defaultHakyllReaderOptions :: ReaderOptions
defaultHakyllReaderOptions = ReaderOptions
forall a. Default a => a
def
    { -- The following option causes pandoc to read smart typography, a nice
      -- and free bonus.
      readerExtensions :: Extensions
readerExtensions = Extension -> Extensions -> Extensions
enableExtension Extension
Ext_smart Extensions
pandocExtensions
    }


--------------------------------------------------------------------------------
-- | The default writer options for pandoc rendering in hakyll
defaultHakyllWriterOptions :: WriterOptions
defaultHakyllWriterOptions :: WriterOptions
defaultHakyllWriterOptions = WriterOptions
forall a. Default a => a
def
    { -- This option causes literate haskell to be written using '>' marks in
      -- html, which I think is a good default.
      writerExtensions :: Extensions
writerExtensions = Extension -> Extensions -> Extensions
enableExtension Extension
Ext_smart Extensions
pandocExtensions
    , -- We want to have hightlighting by default, to be compatible with earlier
      -- Hakyll releases
      writerHighlightStyle :: Maybe Style
writerHighlightStyle = Style -> Maybe Style
forall a. a -> Maybe a
Just Style
pygments
    }