{-|
Module      : Slick.Pandoc
Description : Slick utilities for working with Pandoc
Copyright   : (c) Chris Penner, 2019
License     : BSD3
-}
{-# 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

-- | Reasonable options for reading a markdown file. Behaves similar to Github Flavoured
-- Markdown
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
     ]

-- | Reasonable options for rendering to HTML. Includes default code highlighting rules
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
      }

-- | Reasonable options for reading an org-mode file
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
       ]
     ]
--------------------------------------------------------------------------------

-- | Handle possible pandoc failure within the Action Monad
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

-- | Convert markdown text into a 'Value';
--
--   The 'Value'  has a "content" key containing rendered HTML.
--
--   Metadata is assigned on the respective keys in the 'Value'
markdownToHTML :: T.Text
               -> Action Value
markdownToHTML :: Text -> Action Value
markdownToHTML Text
txt =
    ReaderOptions -> WriterOptions -> Text -> Action Value
markdownToHTMLWithOpts ReaderOptions
defaultMarkdownOptions WriterOptions
defaultHtml5Options Text
txt

-- | Like 'markdownToHTML' but allows returning any JSON serializable object
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

-- | Like 'markdownToHTML' but allows providing additional pandoc reader and writer options
markdownToHTMLWithOpts
    :: ReaderOptions  -- ^ Pandoc reader options to specify extensions or other functionality
    -> WriterOptions  -- ^ Pandoc writer options to modify output
    -> T.Text         -- ^ Text for conversion
    -> 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

-- | Like 'markdownToHTMLWithOpts' but returns any JSON serializable object.
markdownToHTMLWithOpts'
    :: (FromJSON a)
    => ReaderOptions  -- ^ Pandoc reader options to specify extensions or other functionality
    -> WriterOptions  -- ^ Pandoc writer options to modify output
    -> T.Text         -- ^ Text for conversion
    -> 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

-- | Convert org-mode text into a 'Value';
--
--   The 'Value'  has a "content" key containing rendered HTML.
--
--   Metadata is assigned on the respective keys in the 'Value'
orgModeToHTML :: T.Text
               -> Action Value
orgModeToHTML :: Text -> Action Value
orgModeToHTML Text
txt =
    ReaderOptions -> WriterOptions -> Text -> Action Value
orgModeToHTMLWithOpts ReaderOptions
defaultOrgModeOptions WriterOptions
defaultHtml5Options Text
txt

-- | Like 'orgModeToHTML' but allows returning any JSON compatible object.
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

-- | Like 'orgModeToHTML' but allows providing additional pandoc reader and writer options
orgModeToHTMLWithOpts
    :: ReaderOptions  -- ^ Pandoc reader options to specify extensions or other functionality
    -> WriterOptions  -- ^ Pandoc writer options to modify output
    -> T.Text         -- ^ Text for conversion
    -> 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

-- | Like 'orgModeToHTMLWithOpts' but allows returning any JSON compatible object
orgModeToHTMLWithOpts'
    :: (FromJSON a)
    => ReaderOptions  -- ^ Pandoc reader options to specify extensions or other functionality
    -> WriterOptions  -- ^ Pandoc writer options to modify output
    -> T.Text         -- ^ Text for conversion
    -> 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

-- | Given a reader from 'Text.Pandoc.Readers' this creates a loader which
--   given the source document will read its metadata into a 'Value'
--   returning both the 'Pandoc' object and the metadata within an 'Action'.
--   The metadata values will be read as Markdown but rendered as plain text,
--   removing any links, pictures, and inline formatting.
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

-- | Given a reader from 'Text.Pandoc.Readers', and a writer from
--   'Text.Pandoc.Writers', this creates a loader which given the source
--   document will read its metadata as Markdown, then render it into a
--   'Value' using the writer, returning both the 'Pandoc' object and the
--   metadata within an 'Action'
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')

-- | Like 'makePandocReader' but will deserialize the metadata
--   into any object which implements 'FromJSON'. Failure to deserialize will
--   fail the Shake build. Metadata values will be read as Markdown but
--   rendered as plain text, removing any links, pictures, and inline
--   formatting.
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

-- | Like 'makePandocReaderWithMetaWriter' but will deserialize the metadata
--   into any object which implements 'FromJSON'. Failure to deserialize will
--   fail the Shake build.
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)

--------------------------------------------------------------------------------

-- | Load in a source document using the given 'PandocReader', then render the 'Pandoc'
--   into text using the given 'PandocWriter'. Takes a second 'PandocWriter' to render
--   metadata.
--   Returns a 'Value' wherein the rendered text is set to the "content" key and
--   any metadata is set to its respective key in the 'Value'
loadUsingMeta :: PandocReader textType -- ^ The reader used to load the document
          -> PandocWriter -- ^ The writer used to render the document itself
          -> PandocWriter -- ^ The writer used to process metadata.
          -> 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
          -- meta & _Object . at "content" ?~ String outText
      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

-- | Load in a source document using the given 'PandocReader', then render the 'Pandoc'
--   into text using the given 'PandocWriter'.
--   Returns a 'Value' wherein the rendered text is set to the "content" key and
--   any metadata is set to its respective key in the 'Value'
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

-- | Like 'loadUsing' but allows also deserializes the 'Value' into any object
--   which implements 'FromJSON'.  Failure to deserialize will fail the Shake
--   build.
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

--------------------------------------------------------------------------------

-- | Flatten a Pandoc 'Meta' into a well-structured JSON object, rendering Pandoc
--   text objects into plain strings along the way.
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)