Use Unicode for tree drawing
This commit is contained in:
parent
fb2d412f95
commit
aefb7f067f
@ -49,6 +49,7 @@ module Pre (
|
|||||||
allUnorderedPairs,
|
allUnorderedPairs,
|
||||||
adjacentPairs,
|
adjacentPairs,
|
||||||
sortPair,
|
sortPair,
|
||||||
|
drawTree,
|
||||||
HList (..),
|
HList (..),
|
||||||
HListC (..),
|
HListC (..),
|
||||||
HListF (..),
|
HListF (..),
|
||||||
@ -127,7 +128,7 @@ import Data.Text.IO qualified as T
|
|||||||
import Data.Text.Lazy qualified as TL
|
import Data.Text.Lazy qualified as TL
|
||||||
import Data.Time
|
import Data.Time
|
||||||
import Data.Traversable
|
import Data.Traversable
|
||||||
import Data.Tree
|
import Data.Tree hiding (drawTree)
|
||||||
import Data.Tuple.Extra ((&&&))
|
import Data.Tuple.Extra ((&&&))
|
||||||
import Data.Void
|
import Data.Void
|
||||||
import Data.Word
|
import Data.Word
|
||||||
@ -184,6 +185,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.
|
||||||
|
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)))
|
type PuzzleParts input = HListF ((Fanout ((->) input) (Op Text)))
|
||||||
infixr 9 /\\
|
infixr 9 /\\
|
||||||
(/\\) :: (input -> output, output -> Text) -> PuzzleParts input outputs -> PuzzleParts input (output : outputs)
|
(/\\) :: (input -> output, output -> Text) -> PuzzleParts input outputs -> PuzzleParts input (output : outputs)
|
||||||
|
|||||||
Loading…
x
Reference in New Issue
Block a user