packages feed

zwirn-0.2.3.1: app/zwirnmill/Docs/Draw.hs

{- HLINT ignore "Use tuple-section" -}
module Docs.Draw where

import Brick (ViewportType (..), Widget (..), hBox, textWidth)
import Brick.Types (Location (..), VScrollBarOrientation (..))
import Brick.Widgets.Core (clickable, translateBy, txt, vBox, viewport, withAttr, withVScrollBars)
import Data.Bifunctor (second)
import Data.List (intersperse, mapAccumL)
import qualified Data.Map as Map
import qualified Data.Text as T
import Docs.Markdown
import Docs.Util
import Editor.Draw (renderTokens, tokenizeLine)
import UI.Attributes (attrCurrentLink, attrDocCode, attrDocEmph, attrDocStrong, attrLink)
import UI.Core (Doc (..), DocBlock (..), DocFocus (..), DocInline (..), DocMap, DocStyle (..), Name (..))

drawDoc :: (Int, Int) -> Doc -> DocFocus -> Widget Name
drawDoc (sx, _) (Doc ds) c = withVScrollBars OnRight $ viewport DocViewport Vertical $ vBox $ intersperse (txt "\n") $ snd $ mapAccumL (drawDocBlock (sx - 3) c) (0, 0) ds

drawDocBlock :: Int -> DocFocus -> (Int, Int) -> DocBlock -> ((Int, Int), Widget Name)
drawDocBlock sx c (i, j) (Paragraph is) = ((i, j + x), vBox ps)
  where
    (x, ps) = drawParagraph c j sx is
drawDocBlock _ c (i, j) (CodeBlock t) = ((i + 1, j), drawCodeBlock c i t)

drawCodeBlock :: DocFocus -> Int -> T.Text -> Widget Name
drawCodeBlock c i t = clickable (DocCode i) block
  where
    ls = T.lines t
    tok =
      if currentCodeBlock c i
        then
          renderTokens . tokenizeLine (Just (0, 0)) (length ls, 0) 0 []
        else renderTokens . tokenizeLine Nothing (1, -1) (-1) []
    block = translateBy (Location (2, 0)) $ vBox $ map tok ls

drawParagraph :: DocFocus -> Int -> Int -> [DocInline] -> (Int, [Widget Name])
drawParagraph cur ln maxwd ds = case drawParagraphLine cur ln maxwd 0 [] ds of
  (ln', _, ws, []) -> (ln', [hBox ws])
  (ln', _, ws, rs) -> second (hBox ws :) $ drawParagraph cur ln' maxwd rs

drawParagraphLine :: DocFocus -> Int -> Int -> Int -> [Widget Name] -> [DocInline] -> (Int, Int, [Widget Name], [DocInline])
drawParagraphLine _ ln _ wd ps [] = (ln, wd, ps, [])
drawParagraphLine _ ln _ wd ps (Linebreak : ds) = (ln, wd, ps, ds)
drawParagraphLine cur ln maxwd wd ps (TextChunk t s : ds) =
  if wd + curWd > maxwd
    then
      if curWd >= maxwd
        then (ln, wd + curWd, ps ++ [withDocStyle s $ txt t], ds)
        else (ln, wd + curWd, ps, TextChunk t s : ds)
    else drawParagraphLine cur ln maxwd (wd + curWd) (ps ++ [withDocStyle s $ txt t]) ds
  where
    curWd = textWidth t
drawParagraphLine cur ln maxwd wd ps (Link t d : ds) =
  if wd + curWd > maxwd
    then
      if curWd >= maxwd
        then (ln + 1, wd + curWd, ps ++ [linkAttr ln $ txt t], ds)
        else (ln, wd + curWd, ps, Link t d : ds)
    else drawParagraphLine cur (ln + 1) maxwd (wd + curWd) (ps ++ [linkAttr ln $ txt t]) ds
  where
    curWd = textWidth t
    linkAttr x = clickable (DocLink ln) . if currentLink cur x then withAttr attrCurrentLink else withAttr attrLink

withDocStyle :: DocStyle -> (Widget n -> Widget n)
withDocStyle Normal = id
withDocStyle Strong = withAttr attrDocStrong
withDocStyle Emph = withAttr attrDocEmph
withDocStyle Code = withAttr attrDocCode

example :: Doc
example = case parseDoc "Welcome to the Zwirn Documentation!\n This is another line.\n\n Here is a new paragraph. \n Here is a workking [link](other)\n\n\n and another [link](lololol)\n\n\n```\n1 $: s \"kick\"\n  # speed 2\n```" of
  Left _ -> Doc []
  Right x -> x

example2 :: Doc
example2 = case parseDoc "This is another example page in the documentation.\n [This](start) links back to the other page." of
  Left _ -> Doc []
  Right x -> x

exampleMap :: DocMap
exampleMap = Map.fromList [("start", example), ("other", example2)]