module OutlineTree where

import Data.Bifunctor (first)
import Data.Bool (bool)
import Data.Char (isSpace)
import Data.List (find, intercalate)
import Data.Tree (Tree (..), foldTree, levels)



wikiTablesFromOutline :: [String] -> String -> String
wikiTablesFromOutline colorSwatch outline =
  intercalate "\n\n" $
    wikiTableFromTree colorSwatch
      <$> ( forestFromLineIndents
              . indentLevelsFromLines
              . lines
          )
        outline

wikiTableFromTree :: [String] -> Tree String -> String
wikiTableFromTree colorSwatch =
  wikiTableFromRows
    . levels
    . paintedTree colorSwatch
    . widthLabelledTree
    . (paddedTree "" <*> treeDepth)


main :: IO ()
main =
  ( putStrLn
      . wikiTablesFromOutline
        [ "#ffffe6",
          "#ffebd2",
          "#f0fff0",
          "#e6ffff",
          "#ffeeff"
        ]
  )
    "Display an outline as a nested table.\n\
    \    Parse the outline to a tree,\n\
    \        measuring the indent of each line,\n\
    \        translating the indentation to a nested structure,\n\
    \        and padding the tree to even depth.\n\
    \    count the leaves descending from each node,\n\
    \        defining the width of a leaf as 1,\n\
    \        and the width of a parent node as a sum.\n\
    \            (The sum of the widths of its children)\n\
    \    and write out a table with 'colspan' values\n\
    \        either as a wiki table,\n\
    \        or as HTML."



forestFromLineIndents :: [(Int, String)] -> [Tree String]
forestFromLineIndents = go
  where
    go [] = []
    go ((n, s): xs) =
      let (subOutline, rest) = span ((n <) . fst) xs
       in Node s (go subOutline): go rest

indentLevelsFromLines :: [String] -> [(Int, String)]
indentLevelsFromLines xs =
  let pairs = first length . span isSpace <$> xs
      indentUnit = maybe 1 fst (find ((0 <) . fst) pairs)
   in first (`div` indentUnit) <$> pairs



paddedTree :: a -> Tree a -> Int -> Tree a
paddedTree padValue = go
  where
    go tree n
      | 1 >= n = tree
      | otherwise =
        Node
          (rootLabel tree)
          ( (`go` pred n)
              <$> bool nest [Node padValue []] (null nest)
          )
      where
        nest = subForest tree

treeDepth :: Tree a -> Int
treeDepth = foldTree go
  where
    go _ [] = 1
    go _ xs = (succ . maximum) xs



widthLabelledTree :: Tree a -> Tree (a, Int)
widthLabelledTree = foldTree go
  where
    go x [] = Node (x, 1) []
    go x xs =
      Node
        (x, foldr ((+) . snd . rootLabel) 0 xs)
        xs



paintedTree :: [String] -> Tree a -> Tree (String, a)
paintedTree [] tree = fmap ("",) tree
paintedTree (color: colors) tree =
  Node
    (color, rootLabel tree)
    ( zipWith
        (fmap . (,))
        (cycle colors)
        (subForest tree)
    )



wikiTableFromRows :: [[(String, (String, Int))]] -> String
wikiTableFromRows rows =
  let wikiRow = unlines . fmap cellText
      cellText (color, (txt, width))
        | null txt = "| |"
        | otherwise =
          "| "
            <> cw color width
            <> "| "
            <> txt
      cw color width =
        let go w
              | 1 < w = " colspan=" <> show w
              | otherwise = ""
         in "style=\"background:"
              <> color
              <> "; \""
              <> go width
              <> " "
   in "{| class=\"wikitable\" "
        <> "style=\"text-align: center;\"\n|-\n"
        <> intercalate "|-\n" (wikiRow <$> rows)
        <> "|}"