mirror of
https://github.com/marcosh/crem.git
synced 2024-08-16 16:00:37 +03:00
setup RenderableVertices to use deriving via
This commit is contained in:
parent
c70a4cd38e
commit
0f943e4a22
@ -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]
|
||||
|
Loading…
Reference in New Issue
Block a user