diff --git a/src/EquivariantSet.hs b/src/EquivariantSet.hs index bb84155..c9120d7 100644 --- a/src/EquivariantSet.hs +++ b/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 diff --git a/src/Orbit.hs b/src/Orbit.hs index 25963e7..bddb502 100644 --- a/src/Orbit.hs +++ b/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 diff --git a/src/Orbit/Class.hs b/src/Orbit/Class.hs index dfc6abf..b806154 100644 --- a/src/Orbit/Class.hs +++ b/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 :: * diff --git a/stack.yaml b/stack.yaml index aaefa01..644fb92 100644 --- a/stack.yaml +++ b/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.