From aefb7f067f6b2a9aa716b17b0bffb8d3e6586ace Mon Sep 17 00:00:00 2001 From: George Thomas Date: Wed, 7 Jan 2026 00:55:46 +0000 Subject: [PATCH] Use Unicode for tree drawing --- haskell/Pre.hs | 16 +++++++++++++++- 1 file changed, 15 insertions(+), 1 deletion(-) diff --git a/haskell/Pre.hs b/haskell/Pre.hs index 290188e..f871b1a 100644 --- a/haskell/Pre.hs +++ b/haskell/Pre.hs @@ -49,6 +49,7 @@ module Pre ( allUnorderedPairs, adjacentPairs, sortPair, + drawTree, HList (..), HListC (..), HListF (..), @@ -127,7 +128,7 @@ import Data.Text.IO qualified as T import Data.Text.Lazy qualified as TL import Data.Time import Data.Traversable -import Data.Tree +import Data.Tree hiding (drawTree) import Data.Tuple.Extra ((&&&)) import Data.Void import Data.Word @@ -184,6 +185,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 + where + draw (Node x ts0) = 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) + type PuzzleParts input = HListF ((Fanout ((->) input) (Op Text))) infixr 9 /\\ (/\\) :: (input -> output, output -> Text) -> PuzzleParts input outputs -> PuzzleParts input (output : outputs)