setup RenderableVertices to use deriving via

src/Crem/Render/RenderableVertices.hs

@@ -1,28 +1,99 @@
+{-# LANGUAGE DerivingVia #-}
 {-# LANGUAGE UndecidableInstances #-}
 
 -- | The `RenderableVertices` class describes which values of type @a@ should
 -- be rendered when drawing a graph (or a topology) with vertices of type @a@
 module Crem.Render.RenderableVertices where
 
+import "base" Data.Functor.Const (Const (..))
+import "base" Data.Functor.Identity (Identity (..))
+import "base" Data.Monoid (Dual (..), Product (..), Sum (..))
+import "base" Data.Ord (Down (..))
+import "base" Data.Proxy (Proxy (..))
+import "base" Data.Semigroup (All (..), Any (..), First (..), Last (..), Max (..), Min (..))
+import "base" Data.Void (Void)
+
 -- | The `RenderableVertices` class is implemented just as a list of elements
 -- of type @a@.
 class RenderableVertices a where
   vertices :: [a]
 
--- | If @a@ has `Enum` and `Bounded` instances, we have a way to enumerate all
--- the terms of type @a@.
---
--- Be careful to use this instance for types which are actually too big, like
--- `Int`. You probably don't want to print out every possible integer.
-instance {-# OVERLAPPABLE #-} (Enum a, Bounded a) => RenderableVertices a where
-  vertices :: [a]
-  vertices = [minBound .. maxBound]
+-- | This is a newtype to be used with `deriving via`. If `a` has instances for
+-- `Enum` and `Bounded`, then `AllVertices a` has an instance of
+-- `RenderableVertices` which lists all the terms of type `a`.
+newtype AllVertices a = AllVertices a
+
+instance (Enum a, Bounded a) => RenderableVertices (AllVertices a) where
+  vertices :: [AllVertices a]
+  vertices = AllVertices <$> [minBound .. maxBound]
+
+instance RenderableVertices Void where
+  vertices :: [Void]
+  vertices = []
+
+deriving via AllVertices () instance RenderableVertices ()
+
+deriving via AllVertices Bool instance RenderableVertices Bool
+
+instance RenderableVertices All where
+  vertices :: [All]
+  vertices = [All False, All True]
+
+instance RenderableVertices Any where
+  vertices :: [Any]
+  vertices = [Any False, Any True]
+
+deriving via AllVertices Ordering instance RenderableVertices Ordering
 
 instance RenderableVertices a => RenderableVertices (Maybe a) where
   vertices :: [Maybe a]
   vertices =
     Nothing : (Just <$> vertices)
 
+instance RenderableVertices a => RenderableVertices (Min a) where
+  vertices :: [Min a]
+  vertices = Min <$> vertices
+
+instance RenderableVertices a => RenderableVertices (Max a) where
+  vertices :: [Max a]
+  vertices = Max <$> vertices
+
+instance RenderableVertices a => RenderableVertices (First a) where
+  vertices :: [First a]
+  vertices = First <$> vertices
+
+instance RenderableVertices a => RenderableVertices (Last a) where
+  vertices :: [Last a]
+  vertices = Last <$> vertices
+
+instance RenderableVertices a => RenderableVertices (Identity a) where
+  vertices :: [Identity a]
+  vertices = Identity <$> vertices
+
+instance RenderableVertices a => RenderableVertices (Dual a) where
+  vertices :: [Dual a]
+  vertices = Dual <$> vertices
+
+instance RenderableVertices a => RenderableVertices (Sum a) where
+  vertices :: [Sum a]
+  vertices = Sum <$> vertices
+
+instance RenderableVertices a => RenderableVertices (Down a) where
+  vertices :: [Down a]
+  vertices = Down <$> vertices
+
+instance RenderableVertices a => RenderableVertices (Product a) where
+  vertices :: [Product a]
+  vertices = Product <$> vertices
+
+instance RenderableVertices (Proxy a) where
+  vertices :: [Proxy a]
+  vertices = [Proxy]
+
+instance RenderableVertices a => RenderableVertices (Const a b) where
+  vertices :: [Const a b]
+  vertices = Const <$> vertices
+
 instance (RenderableVertices a, RenderableVertices b) => RenderableVertices (Either a b) where
   vertices :: [Either a b]
   vertices =
@@ -32,3 +103,27 @@ instance (RenderableVertices a, RenderableVertices b) => RenderableVertices (Eit
 instance (RenderableVertices a, RenderableVertices b) => RenderableVertices (a, b) where
   vertices :: [(a, b)]
   vertices = [(a, b) | a <- vertices, b <- vertices]
+
+instance (RenderableVertices a, RenderableVertices b, RenderableVertices c) => RenderableVertices (a, b, c) where
+  vertices :: [(a, b, c)]
+  vertices = [(a, b, c) | a <- vertices, b <- vertices, c <- vertices]
+
+instance (RenderableVertices a, RenderableVertices b, RenderableVertices c, RenderableVertices d) => RenderableVertices (a, b, c, d) where
+  vertices :: [(a, b, c, d)]
+  vertices = [(a, b, c, d) | a <- vertices, b <- vertices, c <- vertices, d <- vertices]
+
+instance (RenderableVertices a, RenderableVertices b, RenderableVertices c, RenderableVertices d, RenderableVertices e) => RenderableVertices (a, b, c, d, e) where
+  vertices :: [(a, b, c, d, e)]
+  vertices = [(a, b, c, d, e) | a <- vertices, b <- vertices, c <- vertices, d <- vertices, e <- vertices]
+
+instance (RenderableVertices a, RenderableVertices b, RenderableVertices c, RenderableVertices d, RenderableVertices e, RenderableVertices f) => RenderableVertices (a, b, c, d, e, f) where
+  vertices :: [(a, b, c, d, e, f)]
+  vertices = [(a, b, c, d, e, f) | a <- vertices, b <- vertices, c <- vertices, d <- vertices, e <- vertices, f <- vertices]
+
+instance (RenderableVertices a, RenderableVertices b, RenderableVertices c, RenderableVertices d, RenderableVertices e, RenderableVertices f, RenderableVertices g) => RenderableVertices (a, b, c, d, e, f, g) where
+  vertices :: [(a, b, c, d, e, f, g)]
+  vertices = [(a, b, c, d, e, f, g) | a <- vertices, b <- vertices, c <- vertices, d <- vertices, e <- vertices, f <- vertices, g <- vertices]
+
+instance (RenderableVertices a, RenderableVertices b, RenderableVertices c, RenderableVertices d, RenderableVertices e, RenderableVertices f, RenderableVertices g, RenderableVertices h) => RenderableVertices (a, b, c, d, e, f, g, h) where
+  vertices :: [(a, b, c, d, e, f, g, h)]
+  vertices = [(a, b, c, d, e, f, g, h) | a <- vertices, b <- vertices, c <- vertices, d <- vertices, e <- vertices, f <- vertices, g <- vertices, h <- vertices]