pringletons-0.4: Classes and data structures complementing the singletons library

Safe HaskellNone
LanguageHaskell2010

Data.Singletons.Class

Contents

Synopsis

Singleton Classes

These are singleton variants of the commonly used classes from base, hashable, and aeson. These variants work on higher-kinded types instead of on ground types. For example, if you wrote the following:

data MyType = MyInt | MyBool | MyChar
$(genSingletons [''MyType])
type family Interpret m where
  Interpret 'MyInt  = Int
  Interpret 'MyChar = Char
  Interpret 'MyBool = Bool
newtype MyValue x = MyValue { getMyValue :: Interpret x }

You could then write MyValue instances for all of the classes that in this module that end in Sing1. For example:

instance EqSing1 MyValue where
  eqSing1 x a b = case x of
    SMyInt  -> a == b
    SMyChar -> a == b
    SMyBool -> a == b

For our example MyValue type, the EqSing1 instance is trivial. We simply pattern match on the singleton and then do the same thing in each case. This kind of pattern matching ends up happening any time our universe interpreter maps to types that all have Eq instances. Since writing this out is tedious, we can instead use a template haskell function provided in the Data.Case.Enumerate module:

instance EqSing1 MyValue where
  eqSing1 x a b $(enumerateConstructors 'x ''MyValue =<< [|a == b|])

Instances for the other classes here can be written similarly.

class EqSing1 f where Source #

Minimal complete definition

eqSing1

Methods

eqSing1 :: Sing a -> f a -> f a -> Bool Source #

Instances

EqApplied1 k f => EqSing1 k (Applied1 k f) Source # 

Methods

eqSing1 :: Sing (Applied1 k f) a -> f a -> f a -> Bool Source #

class EqSing2 f where Source #

Minimal complete definition

eqSing2

Methods

eqSing2 :: Sing a -> Sing b -> f a b -> f a b -> Bool Source #

class EqSing1 f => OrdSing1 f where Source #

Minimal complete definition

compareSing1

Methods

compareSing1 :: Sing a -> f a -> f a -> Ordering Source #

class EqSing2 f => OrdSing2 f where Source #

Minimal complete definition

compareSing2

Methods

compareSing2 :: Sing a -> Sing b -> f a b -> f a b -> Ordering Source #

class ShowSing2 f where Source #

Minimal complete definition

showsPrecSing2

Methods

showsPrecSing2 :: Int -> Sing a -> Sing b -> f a b -> ShowS Source #

class ReadSing2 f where Source #

Minimal complete definition

readPrecSing2

Methods

readPrecSing2 :: Sing a -> Sing b -> ReadPrec (f a b) Source #

class HashableSing1 f where Source #

Minimal complete definition

hashWithSaltSing1

Methods

hashWithSaltSing1 :: Sing a -> Int -> f a -> Int Source #

Instances

HashableApplied1 k f => HashableSing1 k (Applied1 k f) Source # 

Methods

hashWithSaltSing1 :: Sing (Applied1 k f) a -> Int -> f a -> Int Source #

class HashableSing2 f where Source #

Minimal complete definition

hashWithSaltSing2

Methods

hashWithSaltSing2 :: Sing a -> Sing b -> Int -> f a b -> Int Source #

class ToJSONSing1 f where Source #

Minimal complete definition

toJSONSing1

Methods

toJSONSing1 :: Sing a -> f a -> Value Source #

Instances

ToJSONApplied1 k f => ToJSONSing1 k (Applied1 k f) Source # 

Methods

toJSONSing1 :: Sing (Applied1 k f) a -> f a -> Value Source #

class ToJSONSing2 f where Source #

Minimal complete definition

toJSONSing2

Methods

toJSONSing2 :: Sing a -> Sing b -> f a b -> Value Source #

class FromJSONSing1 f where Source #

Minimal complete definition

parseJSONSing1

Methods

parseJSONSing1 :: Sing a -> Value -> Parser (f a) Source #

Instances

class FromJSONSing2 f where Source #

Minimal complete definition

parseJSONSing2

Methods

parseJSONSing2 :: Sing a -> Sing b -> Value -> Parser (f a b) Source #

Kind classes

These are kind classes. They express that something is true for all singletons of a particular kind. Note that these are different from the kind classes provided in the singletons library itself. The methods in those classes (SOrd,SEnum,etc.) work entirely on singletons. Here, the methods also work with normal data types.

Notice that classes like EqKind and OrdKind have been omitted from this library. The reason is that that functions that would be provided by these can be trivially recovered by demoting the results of methods in SEq and SOrd.

These methods in these classes all have defaults that involve demoting the singleton and using the corresponding method from the normal typeclass.

class ShowKind k where Source #

Methods

showsPrecKind :: Int -> Sing (x :: k) -> ShowS Source #

showsPrecKind :: (SingKind k, Show (DemoteRep k)) => Int -> Sing (x :: k) -> ShowS Source #

class HashableKind k where Source #

Methods

hashWithSaltKind :: Int -> Sing (x :: k) -> Int Source #

hashWithSaltKind :: (SingKind k, Hashable (DemoteRep k)) => Int -> Sing (x :: k) -> Int Source #

class ToJSONKind k where Source #

Methods

toJSONKind :: Sing (x :: k) -> Value Source #

toJSONKind :: ShowKind k => Sing (x :: k) -> Value Source #

class ToJSONKeyKind k where Source #

Methods

toJSONKeyKind :: Sing (x :: k) -> Text Source #

toJSONKeyKind :: ShowKind k => Sing (x :: k) -> Text Source #

Data types

newtype Applied1 f a Source #

Constructors

Applied1 

Fields

Instances

FromJSONApplied1 k f => FromJSONSing1 k (Applied1 k f) Source # 

Methods

parseJSONSing1 :: Sing (Applied1 k f) a -> Value -> Parser (f a) Source #

ToJSONApplied1 k f => ToJSONSing1 k (Applied1 k f) Source # 

Methods

toJSONSing1 :: Sing (Applied1 k f) a -> f a -> Value Source #

HashableApplied1 k f => HashableSing1 k (Applied1 k f) Source # 

Methods

hashWithSaltSing1 :: Sing (Applied1 k f) a -> Int -> f a -> Int Source #

EqApplied1 k f => EqSing1 k (Applied1 k f) Source # 

Methods

eqSing1 :: Sing (Applied1 k f) a -> f a -> f a -> Bool Source #

Eq (Apply k * f a) => Eq (Applied1 k f a) Source # 

Methods

(==) :: Applied1 k f a -> Applied1 k f a -> Bool #

(/=) :: Applied1 k f a -> Applied1 k f a -> Bool #

Ord (Apply k * f a) => Ord (Applied1 k f a) Source # 

Methods

compare :: Applied1 k f a -> Applied1 k f a -> Ordering #

(<) :: Applied1 k f a -> Applied1 k f a -> Bool #

(<=) :: Applied1 k f a -> Applied1 k f a -> Bool #

(>) :: Applied1 k f a -> Applied1 k f a -> Bool #

(>=) :: Applied1 k f a -> Applied1 k f a -> Bool #

max :: Applied1 k f a -> Applied1 k f a -> Applied1 k f a #

min :: Applied1 k f a -> Applied1 k f a -> Applied1 k f a #

Read (Apply k * f a) => Read (Applied1 k f a) Source # 
Show (Apply k * f a) => Show (Applied1 k f a) Source # 

Methods

showsPrec :: Int -> Applied1 k f a -> ShowS #

show :: Applied1 k f a -> String #

showList :: [Applied1 k f a] -> ShowS #

Hashable (Apply k * f a) => Hashable (Applied1 k f a) Source # 

Methods

hashWithSalt :: Int -> Applied1 k f a -> Int #

hash :: Applied1 k f a -> Int #

ToJSON (Apply k * f a) => ToJSON (Applied1 k f a) Source # 

Methods

toJSON :: Applied1 k f a -> Value #

toEncoding :: Applied1 k f a -> Encoding #

toJSONList :: [Applied1 k f a] -> Value #

toEncodingList :: [Applied1 k f a] -> Encoding #

FromJSON (Apply k * f a) => FromJSON (Applied1 k f a) Source # 

Methods

parseJSON :: Value -> Parser (Applied1 k f a) #

parseJSONList :: Value -> Parser [Applied1 k f a] #

newtype Applied2 f a b Source #

Constructors

Applied2 

Fields

newtype Applied3 f a b c Source #

Constructors

Applied3 

Fields

data SomeSingWith1 k f where Source #

Constructors

SomeSingWith1 :: forall a f. Sing a -> f a -> SomeSingWith1 k f 

Instances

(EqSing1 kproxy f, SDecide kproxy) => Eq (SomeSingWith1 kproxy f) Source # 

Methods

(==) :: SomeSingWith1 kproxy f -> SomeSingWith1 kproxy f -> Bool #

(/=) :: SomeSingWith1 kproxy f -> SomeSingWith1 kproxy f -> Bool #

(HashableKind k, HashableSing1 k f) => Hashable (SomeSingWith1 k f) Source # 

Methods

hashWithSalt :: Int -> SomeSingWith1 k f -> Int #

hash :: SomeSingWith1 k f -> Int #

type family SomeSingWith1' (f :: k -> Type) :: Type where ... Source #

Equations

SomeSingWith1' (f :: k -> Type) = SomeSingWith1 k f 

data SomeSingWith2 k j f where Source #

Constructors

SomeSingWith2 :: forall a b f. Sing a -> Sing b -> f a b -> SomeSingWith2 k j f 

Instances

(SDecide kproxy1, SDecide kproxy2, EqSing2 kproxy2 kproxy1 f) => Eq (SomeSingWith2 kproxy1 kproxy2 f) Source # 

Methods

(==) :: SomeSingWith2 kproxy1 kproxy2 f -> SomeSingWith2 kproxy1 kproxy2 f -> Bool #

(/=) :: SomeSingWith2 kproxy1 kproxy2 f -> SomeSingWith2 kproxy1 kproxy2 f -> Bool #

(ReadKind k, ReadKind j, ReadSing2 j k f) => Read (SomeSingWith2 k j f) Source # 
(ShowKind kproxy1, ShowKind kproxy2, ShowSing2 kproxy2 kproxy1 f) => Show (SomeSingWith2 kproxy1 kproxy2 f) Source # 

Methods

showsPrec :: Int -> SomeSingWith2 kproxy1 kproxy2 f -> ShowS #

show :: SomeSingWith2 kproxy1 kproxy2 f -> String #

showList :: [SomeSingWith2 kproxy1 kproxy2 f] -> ShowS #

(ToJSONKind kproxy1, ToJSONKind kproxy2, ToJSONSing2 kproxy2 kproxy1 f) => ToJSON (SomeSingWith2 kproxy1 kproxy2 f) Source # 

Methods

toJSON :: SomeSingWith2 kproxy1 kproxy2 f -> Value #

toEncoding :: SomeSingWith2 kproxy1 kproxy2 f -> Encoding #

toJSONList :: [SomeSingWith2 kproxy1 kproxy2 f] -> Value #

toEncodingList :: [SomeSingWith2 kproxy1 kproxy2 f] -> Encoding #

(FromJSONKind k, FromJSONKind j, FromJSONSing2 j k f) => FromJSON (SomeSingWith2 k j f) Source # 

type family SomeSingWith2' (f :: k -> j -> Type) :: Type where ... Source #

Equations

SomeSingWith2' (f :: k -> j -> Type) = SomeSingWith2 k j f 

data SingWith1 k f a where Source #

Constructors

SingWith1 :: Sing a -> f a -> SingWith1 k f a 

newtype ClassySomeSing kproxy Source #

This is a wrapper for SomeSing that provides common typeclass instances for it. This can be helpful when you want to use Data.Set with SomeSing.

Constructors

ClassySomeSing 

Fields

Instances

SEq kproxy => Eq (ClassySomeSing kproxy) Source # 

Methods

(==) :: ClassySomeSing kproxy -> ClassySomeSing kproxy -> Bool #

(/=) :: ClassySomeSing kproxy -> ClassySomeSing kproxy -> Bool #

SOrd kproxy => Ord (ClassySomeSing kproxy) Source # 

Methods

compare :: ClassySomeSing kproxy -> ClassySomeSing kproxy -> Ordering #

(<) :: ClassySomeSing kproxy -> ClassySomeSing kproxy -> Bool #

(<=) :: ClassySomeSing kproxy -> ClassySomeSing kproxy -> Bool #

(>) :: ClassySomeSing kproxy -> ClassySomeSing kproxy -> Bool #

(>=) :: ClassySomeSing kproxy -> ClassySomeSing kproxy -> Bool #

max :: ClassySomeSing kproxy -> ClassySomeSing kproxy -> ClassySomeSing kproxy #

min :: ClassySomeSing kproxy -> ClassySomeSing kproxy -> ClassySomeSing kproxy #

Classes for Applied

These are additional classes used to provide instances for Applied1. If you have a defunctionalized typeclass that provides produces types in the category hask, you can use this. Instances will often look like this:

data Thing = ...
type family ToType (x :: Thing) :: Type where ...
instance EqApplied1 ToTypeSym0 where
  eqApplied1 _ x (Applied a) (Applied b) = $(enumerateConstructors 'x ''Thing =<< [|a == b|])

class EqApplied1 f where Source #

Minimal complete definition

eqApplied1

Methods

eqApplied1 :: proxy f -> Sing a -> Apply f a -> Apply f a -> Bool Source #

class HashableApplied1 f where Source #

Minimal complete definition

hashWithSaltApplied1

Methods

hashWithSaltApplied1 :: proxy f -> Sing a -> Int -> Apply f a -> Int Source #

class ToJSONApplied1 f where Source #

Minimal complete definition

toJSONApplied1

Methods

toJSONApplied1 :: proxy f -> Sing a -> Apply f a -> Value Source #

class FromJSONApplied1 f where Source #

Minimal complete definition

parseJSONApplied1

Methods

parseJSONApplied1 :: proxy f -> Sing a -> Value -> Parser (Apply f a) Source #

Functions

showKind :: forall a. ShowKind k => Sing a -> String Source #

eqSome :: SEq kproxy => SomeSing kproxy -> SomeSing kproxy -> Bool Source #

Helper function to demote an equality check. It would be nice if this could be added as an Eq instance for SomeSing, but it would required collapsing a lot of the modules in singletons to prevent cyclic imports. Or it could be provided as an orphan instance.

compareSome :: SOrd kproxy => SomeSing kproxy -> SomeSing kproxy -> Ordering Source #

Helper function to demote a comparison