content: {-# LANGUAGE OverloadedStrings   #-}
  {-# LANGUAGE ScopedTypeVariables #-}
  {- |
     Module      : Text.Pandoc.Writers.Djot
     Copyright   : Copyright (C) 2024 John MacFarlane
     License     : GNU GPL, version 2 or above
  
     Maintainer  : John MacFarlane <jgm@berkeley.edu>
     Stability   : alpha
     Portability : portable
  
  Conversion of 'Pandoc' format into Djot markup (<https://djot.net>).
  -}
  module Text.Pandoc.Writers.Djot (
      writeDjot
    ) where
  import Text.Pandoc.Definition
  import Text.Pandoc.Logging
  import Text.Pandoc.Class ( PandocMonad , report )
  import Text.Pandoc.Options ( WriterOptions(..), WrapOption(..))
  import Data.Text (Text)
  import Data.Set (Set)
  import qualified Data.Set as Set
  import qualified Data.ByteString as B
  import qualified Data.ByteString.Char8 as B8
  import Data.List (intersperse)
  import qualified Data.Text as T
  import qualified Data.Map as M
  import qualified Text.Pandoc.UTF8 as UTF8
  import Text.Pandoc.Writers.Shared ( metaToContext, defField, toLegacyTable )
  import Text.Pandoc.Shared (isTightList, tshow, stringify, onlySimpleTableCells,
                             makeSections)
  import Text.DocLayout
  import Text.DocTemplates (renderTemplate)
  
  import Control.Monad.State (StateT(..), gets, modify)
  import Control.Monad (zipWithM, when)
  import Data.Maybe (fromMaybe)
  import qualified Djot.AST as D
  import Djot (renderDjot, RenderOptions(..), toIdentifier)
  import Text.Pandoc.UTF8 (fromText)
  
  -- | Convert Pandoc to Djot.
  writeDjot :: PandocMonad m => WriterOptions -> Pandoc -> m Text
  writeDjot opts (Pandoc meta blocks) = do
    let colwidth = if writerWrapText opts == WrapAuto
                      then Just $ writerColumns opts
                      else Nothing
    let ropts = RenderOptions{ preserveSoftBreaks =
                                 writerWrapText opts == WrapPreserve }
    metadata <- metaToContext opts
                 (fmap (renderDjot ropts) . bodyToDjot opts)
                 (fmap (chomp . renderDjot ropts) . bodyToDjot opts .
                    (:[]) . Plain)
                 meta
    main <- renderDjot ropts <$>
              bodyToDjot opts (makeSections False Nothing blocks)
    let context  = defField "body" main metadata
    return $ render colwidth $
      case writerTemplate opts of
         Nothing  -> main
         Just tpl -> renderTemplate tpl context
  
  data DjotState =
    DjotState
    { footnotes :: D.NoteMap
    , references :: D.ReferenceMap
    , autoReferences :: D.ReferenceMap
    , autoIds :: Set B.ByteString
    , options :: WriterOptions }
  
  bodyToDjot :: PandocMonad m => WriterOptions -> [Block] -> m D.Doc
  bodyToDjot opts bls = do
    (bs, st) <- runStateT (blocksToDjot bls)
                 (DjotState mempty mempty mempty mempty opts)
    let D.ReferenceMap autos = autoReferences st
    let D.ReferenceMap refs = references st
    pure $ D.Doc{ D.docBlocks = bs
                , D.docFootnotes = footnotes st
                , D.docReferences = D.ReferenceMap $ M.difference refs autos
                , D.docAutoReferences = D.ReferenceMap autos
                , D.docAutoIdentifiers = autoIds st
                }
  
  blocksToDjot :: PandocMonad m => [Block] -> StateT DjotState m D.Blocks
  blocksToDjot = fmap mconcat . mapM blockToDjot
  
  blockToDjot :: PandocMonad m => Block -> StateT DjotState m D.Blocks
  blockToDjot (Para ils) = D.para <$> inlinesToDjot ils
  blockToDjot (Plain ils) = D.para <$> inlinesToDjot ils
  blockToDjot (LineBlock ls) =
    D.para . mconcat . intersperse D.hardBreak <$> mapM inlinesToDjot ls
  blockToDjot (CodeBlock attr@(_,_,kvs) t) = do
    let lang = fromMaybe mempty $ lookup "lang" kvs
    pure $ D.addAttr (toDjotAttr attr)
         <$> D.codeBlock (fromText lang) (fromText t)
  blockToDjot (RawBlock (Format f) t) =
    pure $ D.rawBlock (D.Format (fromText f)) (fromText t)
  blockToDjot (BlockQuote bls) = D.blockQuote <$> blocksToDjot bls
  blockToDjot (Header lev attr ils) =
    fmap (D.addAttr (toDjotAttr attr)) . D.heading lev <$> inlinesToDjot ils
  blockToDjot HorizontalRule = pure D.thematicBreak
  blockToDjot (Div (ident,"section":cls,kvs)
                (Header lev (_,hcls,hkvs) ils : bls)) = do
    ilsBs <- D.inlinesToByteString <$> inlinesToDjot ils
    let ident' = toIdentifier ilsBs
    let label = D.normalizeLabel ilsBs
    let autoid = UTF8.toText ident' == ident
    when autoid $
      modify $ \st -> st{ autoIds = Set.insert ident' (autoIds st) }
    modify $ \st -> st{ autoReferences = D.insertReference label
                            (B8.cons '#' ident', mempty) (autoReferences st) }
    fmap
      (D.addAttr (toDjotAttr (if autoid then "" else ident,
                           filter (/= "section") cls,
                           filter (\(k,_) -> k /= "wrapper") kvs) <>
                  toDjotAttr ("", [c | c <- hcls, c `notElem` cls], hkvs)))
           . D.section
       <$> blocksToDjot (Header lev mempty ils : bls)
  blockToDjot (Div attr@(ident,cls,kvs) bls)
    | Just "1" <- lookup "wrapper" kvs
      = fmap (D.addAttr
               (toDjotAttr (ident,cls,filter (\(k,_) -> k /= "wrapper") kvs)))
         <$> blocksToDjot bls
    | otherwise
      = fmap (D.addAttr (toDjotAttr attr)) . D.div <$> blocksToDjot bls
  blockToDjot (BulletList items) =
    D.bulletList spacing <$> mapM blocksToDjot items
   where
     spacing = if isTightList items then D.Tight else D.Loose
  blockToDjot (OrderedList (start, sty, delim) items) =
    D.orderedList listAttr spacing <$> mapM blocksToDjot items
   where
     spacing = if isTightList items then D.Tight else D.Loose
     listAttr = D.OrderedListAttributes {
                  D.orderedListStyle =
                    case sty of
                      DefaultStyle -> D.Decimal
                      Example -> D.Decimal
                      Decimal -> D.Decimal
                      LowerRoman -> D.RomanLower
                      UpperRoman -> D.RomanUpper
                      LowerAlpha -> D.LetterLower
                      UpperAlpha -> D.LetterUpper,
                  D.orderedListDelim =
                      case delim of
                        DefaultDelim -> D.RightPeriod
                        Period -> D.RightPeriod
                        OneParen -> D.RightParen
                        TwoParens -> D.LeftRightParen,
                  D.orderedListStart = start }
  blockToDjot (DefinitionList items) =
    D.definitionList spacing <$> mapM toDLItem items
   where
     spacing = if isTightList (map (concat . snd) items)
                  then D.Tight
                  else D.Loose
     toDLItem (term, defs) = do
       term' <- inlinesToDjot term
       def' <- mconcat <$> mapM blocksToDjot defs
       pure (term', def')
  blockToDjot (Figure attr (Caption _ capt) bls) = do
    content <- blocksToDjot bls
    caption <- fmap (D.addAttr (D.Attr [("class","caption")])) . D.div <$>
                 blocksToDjot capt
    pure $ fmap (D.addAttr (toDjotAttr attr)) $ D.div $ content <> caption
  blockToDjot (Table attr capt' colspecs thead tbodies tfoot) = do
    let (capt, aligns, _, headRow, bodyRows) =
          toLegacyTable capt' colspecs thead tbodies tfoot
    if onlySimpleTableCells (headRow : bodyRows)
       then do
         let alignToAlign al = case al of
                                 AlignDefault -> D.AlignDefault
                                 AlignLeft -> D.AlignLeft
                                 AlignRight -> D.AlignRight
                                 AlignCenter -> D.AlignCenter
         let defAligns = map alignToAlign aligns
         let cellToCell isHeader bls al =
               D.Cell (if isHeader then D.HeadCell else D.BodyCell) al
                 <$> case bls of
                       [Para ils] -> inlinesToDjot ils
                       [Plain ils] -> inlinesToDjot ils
                       [] -> pure mempty
                       bs -> do
                         mapM_ (report . BlockNotRendered) bs
                         pure $ D.str "((omitted))"
         let rowToRow isHeader cells = zipWithM (cellToCell isHeader) cells defAligns
         hrows <- if null headRow
                     then pure []
                     else (:[]) <$> rowToRow True headRow
         rows <- mapM (rowToRow False) bodyRows
         caption <- case capt of
                         [] -> pure Nothing
                         _ -> Just . D.Caption . D.para <$> inlinesToDjot capt
         pure $ D.addAttr (toDjotAttr attr) <$> D.table caption (hrows <> rows)
       else do -- table can't be represented as a simple pipe table, use list
         tableList <- D.bulletList D.Loose <$> mapM
                       (fmap (D.bulletList D.Loose) . mapM blocksToDjot)
                        (headRow:bodyRows)
         pure $ D.addAttr (D.Attr [("class", "table")]) <$> tableList
  
  inlinesToDjot :: PandocMonad m => [Inline] -> StateT DjotState m D.Inlines
  inlinesToDjot = fmap mconcat . mapM inlineToDjot
  
  inlineToDjot :: PandocMonad m => Inline -> StateT DjotState m D.Inlines
  inlineToDjot (Str t) = pure $ D.str (fromText t)
  inlineToDjot Space = pure $ D.str " "
  inlineToDjot SoftBreak = pure D.softBreak
  inlineToDjot LineBreak = pure D.hardBreak
  inlineToDjot (Emph ils) = D.emph <$> inlinesToDjot ils
  inlineToDjot (Underline ils) =
    fmap (D.addAttr (D.Attr [("class","underline")])) . D.span_
      <$> inlinesToDjot ils
  inlineToDjot (Strong ils) = D.strong <$> inlinesToDjot ils
  inlineToDjot (Strikeout ils) = D.delete <$> inlinesToDjot ils
  inlineToDjot (Subscript ils) = D.subscript <$> inlinesToDjot ils
  inlineToDjot (Superscript ils) = D.superscript <$> inlinesToDjot ils
  inlineToDjot (Span ("",["mark"],[]) ils) = D.highlight <$> inlinesToDjot ils
  inlineToDjot (Span attr@(ident,cls,kvs) ils)
    | Just "1" <- lookup "wrapper" kvs
      = fmap (D.addAttr
              (toDjotAttr (ident,cls,filter (\(k,_) -> k /= "wrapper") kvs)))
         <$> inlinesToDjot ils
    | otherwise
      = fmap (D.addAttr (toDjotAttr attr)) . D.span_ <$> inlinesToDjot ils
  inlineToDjot (SmallCaps ils) =
    fmap (D.addAttr (D.Attr [("class","smallcaps")])) . D.span_
      <$> inlinesToDjot ils
  inlineToDjot (Quoted DoubleQuote ils) = D.doubleQuoted <$> inlinesToDjot ils
  inlineToDjot (Quoted SingleQuote ils) = D.singleQuoted <$> inlinesToDjot ils
  inlineToDjot (Cite _cs ils) = inlinesToDjot ils
  inlineToDjot (Code attr t) =
    pure $ D.addAttr (toDjotAttr attr) <$> D.verbatim (fromText t)
  inlineToDjot (Math mt t) =
    pure $ (if mt == InlineMath
               then D.inlineMath
               else D.displayMath) (fromText t)
  inlineToDjot (RawInline (Format f) t) =
    pure $ D.rawInline (D.Format (fromText f)) (fromText t)
  inlineToDjot (Link attr ils (src,tit)) = do
    opts <- gets options
    description <- inlinesToDjot ils
    let ilstring = stringify ils
    let autolink = ilstring == src
    let email = ("mailto:" <> ilstring) == src
    let removeClass name (ident, cls, kvs) = (ident, filter (/= name) cls, kvs)
    let attr' = D.Attr [("title", fromText tit) | not (T.null tit)] <>
                 toDjotAttr ( (if autolink
                                  then removeClass "uri"
                                  else id) .
                              (if email
                                  then removeClass "email"
                                  else id) $ attr)
    case () of
      _ | autolink -> pure $ D.addAttr attr' <$> D.urlLink (fromText ilstring)
        | email -> pure $ D.addAttr attr' <$> D.emailLink (fromText ilstring)
        | writerReferenceLinks opts
          -> do refs@(D.ReferenceMap m) <- gets references
                autoRefs <- gets autoReferences
                let lab' = D.inlinesToByteString description
                lab <- case D.lookupReference lab' (refs <> autoRefs) of
                         Just _ -> pure lab'
                         Nothing -> do
                           let refnum = M.size m + 1
                           let lab = fromText $ tshow refnum
                           modify $ \st -> st{ references =
                                                 D.insertReference lab
                                                   (fromText src, attr') refs }
                           pure lab
                pure $ D.addAttr attr' <$> D.link description (D.Reference lab)
        | otherwise
           -> pure $ D.addAttr attr' <$> D.link description (D.Direct (fromText src))
  inlineToDjot (Image attr ils (src,tit)) = do
    opts <- gets options
    description <- inlinesToDjot ils
    let attr' = D.Attr [("title", fromText tit) | not (T.null tit)] <>
                  toDjotAttr attr
    if writerReferenceLinks opts
       then do
         refs@(D.ReferenceMap m) <- gets references
         let refnum = M.size m + 1
         let lab = fromText $ tshow refnum
         modify $ \st -> st{ references =
                               D.insertReference lab
                                 (fromText src, attr') refs }
         pure $ D.addAttr attr' <$> D.image description (D.Reference lab)
       else pure $ D.addAttr attr' <$> D.image description (D.Direct (fromText src))
  inlineToDjot (Note bs) = do
    notes@(D.NoteMap m) <- gets footnotes
    let notenum = M.size m + 1
    let lab = fromText $ tshow notenum
    contents <- blocksToDjot bs
    modify $ \st -> st{ footnotes = D.insertNote lab contents notes }
    pure $ D.footnoteReference lab
  
  toDjotAttr :: (Text, [Text], [(Text, Text)]) -> D.Attr
  toDjotAttr (ident, classes, kvs) =
    D.Attr $ [("id", fromText ident) | not (T.null ident)] ++
             [("class", fromText (T.unwords classes)) | not (null classes)] ++
             map (\(k,v) -> (fromText k, fromText v)) kvs
  