Use Text for drawTree
This commit is contained in:
parent
1de4fcd028
commit
31082a85d5
@ -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 ()
|
||||
|
||||
@ -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 /\\
|
||||
|
||||
Loading…
x
Reference in New Issue
Block a user