Somebody's Homework that I did for free

Main.hs

module Main where

-- https://i.imgur.com/mA5EEWI.png

import Control.Exception
import Data.List
import Data.Maybe
import Data.Foldable

data Tree a
  = Node a
         (Tree a)
         (Tree a)
  | Null
  deriving (Show, Eq)

instance Ord a => Ord (Tree a) where
  compare Null Null = EQ
  compare Null _ = LT
  compare _ Null = GT
  compare (Node value1 left1 right1) (Node value2 left2 right2) =
    fromMaybe EQ $
    find
      (/= EQ)
      [compare left1 left2, compare value1 value2, compare right1 right2]

test :: IO ()
test = do
  assert (compare tree1 tree2 == LT) (return ())
  assert (compare tree3 tree4 == GT) (return ())
  assert (compare tree5 tree6 == LT) (return ())
  putStrLn "OKeg"

tree1 :: Tree Int
tree1 = Node 4 (Node 5 Null Null) (Node 7 Null Null)

tree2 :: Tree Int
tree2 = Node 4 (Node 10 Null Null) (Node 7 Null Null)

tree3 :: Tree Int
tree3 = Node 10 (Node 5 Null Null) (Node 3 Null Null)

tree4 :: Tree Int
tree4 = Node 4 (Node 5 Null Null) (Node 7 Null Null)

tree5 :: Tree Int
tree5 = Node 10 Null (Node 4 Null Null)

tree6 :: Tree Int
tree6 = Node 1 (Node 2 Null Null) (Node 3 Null Null)

trees :: [Tree Int]
trees = [tree1, tree2, tree3, tree4, tree5, tree6]

pp :: Show a => Tree a -> String
pp tree = unlines $ pp' 0 tree
  where
    pp' :: Show a => Int -> Tree a -> [String]
    pp' level (Node value left right) =
      let leftPp = pp' (level + 1) left
          rightPp = pp' (level + 1) right
       in concat [rightPp, [replicate (2 * level) ' ' ++ show value], leftPp]
    pp' _ Null = []

main :: IO ()
main = undefined