{-# LANGUAGE OverloadedRecordDot #-}

module Zettel.Transclusion where

import Data.Map.Strict ((!?))
import qualified Data.Text as T
import Text.Pandoc.Definition (Block (..), Inline (..), Pandoc (..))
import Text.Pandoc.Walk (walk)
import Zettel.Common
import Zettel.Types

parseTranscludeBlock :: Text -> ZettelId
parseTranscludeBlock t = parseLink link
  where
    link = T.takeWhile (']' /=) $ T.dropWhile ('[' /=) t

transcludeRawBlockWith' :: (ZettelId -> [Block]) -> Block -> [Block]
transcludeRawBlockWith' f r@(RawBlock t c)
  | t == "org" = f $ parseTranscludeBlock c
  | otherwise = [r]
transcludeRawBlockWith' _ p = [p]

transcludeRawBlockWith :: (ZettelId -> [Block]) -> [Block] -> [Block]
transcludeRawBlockWith f = concatMap (transcludeRawBlockWith' f)

transcludeRawBlock :: Block -> Block
transcludeRawBlock r@(RawBlock t c)
  | t == "org" =
      RawBlock "org-zk-transclude" . unZettelId $ parseTranscludeBlock c
  | otherwise = r
transcludeRawBlock p = p

markdownIdFormat :: ZettelId -> Text
markdownIdFormat (ZettelId d) =
  "{{< transclude zettel=\"" <> d <> "\" >}}"

transcludeToMarkdownLink :: Block -> Block
transcludeToMarkdownLink r@(RawBlock t c)
  | t == "org" = Para [Str . markdownIdFormat $ parseTranscludeBlock c]
  | otherwise = r
transcludeToMarkdownLink p = p

transclude :: Pandoc -> Pandoc
transclude = walk transcludeRawBlock

transcludeMdLink :: Pandoc -> Pandoc
transcludeMdLink = walk transcludeToMarkdownLink

wrapTransclude :: Int -> ZettelId -> [Block] -> [Block]
wrapTransclude depth zid b =
  [Para [RawInline "markdown" $ "{{< transclude-" <> show depth <> " zettel=\"" <> unZettelId zid <> "\" >}}"]]
    <> b
    <> [Para [RawInline "markdown" $ "{{< /transclude-" <> show depth <> " >}}"]]

transcludeMd :: ZettelGraph -> Int -> Pandoc -> Pandoc
transcludeMd zg depth = walk (transcludeRawBlockWith f)
  where
    f ident =
      concatMap
        ( (\(Pandoc _ b) -> wrapTransclude depth ident b)
            . transcludeMd zg (depth + 1)
            . zettelBody
        )
        . toList
        $ zg.unZettelGraph !? ident

transcludeMdZettel :: ZettelGraph -> Zettel -> Zettel
transcludeMdZettel zg zettel =
  zettel {zettelBody = transcludeMd zg 1 zettel.zettelBody}

transcludeMdAll :: ZettelGraph -> ZettelGraph
transcludeMdAll zg =
  ZettelGraph . fmap (transcludeMdZettel zg) $ unZettelGraph zg