Graph.hs

data Graph a
  = Empty
  | Vertex a
  | Overlay (Graph a) (Graph a)
  | Connect (Graph a) (Graph a)
  deriving stock (Show)

instance (Num a) => Num (Graph a) where
  fromInteger = Vertex . fromInteger
  (+) = Overlay
  (*) = Connect
  signum = const Empty
  abs = id
  negate = id

instance Semigroup (Graph a) where
  (<>) = Overlay

instance Monoid (Graph a) where
  mempty = Empty

vertices :: [a] -> Graph a
vertices = foldr (Overlay . Vertex) Empty

edges :: [(a, a)] -> Graph a
edges = foldr (\(x, y) acc -> Overlay (Connect (Vertex x) (Vertex y)) acc) Empty

create :: [a] -> [(a, a)] -> Graph a
create v e = Overlay (vertices v) (edges e)

foldg :: b -> (a -> b) -> (b -> b -> b) -> (b -> b -> b) -> Graph a -> b
foldg e v o c = go
  where
    go = \case
      Empty -> e
      Vertex x -> v x
      Overlay x y -> o (go x) (go y)
      Connect x y -> c (go x) (go y)

transpose :: Graph a -> Graph a
transpose = foldg Empty Vertex Overlay (flip Connect)

induce :: (a -> Bool) -> Graph a -> Graph a
induce f = foldg Empty (\x -> if f x then Vertex x else Empty) Overlay Connect

removeVertex :: (Eq a) => a -> Graph a -> Graph a
removeVertex = induce . (/=)