Print Binary Search Tree in a tree like structure in Haskell

Question

I created a binary search tree and tried to print the binary search tree with this instance

data Tree a = Nil | Node (Tree a) a (Tree a)
instance Show a => Show (Tree a) where
        show t = intercalate "\n"  (map snd (draw t))

draw :: Show a => Tree a -> [(Int,String)]
draw Nil                = [(1,"*")]
draw (Node Nil x Nil)   = [(1,show x)]
draw (Node tl x tr)     = zip (repeat 0) (map shiftl (draw tl)) ++ [(1,show x ++ "-+")] ++ zip (repeat 2) (map shiftr (draw tr)) where
        shiftl (0,x)    =       spaces ++ "  " ++ x 
        shiftl (1,x)    =       spaces ++ "+-" ++ x 
        shiftl (2,x)    =       spaces ++ "| " ++ x 
        shiftr (0,x)    =       spaces ++ "| " ++ x 
        shiftr (1,x)    =       spaces ++ "+-" ++ x 
        shiftr (2,x)    =       spaces ++ "  " ++ x
        spaces          =       replicate  (length (show x)+1) ' '
createTree :: [a] -> BTree a
createTree []   = Nil
createTree xs    = Node
    (createTree front) x (createTree back) where
        n = length xs
        (front, x:back) = splitAt (n `div` 2) xs

Now I want to print it horizontally, which i am not able to do so. I want to print the binary search tree like this picture below. (Sorry for the low quality of the picture but you get the idea). How can i do it ?

Use the sample example [1..50]

UPDATE ANSWER :-

I found my answer myself. I created one function that shows like that. The code is in the comments.

If you have an other solution please share

Answer 1

I found my answer myself. I created one function that shows like that. Here is the code

import Data.List (intercalate)
data BTree a    = Nil | Node (BTree a) a (BTree a) deriving Eq
-- Instances of BST
instance Show a => Show (BTree a) where
    show t = "\n" ++ intercalate "\n" (map (map snd) (fst $ draw5 t)) ++ "\n"

-- End of instances
data Tag        = L | M | R deriving (Eq,Show)
type Entry      = (Tag, Char)
type Line       = [Entry] 
--the tag thing is for my own understanding that do no work here.
createTree :: [a] -> BTree a
createTree []   = Nil
createTree xs    = Node
    (createTree front) x (createTree back) where
        n = length xs
        (front, x:back) = splitAt (n `div` 2) xs
        
-- my own draw
draw5 :: Show a => BTree a -> ([Line],(Int,Int,Int))
draw5 Nil               =   ([zip [M] "*"],(0,1,0) )
draw5 (Node Nil x Nil)  =   
    let (sx,n,m) = (show x, length sx, n `div` 2) in
        ([zip (replicate m L ++ [M] ++ replicate (n-m-1) R) sx], (m,1,n-m-1)) 

draw5 (Node tl x tr) = (l1:l2:l3:l4:mainline,(a,b,c)) where
    (mainline ,(a,b,c)) = drawing xs ys
    (xs,(xsa,xsb,xsc)) = draw5 tl
    (ys,(ysa,ysb,ysc)) = draw5 tr 
    drawing xs ys = (join xs ys, (xsa+xsb+xsc+1, 1, ysa+ysb+ysc+1) )
    join (as:ass) (bs:bss) = go as bs : join ass bss
    join xss []  = map (++  ([(L,' '),(M, ' '),(R,' ')] ++ replicate (ysa+ysb+ysc) (R,' ') )) xss
    join [] yss  = map ((replicate (xsa+xsb+xsc) (L,' ') ++  [(L,' '),(M, ' '),(R,' ')]) ++ ) yss
    go xss yss = xss ++ [(L,' '),(M, ' '),(R,' ')] ++ yss
    ([cs],(m,n,o)) = draw5 (Node Nil x Nil)
    l1 = replicate (a-m) (L,' ') ++ cs ++ replicate (c-o) (R,' ')
    l2 = replicate a (L,' ') ++ [(M, '|')] ++ replicate c (R,' ')
    l3 = replicate xsa (L,' ') ++ [(L,'+')] ++ replicate (xsc+1) (L,'-') ++ [(M,'+')] ++ replicate (ysa+1) (R,'-') ++ [(R,'+')] ++ replicate ysc (R,' ')
    l4 = replicate xsa (L,' ') ++ [(L,'|')] ++ replicate (xsc+ysa+3) (M,' ') ++ [(R,'|')] ++ replicate ysc (R,' ')