Use Text for drawTree

This commit is contained in:
George Thomas 2026-01-08 00:53:14 +00:00
parent 1de4fcd028
commit 31082a85d5
2 changed files with 8 additions and 7 deletions

View File

@ -23,7 +23,7 @@ main :: IO ()
main = do
-- terminalWidth <- Terminal.Size.width <<$>> Terminal.Size.size -- TODO this doesn't work in GHCID or GHCIWatch...
terminalWidth <- pure $ Just 62
putStrLn $ drawTree $ T.unpack <$> getTestTree tests
T.putStrLn $ drawTree $ getTestTree tests
TL.putStrLn . displayTestResultsConsole terminalWidth =<< runTests () tests
tests :: TestTree IO ()

View File

@ -184,18 +184,19 @@ adjacentPairs = \case
sortPair :: (Ord a) => (a, a) -> (a, a)
sortPair (a, b) = if a <= b then (a, b) else (b, a)
-- | This is `Data.Tree.drawTree` with the ASCII characters replaced with Unicode box drawing characters.
drawTree :: Tree String -> String
drawTree = unlines . draw
-- | This is `Data.Tree.drawTree` with the ASCII characters replaced with Unicode box drawing characters,
-- and using `Text` instead of `String`.
drawTree :: Tree Text -> Text
drawTree = T.unlines . draw
where
draw (Node x ts0) = lines x ++ drawSubTrees ts0
draw (Node x ts0) = T.lines x <> drawSubTrees ts0
where
drawSubTrees [] = []
drawSubTrees [t] =
"" : shift_ "└─ " " " (draw t)
drawSubTrees (t : ts) =
"" : shift_ "├─ " "" (draw t) ++ drawSubTrees ts
shift_ first_ other = zipWith (++) (first_ : repeat other)
"" : shift_ "├─ " "" (draw t) <> drawSubTrees ts
shift_ first_ other = zipWith (<>) (first_ : repeat other)
type PuzzleParts input = HListF ((Fanout ((->) input) (Op Text)))
infixr 9 /\\