module Handler.Utils.Pandoc
  ( htmlField, htmlFieldSmall
  , htmlReaderOptions, markdownReaderOptions
  , markdownWriterOptions, htmlWriterOptions
  ) where

import Import.NoFoundation
import Handler.Utils.I18n

import qualified Data.Text as Text

import qualified Text.Pandoc as P

import Text.Blaze (preEscapedText)
import Text.Blaze.Html.Renderer.Text (renderHtml)
import Text.HTML.SanitizeXSS (sanitizeBalance)


data HtmlFieldKind
  = HtmlFieldNormal
  | HtmlFieldSmall
  deriving (Eq, Ord, Enum, Bounded, Read, Show, Generic, Typeable)
instance Universe HtmlFieldKind
instance Finite HtmlFieldKind

htmlField, htmlFieldSmall :: MonadLogger m => Field m Html
htmlField = htmlField' HtmlFieldNormal
htmlFieldSmall = htmlField' HtmlFieldSmall


htmlField' :: MonadLogger m => HtmlFieldKind -> Field m Html
htmlField' fieldKind = Field{..}
  where
    fieldEnctype = UrlEncoded
    
    fieldParse (t : _) _
      = return . fmap (assertM' $ not . null . renderHtml) . parseMarkdown $ Text.strip t
    fieldParse []     _ = return $ Right Nothing

    fieldView theId name attrs val isReq = do
      val' <- either return (maybeT (return mempty) . renderMarkdown) val
      let markdownExplanation = $(i18nWidgetFile "markdown-explanation")
      $(widgetFile "widgets/html-field")

parseMarkdown :: Text -> Either (SomeMessage site) Html
parseMarkdown text =
  bimap pandocError (preEscapedText . sanitizeBalance) . P.runPure $
    P.writeHtml5String htmlWriterOptions =<< P.readMarkdown markdownReaderOptions text
  where
    pandocError = SomeMessage . tshow

renderMarkdown :: (MonadLogger m, MonadPlus m) => Html -> m Text
renderMarkdown html =
  either (\e -> logPandocError e >> mzero) return . P.runPure $
    P.writeMarkdown markdownWriterOptions =<< P.readHtml htmlReaderOptions (toStrict $ renderHtml html)
  where
    logPandocError = $logErrorS "renderMarkdown" . tshow


htmlReaderOptions, markdownReaderOptions :: P.ReaderOptions
htmlReaderOptions = markdownReaderOptions
markdownReaderOptions = def
  { P.readerExtensions = P.pandocExtensions
      & P.enableExtension P.Ext_hard_line_breaks
      & P.enableExtension P.Ext_autolink_bare_uris
  , P.readerTabStop = 2
  }

markdownWriterOptions, htmlWriterOptions :: P.WriterOptions
markdownWriterOptions = def
  { P.writerExtensions = P.readerExtensions markdownReaderOptions
  , P.writerTabStop = P.readerTabStop markdownReaderOptions
  }
htmlWriterOptions = markdownWriterOptions