36 lines
1.1 KiB
Haskell
36 lines
1.1 KiB
Haskell
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 ' ') ++)
|