{- This file is part of Vervis.
 -
 - Written in 2016, 2018, 2019, 2022 by fr33domlover <fr33domlover@riseup.net>.
 -
 - ♡ Copying is an act of love. Please copy, reuse and share.
 -
 - The author(s) have dedicated all copyright and related and neighboring
 - rights to this software to the public domain worldwide. This software is
 - distributed without any warranty.
 -
 - You should have received a copy of the CC0 Public Domain Dedication along
 - with this software. If not, see
 - <http://creativecommons.org/publicdomain/zero/1.0/>.
 -}

{-# Language CPP #-}

-- | Tools for rendering repository file contents and other source files.
--
-- There are several ways to render a file:
--
-- (1) As a source file, plain text and with line numbers
-- (2) As a source file, syntax highlighted and with line numbers
-- (3) As a plain text document
-- (4) As a document rendered to HTML, e.g. Markdown is a popular format
-- (5) As a document rendered to a custom format, e.g. presentation
--
-- The difference between 3 and 5 is line numbers and font (3 would use regular
-- text font, while 5 would use monospaced font).
--
-- At the time of writing, not all rendering modes are implemented. The current
-- status, assuming I'm keeping it updated, is:
--
-- (1) Partially implemented: No line numbers
-- (2) Implemented, using line numbers generated by @highlighter2@ formatter
-- (3) Not implemented
-- (4) Not implemented
-- (5) Not implmented
module Yesod.RenderSource
    ( renderSourceT
    , renderSourceBL
    , renderPandocMarkdown
    , renderPrettyJSON
    , renderPrettyJSON'
    , renderPrettyJSONSkylighting
    , renderPrettyJSONSkylighting'
    )
where

import Control.Exception
import Control.Monad.Catch (throwM)
import Control.Monad.Logger (logDebug, logWarn)
import Data.Aeson
import Data.Foldable (for_)
import Data.Maybe (fromMaybe)
import Data.Monoid ((<>))
import Data.Text (Text)
--import Formatting hiding (format)
import Skylighting
import Text.Blaze.Html (preEscapedToMarkup)
import Text.Blaze.Html.Renderer.Text (renderHtml)
import Text.Highlighter (lexerFromFilename, runLexer, Lexer (lName))
import Text.Highlighter.Formatters.Html (format)
import Text.HTML.SanitizeXSS (sanitizeBalance)
import Text.Pandoc.Class (runPure)
import Text.Pandoc.Definition (Pandoc)
import Text.Pandoc.Highlighting
import Text.Pandoc.Options
import Text.Pandoc.Readers.Markdown
import Text.Pandoc.Writers.HTML
import Yesod.Core.Widget

import qualified Data.ByteString as B
import qualified Data.ByteString.Lazy as BL
import qualified Data.Map.Strict as M
import qualified Data.Text as T
import qualified Data.Text.Encoding as TE
import qualified Data.Text.Encoding.Error as TE
import qualified Data.Text.Lazy as TL
import qualified Data.Text.Lazy.Builder as TLB
import qualified Data.Text.Lazy.Encoding as TLE
import qualified Text.Highlighter.Lexers.DarcsPatch as L.DarcsPatch
import qualified Text.Highlighter.Lexers.Diff as L.Diff
import qualified Text.Highlighter.Lexers.Haskell as L.Haskell
import qualified Text.Highlighter.Lexers.Javascript as L.JS

import Data.Aeson.Encode.Pretty.ToEncoding
import Data.MediaType

-- * File uploads and wiki attachments
-- * Wiki pages
-- * READMEs
-- * Source files which happen to be documents, e.g. Markdown, manpages,
--   OrgMode, LaTeX, and
-- * Literate Haskell files
--
-- For now, let's ignore the first two. Which source files, README or other, do
-- we want to offer to display as HTML rendering?
--
-- * [ ] native
-- * [ ] json
-- * [x] markdown
-- * [ ] markdown_strict
-- * [ ] markdown_phpextra
-- * [ ] markdown_github
-- * [ ] markdown_mmd
-- * [ ] commonmark
-- * [ ] rst
-- * [ ] mediawiki
-- * [ ] docbook
-- * [ ] opml
-- * [ ] org
-- * [ ] textile
-- * [ ] html
-- * [ ] latex
-- * [ ] haddock
-- * [ ] twiki
-- * [ ] docx
-- * [ ] odt
-- * [ ] t2t
-- * [ ] epub
--
-- Any others not in this list, maybe using other libraries?
--
-- * [ ] asciidoc
-- * [ ] groff manpage

renderPlain :: TL.Text -> WidgetFor site ()
renderPlain content =
    [whamlet|
        <pre>
            <code>#{content}
    |]

renderHighlight :: Lexer -> B.ByteString -> Maybe (WidgetFor site ())
renderHighlight lexer content =
    case runLexer lexer content of
        Left err     -> Nothing
        Right tokens -> Just $ toWidget $ format True tokens

renderCode :: Lexer -> TL.Text -> B.ByteString -> WidgetFor site ()
renderCode lexer contentTL contentB =
    fromMaybe (renderPlain contentTL) $ renderHighlight lexer contentB

readerOptions :: ReaderOptions
readerOptions = def
    { readerExtensions            = pandocExtensions
    , readerStandalone            = False
    , readerColumns               = 80
    , readerTabStop               = 4
--  , readerIndentedCodeClasses   = []
--  , readerAbbreviations         = defaultAbbrevs
--  , readerDefaultImageExtension = ""
--  , readerTrackChanges          = AcceptChanges
--  , readerStripComments         = False
    }

writerOptions :: WriterOptions
writerOptions = def
    {
--    writerTemplate          = Nothing
--  , writerVariables         = []
      writerTabStop           = 4
    , writerTableOfContents   = True
--  , writerIncremental       = False
--  , writerHTMLMathMethod    = PlainMath
--  , writerNumberSections    = False
--  , writerNumberOffset      = [0,0,0,0,0,0]
--  , writerSectionDivs       = False
    , writerExtensions        = pandocExtensions
--  , writerReferenceLinks    = False
--  , writerDpi               = 96
    , writerWrapText          = WrapAuto
    , writerColumns           = 79
    , writerEmailObfuscation  = ReferenceObfuscation
--  , writerIdentifierPrefix  = ""
--  , writerCiteMethod        = Citeproc
--  , writerHtmlQTags         = False
--  , writerSlideLevel        = Nothing
--  , writerTopLevelDivision  = TopLevelDefault
--  , writerListings          = False
    , writerHighlightStyle    = Just tango
--  , writerSetextHeaders     = True
--  , writerEpubSubdirectory  = "EPUB"
--  , writerEpubMetadata      = Nothing
--  , writerEpubFonts         = []
--  , writerEpubChapterLevel  = 1
--  , writerTOCDepth          = 3
--  , writerReferenceDoc      = Nothing
--  , writerReferenceLocation = EndOfDocument
--  , writerSyntaxMap         = defaultSyntaxMap
    }

renderPandoc :: Pandoc -> WidgetFor site ()
renderPandoc
    = either throwM toWidget
    . fmap
        ( preEscapedToMarkup
        . sanitizeBalance
        . TL.toStrict
        . renderHtml
        )
    . runPure
    . writeHtml5 writerOptions

renderSourceT :: MediaType -> Text -> WidgetFor site ()
renderSourceT mt contentT =
    let contentB = TE.encodeUtf8 contentT
        contentTL = TL.fromStrict contentT
    in  renderSource mt contentB contentTL contentT

renderSourceBL :: MediaType -> BL.ByteString -> WidgetFor site ()
renderSourceBL mt contentBL =
    let contentB = BL.toStrict contentBL
        contentTL = TLE.decodeUtf8With TE.lenientDecode contentBL
        contentT = TL.toStrict contentTL
    in  renderSource mt contentB contentTL contentT

renderSource
    :: MediaType -> B.ByteString -> TL.Text -> Text -> WidgetFor site ()
renderSource mt contentB contentTL contentT =
    let mtName = T.pack $ show mt

        failed e =
            "Failed to parse " <> mtName <> "content: " <> T.pack (show e)

        -- Plain text with line numbers
        plain = renderPlain contentTL
        -- Syntax highlighted source code with line numbers
        code l = renderCode l contentTL contentB
        -- Rendered document from Text source
        docT r =
            case runPure $ r readerOptions contentT of
                Left err  -> $logWarn (failed err) >> plain
                Right doc -> renderPandoc doc
    in  case mt of
            -- * Documents
            PlainText -> plain
            Markdown  -> docT readMarkdown
            -- * Programming languages
            -- ** Haskell
            Haskell   -> code L.Haskell.lexer
            -- * Development files
            Diff      -> code L.Diff.lexer
            DarcsPatch -> code L.DarcsPatch.lexer
            -- * Misc
            _         -> plain

renderPandocMarkdown :: Text -> Either Text Text
renderPandocMarkdown input =
    case parse input of
        Left err ->
            Left $
                "Failed to parse Markdown: " <> T.pack (displayException err)
        Right doc ->
            case render doc of
                Left err ->
                    Left $
                        "Failed to render Markdown: " <>
                        T.pack (displayException err)
                Right output -> Right output
    where
    parse = runPure . readMarkdown readerOptions
    render
        = fmap (sanitizeBalance . TL.toStrict . renderHtml)
        . runPure
        . writeHtml5 writerOptions

renderPrettyJSON :: ToJSON a => a -> WidgetFor site ()
renderPrettyJSON = renderPrettyJSON' . encodePretty

renderPrettyJSON' :: BL.ByteString -> WidgetFor site ()
renderPrettyJSON' prettyBL =
    let prettyB = BL.toStrict prettyBL
        prettyTL = TLE.decodeUtf8 prettyBL
    in  renderCode L.JS.lexer prettyTL prettyB

renderPrettyJSONSkylighting' :: BL.ByteString -> WidgetFor site ()
renderPrettyJSONSkylighting' prettyBL =
    case tokenizeJSON prettyBL of
        Left e -> error $ "Tokenizing JSON failed: " ++ e
        Right sls -> do
            toWidgetHead $ CssBuilder $ TLB.fromString $ styleToCss zenburn
            toWidget $ formatHtmlBlock options sls
    where
    tokenizeJSON = tokenize config jsonSyntax . TE.decodeUtf8 . BL.toStrict
        where
        syntaxMap = defaultSyntaxMap
        jsonSyntax =
            case M.lookup "JSON" syntaxMap of
                Nothing -> error "Skylighting JSON syntax not found"
                Just s -> s
        config = TokenizerConfig syntaxMap False
    options = defaultFormatOpts { numberLines = True }

renderPrettyJSONSkylighting :: ToJSON a => a -> WidgetFor site ()
renderPrettyJSONSkylighting = renderPrettyJSONSkylighting' . encodePretty