content: {-|
  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 =
    def { readerExtensions = exts }
    where
      exts = mconcat
       [ extensionsFromList
         [ Ext_yaml_metadata_block
         , Ext_fenced_code_attributes
         , Ext_auto_identifiers
         , Ext_footnotes
         ]
       , githubMarkdownExtensions
       ]
  
  -- | Reasonable options for rendering to HTML. Includes default code highlighting rules
  defaultHtml5Options :: WriterOptions
  defaultHtml5Options =
    def { writerHighlightMethod = Skylighting tango
        , writerExtensions     = writerExtensions def
        }
  
  -- | Reasonable options for reading an org-mode file
  defaultOrgModeOptions :: ReaderOptions
  defaultOrgModeOptions =
    def { readerExtensions = exts }
    where
      exts = mconcat
       [ extensionsFromList
         [ Ext_fenced_code_attributes
         , Ext_auto_identifiers
         ]
       ]
  --------------------------------------------------------------------------------
  
  -- | Handle possible pandoc failure within the Action Monad
  unPandocM :: PandocIO a -> Action a
  unPandocM p = do
    result <- liftIO $ runIO p
    either (fail . show) return 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 txt =
      markdownToHTMLWithOpts defaultMarkdownOptions defaultHtml5Options txt
  
  -- | Like 'markdownToHTML' but allows returning any JSON serializable object
  markdownToHTML' :: (FromJSON a)
                  => T.Text
                  -> Action a
  markdownToHTML' txt =
      markdownToHTML txt >>= 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 rops wops txt =
    loadUsing
      (readMarkdown rops)
      (writeHtml5String wops)
      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' rops wops txt =
      markdownToHTMLWithOpts rops wops txt >>= 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 txt =
      orgModeToHTMLWithOpts defaultOrgModeOptions defaultHtml5Options txt
  
  -- | Like 'orgModeToHTML' but allows returning any JSON compatible object.
  orgModeToHTML' :: (FromJSON a)
                 => T.Text
                 -> Action a
  orgModeToHTML' txt =
      orgModeToHTML txt >>= 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 rops wops txt =
    loadUsing
      (readOrg rops)
      (writeHtml5String wops)
      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' rops wops txt =
      orgModeToHTMLWithOpts rops wops txt >>= 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 readerFunc text =
    makePandocReaderWithMetaWriter readerFunc (writePlain def) 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 readerFunc writerFunc text = do
    pdoc@(Pandoc meta _) <- unPandocM $ readerFunc text
    meta' <- flattenMeta writerFunc meta
    return (pdoc, 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' readerFunc text =
    makePandocReaderWithMetaWriter' readerFunc (writePlain def) 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' readerFunc writerFunc text = do
    (pdoc, meta)  <- makePandocReaderWithMetaWriter readerFunc writerFunc text
    convertedMeta <- convert meta
    return (pdoc, 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 reader writer metaWriter text = do
    (pdoc, meta) <- makePandocReaderWithMetaWriter reader metaWriter text
    outText      <- unPandocM $ writer pdoc
    withContent <- case meta of
        Object m -> return . Object $ KM.insert "content" (String outText) m
            -- meta & _Object . at "content" ?~ String outText
        _ -> fail "Failed to parse metadata"
    return 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 reader writer text = loadUsingMeta reader writer writer 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' reader writer text =
    loadUsing reader writer text >>= 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 writer (Meta meta) = toJSON <$> traverse go meta
   where
    go :: MetaValue -> Action Value
    go (MetaMap     m) = toJSON <$> traverse go m
    go (MetaList    m) = toJSONList <$> traverse go m
    go (MetaBool    m) = pure $ toJSON m
    go (MetaString  m) = pure $ toJSON m
    go (MetaInlines m) = toJSON <$> (unPandocM . writer . Pandoc mempty . (:[]) . Plain $ m)
    go (MetaBlocks  m) = toJSON <$> (unPandocM . writer . Pandoc mempty $ m)
  