Binary Tree implementation in Haskell as members of common type classes.

BinTree.hs

module BinTree
  ( Tree, genTree
  ) where

import GHC.Read
import GHC.Show
import Text.ParserCombinators.ReadPrec
import Text.Read.Lex

-- defines a recursive algebraic datatype describing a binary tree
data Tree a
  = Leaf a
  | Branch (Tree a)
           (Tree a)

leafPrefix = "L"

branchPrefix = "B"

-- describes how to compare two instances of the tree for equality
-- http://hackage.haskell.org/package/base-4.11.1.0/docs/Data-Eq.html
instance (Eq a) => Eq (Tree a) where
  Leaf a == Leaf b = a == b
  (Branch lft_a rgt_a) == (Branch lft_b rgt_b) = (lft_a == lft_b) && (rgt_a == rgt_b)
  _ == _ = False

-- describes how to render a tree instance as text
-- http://hackage.haskell.org/package/base-4.11.1.0/docs/src/GHC.Read.html
instance Show a => Show (Tree a) where
  showsPrec x (Leaf y) =
    showParen (x >= 11) $ showString leafPrefix . showSpace . showsPrec 11 y
  showsPrec x (Branch fst snd) =
    showParen (x >= 11) $
    showString branchPrefix . showSpace . showsPrec 11 fst . showSpace . showsPrec 11 snd

-- describes how to parse a previously rendered tree instance from text
instance Read a => Read (Tree a) where
  readPrec =
    parens $
    prec 10 $
    -- this is the branch that recognizes a leaf
    (do expectP (Ident leafPrefix)
        value <- step readPrec
        return (Leaf value)) +++
    prec 10
    -- this is the branch that recognizes a branch
      (do expectP (Ident branchPrefix)
          fst <- step readPrec
          snd <- step readPrec
          return (Branch fst snd))
  readList = readListDefault
  readListPrec = readListPrecDefault

genTreeHelper lft rgt =
  let len = rgt - lft + 1
      half = div len 2
   in case len of
        1 -> Leaf (rgt)
        2 -> Branch (Leaf (lft)) (Leaf (rgt))
        _ ->
          Branch
            (genTreeHelper lft (lft + half))
            (genTreeHelper (lft + half + 1) rgt)

genTree n =
  if n >= 1 then genTreeHelper 0 (n - 1) else error "n must be >= 1"

-- examples:
-- λ> show $ BinTree.Branch (BinTree.Leaf 1) (BinTree.Leaf 2) 
-- "b (l 1) (l 2)"
-- λ> read $ show $ BinTree.Branch (BinTree.Leaf 1) (BinTree.Leaf 2) :: BinTree.Tree Int
-- b (l 1) (l 2)