Adds trivial instances by using DerivingVia extension (needs new ghc)

src/EquivariantSet.hs

@@ -1,22 +1,19 @@
+{-# LANGUAGE DerivingVia #-}
 {-# LANGUAGE FlexibleContexts #-}
-{-# LANGUAGE FlexibleInstances #-}
 {-# LANGUAGE GeneralizedNewtypeDeriving #-}
 {-# LANGUAGE ScopedTypeVariables #-}
 {-# LANGUAGE StandaloneDeriving #-}
 {-# LANGUAGE TypeApplications #-}
-{-# LANGUAGE TypeFamilies #-}
 {-# LANGUAGE UndecidableInstances #-}
 
 module EquivariantSet where
 
 import Data.Proxy
-
 import Data.Set (Set)
 import qualified Data.Set as Set
 import Prelude hiding (map, product)
 
 import Orbit
-import Support
 
 
 -- Given a nominal type, we can construct equivariant sets. These simply use a
@@ -37,18 +34,8 @@ deriving instance Show (Orb a) => Show (EquivariantSet a)
 deriving instance Ord (Orb a) => Monoid (EquivariantSet a)
 deriving instance Ord (Orb a) => Semigroup (EquivariantSet a)
 
--- We could derive a correct instance if I had written generic instances.
--- Didn't do that yet, but a direct instance is also nice.
-instance Orbit (EquivariantSet a) where
-  type Orb (EquivariantSet a) = EquivariantSet a
-  toOrbit = id
-  support _ = Support.empty
-  getElement x _ = x
-  index _ _ = 0
-
--- deriving instance Show (Orb a) => Show (Orb (EquivariantSet a))
--- deriving instance Eq (Orb a) => Eq (Orb (EquivariantSet a))
--- deriving instance Ord (Orb a) => Ord (Orb (EquivariantSet a))
+-- This action is trivial, since equivariant sets are equivariant
+deriving via (Trivial (EquivariantSet a)) instance Orbit (EquivariantSet a) 
 
 
 -- Query

src/Orbit.hs

@@ -76,15 +76,3 @@ leftProduct pa pb oa ob = OrbPair (OrbRec oa) (OrbRec ob) <$> rincProdStrings (i
 {-# INLINABLE separatedProduct #-}
 {-# INLINABLE leftProduct #-}
 
-
--- Data structure for the discrete nominal sets with a trivial action.
-newtype Trivial a = Trivial { unTrivial :: a }
-  deriving (Eq, Ord, Show)
-
--- We need to remember the value!
-instance Orbit (Trivial a) where
-  type Orb (Trivial a) = a
-  toOrbit (Trivial a) = a
-  support _ = Support.empty
-  getElement a _ = Trivial a
-  index _ _ = 0

src/Orbit/Class.hs

@@ -1,3 +1,4 @@
+{-# LANGUAGE DerivingVia #-}
 {-# LANGUAGE TypeFamilies #-}
 {-# LANGUAGE DefaultSignatures #-}
 {-# LANGUAGE DeriveGeneric #-}
@@ -57,6 +58,26 @@ class Orbit a where
   {-# INLINABLE index #-}
 
 
+-- Data structure for the discrete nominal sets with a trivial action.
+newtype Trivial a = Trivial { unTrivial :: a }
+  deriving (Eq, Ord, Show)
+
+-- For the trivial action, each element is its own orbit and is supported
+-- by the empty set.
+instance Orbit (Trivial a) where
+  type Orb (Trivial a) = a
+  toOrbit (Trivial a) = a
+  support _ = Support.empty
+  getElement a _ = Trivial a
+  index _ _ = 0
+
+
+-- We can now define trivial instances for some basic types.
+-- This uses a new Haskell extension (ghc 8.6.1)
+deriving via (Trivial Bool) instance Orbit Bool
+
+
+
 -- Generic class, so that custom data types can be derived
 class GOrbit f where
   type GOrb f :: *

stack.yaml

@@ -15,7 +15,7 @@
 # resolver:
 #  name: custom-snapshot
 #  location: "./custom-snapshot.yaml"
-resolver: lts-11.0
+resolver: lts-13.1
 
 # User packages to be built.
 # Various formats can be used as shown in the example below.