{-# LANGUAGE FunctionalDependencies #-}
{-# LANGUAGE PatternSynonyms #-}
{-# LANGUAGE UndecidableInstances #-}
module Data.InternalQuiver(
  IQuiver(..),
) where

import Data.Void
import Data.Bifunctor (Bifunctor(..))

-- | Class for Quiver represented by types of edges and vertices
class IQuiver v e | e -> v where
  src :: e -> v
  tgt :: e -> v

-- * Instances

-- | Empty graph
instance IQuiver Void Void where
  src :: Void -> Void
src = Void -> Void
forall a. Void -> a
absurd
  tgt :: Void -> Void
tgt = Void -> Void
forall a. Void -> a
absurd

-- | A graph with one vertex and one loop on it
instance IQuiver () () where
  src :: () -> ()
src = () -> ()
forall a. a -> a
id
  tgt :: () -> ()
tgt = () -> ()
forall a. a -> a
id

instance (IQuiver v e, IQuiver w f) => IQuiver (Either v w) (Either e f) where
  src :: Either e f -> Either v w
src = (e -> v) -> (f -> w) -> Either e f -> Either v w
forall a b c d. (a -> b) -> (c -> d) -> Either a c -> Either b d
forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap e -> v
forall v e. IQuiver v e => e -> v
src f -> w
forall v e. IQuiver v e => e -> v
src
  tgt :: Either e f -> Either v w
tgt = (e -> v) -> (f -> w) -> Either e f -> Either v w
forall a b c d. (a -> b) -> (c -> d) -> Either a c -> Either b d
forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap e -> v
forall v e. IQuiver v e => e -> v
src f -> w
forall v e. IQuiver v e => e -> v
src

instance (IQuiver v e, IQuiver w f) => IQuiver (v,w) (e,f) where
  src :: (e, f) -> (v, w)
src = (e -> v) -> (f -> w) -> (e, f) -> (v, w)
forall a b c d. (a -> b) -> (c -> d) -> (a, c) -> (b, d)
forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap e -> v
forall v e. IQuiver v e => e -> v
src f -> w
forall v e. IQuiver v e => e -> v
src
  tgt :: (e, f) -> (v, w)
tgt = (e -> v) -> (f -> w) -> (e, f) -> (v, w)
forall a b c d. (a -> b) -> (c -> d) -> (a, c) -> (b, d)
forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap e -> v
forall v e. IQuiver v e => e -> v
tgt f -> w
forall v e. IQuiver v e => e -> v
tgt