Prints Binary Trees In "Ancestor" Orientation ( AKA Leaves on the Top )

Ancestor-Tree.fs

(*
        Example Tree Print
        ------------------

[Grandfather] [Grandmother] [Grandpa] [Grandma]          
     |______________|          |__________|              
             |                       |                  
           [Dad]                   [Mom]                
             |_______________________|                  
                           |                            
                         [me]                   [Unknown]
                          |_________________________|    
                                               |        
                                            [weird]  
*)


type AncTree =
        | Unspec
        | Info of AncTree * string * AncTree
        member this.Name() =
            match this with
            | Unspec        -> "[Unknown]"
            | Info(f,s,m)   -> "["+s+"]"
 
        override this.ToString()=
 
            let bars    x   =
                match x with
                | x when x <= 0 ->  String.replicate 0 "_"
                | x             ->  String.replicate x "_"
            let spaces  x   =
                match x with
                | x when x <= 0 ->  String.replicate 0 " "
                | x             ->  String.replicate x " "
            let listConcat (ls:string list):string=
                let rec concat_stringlist (strs: string list)(acc:string) : string =
                    match strs with
                    | x::[] -> concat_stringlist [] (acc + x + "\n" )
                    | x::xs -> concat_stringlist xs (acc + x + "\n" )
                    | []    -> acc
                concat_stringlist ls ""
            // [strings], 1st, 2nd, 3rd
            // strings are all the same width (space padded if needed)
            // first int is that total width
            // second int is the column the root node starts in
            // third int is the column the root node ends in
            let rec formatNode tree =
                match tree with
                | Unspec                -> [tree.Name()],
                                            tree.Name().Length,
                                            0,
                                            tree.Name().Length-1
                           
                | Info(Unspec,s,Unspec) -> [tree.Name()],
                                            tree.Name().Length,
                                            0,
                                            tree.Name().Length-1
                | Info(left,s,right)    
                    ->  
                        let nodestr        = tree.Name()
                        let nodelen        = nodestr.Length
                        let lhlf           = nodelen /2
                        let rhlf           = (nodelen-1)/2
                        let leftStrings,
                            leftWidth,
                            leftColStart,
                            leftColEnd     = formatNode left
                        let rightStrings,
                            rightWidth,
                            rightColStart,
                            rightColEnd    = formatNode right
                        let totalWidth     = leftWidth     + 1 + rightWidth
                        let rightColStart2 = rightColStart + 1 + leftWidth
                        let leftpadding    = leftWidth  - lhlf |> spaces
                        let rightpadding   = rightWidth - rhlf |> spaces
                        let baseline       = leftpadding + nodestr + rightpadding
                        let pipeline       = spaces leftWidth + "|" + spaces rightWidth
                        let leftbars       = leftWidth - leftColEnd + (leftColEnd - leftColStart)/2  |> bars
                        let rightbars      = rightColStart + (rightColEnd - rightColStart)/2 |> bars
                        let lconnectpad    = leftWidth  - leftbars.Length  - 1 |> spaces
                        let rconnectpad    = rightWidth - rightbars.Length - 1 |> spaces
                        let connectline    = lconnectpad + "|" + leftbars    + "_" +
                                             rightbars   + "|" + rconnectpad
                        let ladjHeight, radjHeight =
                            match leftStrings, rightStrings with
                            | l,r when l.Length > r.Length  
                                    ->  let hpad = List.init (l.Length - r.Length) (fun x -> "")
                                        l, hpad@r
                            | l,r when r.Length > l.Length  
                                    ->  let hpad = List.init (r.Length - l.Length) (fun x -> "")
                                        hpad@l, r
                            | l,r   ->  l,r
                        let rec fixWidthLeft  (strs:string list) (width:int) =
                            match strs with
                            | x::xs when x.Length < width
                                    -> (spaces (width - x.Length) + x)::fixWidthLeft xs width
                            | x::xs -> x::fixWidthLeft xs width
                            | []    -> []
                        let rec fixWidthRight (strs:string list) (width:int) =
                            match strs with
                            | x::xs when x.Length < width
                                    -> (x + spaces (width - x.Length))::fixWidthRight xs width
                            | x::xs -> x::fixWidthRight xs width
                            | []    -> []
                        let ladjHW, radjHW =    fixWidthLeft  ladjHeight leftWidth ,
                                                fixWidthRight radjHeight rightWidth
                        let ancestors = (ladjHW,radjHW )
                                        ||> List.map2 (fun left right -> left + " " + right )
                        let treelines = ancestors @ connectline::pipeline::baseline::[]
                        in
                        treelines, totalWidth, leftWidth-lhlf, leftWidth+1+rhlf
            let ancStrings,_,_,_ = formatNode this
            ancStrings |> listConcat
 
let dadtree = Info(Info(Unspec,"Grandfather",Unspec),"Dad",Info(Unspec,"Grandmother",Unspec))
let momtree = Info(Info(Unspec,"Grandpa",Unspec),"Mom",Info(Unspec,"Grandma",Unspec))
let metree = Info(dadtree,"me",momtree)
let weirdtree = Info(metree,"weird",Unspec)