Use Text for drawTree
This commit is contained in:
parent
1de4fcd028
commit
31082a85d5
@ -23,7 +23,7 @@ main :: IO ()
|
|||||||
main = do
|
main = do
|
||||||
-- terminalWidth <- Terminal.Size.width <<$>> Terminal.Size.size -- TODO this doesn't work in GHCID or GHCIWatch...
|
-- terminalWidth <- Terminal.Size.width <<$>> Terminal.Size.size -- TODO this doesn't work in GHCID or GHCIWatch...
|
||||||
terminalWidth <- pure $ Just 62
|
terminalWidth <- pure $ Just 62
|
||||||
putStrLn $ drawTree $ T.unpack <$> getTestTree tests
|
T.putStrLn $ drawTree $ getTestTree tests
|
||||||
TL.putStrLn . displayTestResultsConsole terminalWidth =<< runTests () tests
|
TL.putStrLn . displayTestResultsConsole terminalWidth =<< runTests () tests
|
||||||
|
|
||||||
tests :: TestTree IO ()
|
tests :: TestTree IO ()
|
||||||
|
|||||||
@ -184,18 +184,19 @@ adjacentPairs = \case
|
|||||||
sortPair :: (Ord a) => (a, a) -> (a, a)
|
sortPair :: (Ord a) => (a, a) -> (a, a)
|
||||||
sortPair (a, b) = if a <= b then (a, b) else (b, 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.
|
-- | This is `Data.Tree.drawTree` with the ASCII characters replaced with Unicode box drawing characters,
|
||||||
drawTree :: Tree String -> String
|
-- and using `Text` instead of `String`.
|
||||||
drawTree = unlines . draw
|
drawTree :: Tree Text -> Text
|
||||||
|
drawTree = T.unlines . draw
|
||||||
where
|
where
|
||||||
draw (Node x ts0) = lines x ++ drawSubTrees ts0
|
draw (Node x ts0) = T.lines x <> drawSubTrees ts0
|
||||||
where
|
where
|
||||||
drawSubTrees [] = []
|
drawSubTrees [] = []
|
||||||
drawSubTrees [t] =
|
drawSubTrees [t] =
|
||||||
"│" : shift_ "└─ " " " (draw t)
|
"│" : shift_ "└─ " " " (draw t)
|
||||||
drawSubTrees (t : ts) =
|
drawSubTrees (t : ts) =
|
||||||
"│" : shift_ "├─ " "│ " (draw t) ++ drawSubTrees ts
|
"│" : shift_ "├─ " "│ " (draw t) <> drawSubTrees ts
|
||||||
shift_ first_ other = zipWith (++) (first_ : repeat other)
|
shift_ first_ other = zipWith (<>) (first_ : repeat other)
|
||||||
|
|
||||||
type PuzzleParts input = HListF ((Fanout ((->) input) (Op Text)))
|
type PuzzleParts input = HListF ((Fanout ((->) input) (Op Text)))
|
||||||
infixr 9 /\\
|
infixr 9 /\\
|
||||||
|
|||||||
Loading…
x
Reference in New Issue
Block a user