diff --git a/src/Crem/Render/RenderableVertices.hs b/src/Crem/Render/RenderableVertices.hs index 2dd0aba..fc43e13 100644 --- a/src/Crem/Render/RenderableVertices.hs +++ b/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]