Doubly Linked List (tying the knot)

import Data.Semigroup

data List a = Node (List a) a (List a) | Nil

instance Show a => Show (List a) where
  show ls = "[" <> pretty ls <> "]"

pretty :: Show a => List a -> String
pretty Nil = ""
pretty (Node _ a Nil) = show a
pretty (Node _ a ls) = (show a) <> "," <> pretty ls

singleton :: a -> List a
singleton a = Node Nil a Nil

append :: List a -> a -> List a
append (Node p x Nil) a =
  let parent = Node p x child
      child = Node parent a Nil
  in parent
append (Node p x l) a = Node p x (append l a)

join :: List a -> List a -> List a
join l Nil = l
join Nil l = l
join (Node a b Nil) (Node Nil y z) =
  let p = Node a b c
      c = Node p y z
  in p
join (Node a b c) n@(Node Nil _ _) = Node a b $ join c n
join n@(Node _ _ Nil) (Node a b c) = join n a

instance Semigroup (List a) where
  (<>) = join

instance Monoid (List a) where
  mempty = Nil
  mappend = (<>)

fromList :: [a] -> List a
fromList [] = mempty
fromList (x:xs) = (singleton x) <> (fromList xs)

main = do
  let x = append (singleton 1) 2
  print x
  let y = append (singleton 3) 4
  let z = x <> y
  let w = fromList [5,6,7,8]
  print $ z <> w