module Tree (
      Tree(..)
    , Structure(..)
  ) where

data Structure = Leaf | Node [(String, Structure)]

class Functor a => Tree a where
  getStructure :: a String -> Structure

  draw :: Show b => a b -> String
  draw = unlines . getLines . getStructure . fmap show

getLines :: Structure -> [String]
getLines Leaf = ["╼"]
getLines (Node []) = [""]
getLines (Node [(s, structure)]) = showBlock '─' (s, structure)
getLines (Node ((s, structure):pairs)) = concat $
  showBlock '┬' (s, structure) : showBlocks pairs

showBlocks :: [(String, Structure)] -> [[String]]
showBlocks [] = []
showBlocks [(s, structure)] = [showBlock '╰' (s, structure)]
showBlocks ((s, structure):pairs) =
  showBlock '├' (s, structure) : showBlocks pairs

showBlock :: Char -> (String, Structure) -> [String]
showBlock connectingChar (s, structure) =
  case getLines structure of
    [] -> []
    firstLine:otherLines -> (prefix ++ firstLine) : (pad <$> otherLines)
  where
    connect = ((if connectingChar `elem` "├┬" then '│' else ' '):)
    prefix = connectingChar : " " ++ s ++ " "
    pad = connect . (take (length prefix - 1) (repeat ' ') ++)