singletons-2.3.1: A framework for generating singleton types

Copyright(C) 2016 Richard Eisenberg
LicenseBSD-style (see LICENSE)
MaintainerRichard Eisenberg (rae@cs.brynmawr.edu)
Stabilityexperimental
Portabilitynon-portable
Safe HaskellNone
LanguageHaskell2010

Data.Singletons.Prelude.Function

Contents

Description

Defines singleton versions of the definitions in Data.Function.

Because many of these definitions are produced by Template Haskell, it is not possible to create proper Haddock documentation. Please look up the corresponding operation in Data.Function. Also, please excuse the apparent repeated variable names. This is due to an interaction between Template Haskell and Haddock.

Synopsis

Prelude re-exports

type family Id (a :: a) :: a where ... Source #

Equations

Id x = x 

sId :: forall (t :: a). Sing t -> Sing (Apply IdSym0 t :: a) Source #

type family Const (a :: a) (a :: b) :: a where ... Source #

Equations

Const x _z_6989586621679281163 = x 

sConst :: forall (t :: a) (t :: b). Sing t -> Sing t -> Sing (Apply (Apply ConstSym0 t) t :: a) Source #

type family ((a :: TyFun b c -> Type) :. (a :: TyFun a b -> Type)) (a :: a) :: c where ... infixr 9 Source #

Equations

(f :. g) a_6989586621679281126 = Apply (Apply (Apply (Apply Lambda_6989586621679281131Sym0 f) g) a_6989586621679281126) a_6989586621679281126 

(%:.) :: forall (t :: TyFun b c -> Type) (t :: TyFun a b -> Type) (t :: a). Sing t -> Sing t -> Sing t -> Sing (Apply (Apply (Apply (:.$) t) t) t :: c) infixr 9 Source #

type family Flip (a :: TyFun a (TyFun b c -> Type) -> Type) (a :: b) (a :: a) :: c where ... Source #

Equations

Flip f x y = Apply (Apply f y) x 

sFlip :: forall (t :: TyFun a (TyFun b c -> Type) -> Type) (t :: b) (t :: a). Sing t -> Sing t -> Sing t -> Sing (Apply (Apply (Apply FlipSym0 t) t) t :: c) Source #

type family (f :: TyFun a b -> *) $ (x :: a) :: b infixr 0 Source #

Instances

type ($) k1 k f x Source # 
type ($) k1 k f x = (@@) k1 k f x

(%$) :: forall (f :: TyFun a b -> *) (x :: a). Sing f -> Sing x -> Sing ((($$) @@ f) @@ x) infixr 0 Source #

Other combinators

type family (a :: a) :& (a :: TyFun a b -> Type) :: b where ... Source #

Equations

x :& f = Apply f x 

(%:&) :: forall (t :: a) (t :: TyFun a b -> Type). Sing t -> Sing t -> Sing (Apply (Apply (:&$) t) t :: b) Source #

type family On (a :: TyFun b (TyFun b c -> Type) -> Type) (a :: TyFun a b -> Type) (a :: a) (a :: a) :: c where ... Source #

Equations

On ty f a_6989586621679292947 a_6989586621679292949 = Apply (Apply (Apply (Apply (Apply (Apply Lambda_6989586621679292955Sym0 ty) f) a_6989586621679292947) a_6989586621679292949) a_6989586621679292947) a_6989586621679292949 

sOn :: forall (t :: TyFun b (TyFun b c -> Type) -> Type) (t :: TyFun a b -> Type) (t :: a) (t :: a). Sing t -> Sing t -> Sing t -> Sing t -> Sing (Apply (Apply (Apply (Apply OnSym0 t) t) t) t :: c) Source #

Defunctionalization symbols

data IdSym0 (l :: TyFun a6989586621679281044 a6989586621679281044) Source #

Instances

SuppressUnusedWarnings (TyFun a6989586621679281044 a6989586621679281044 -> *) (IdSym0 a6989586621679281044) Source # 

Methods

suppressUnusedWarnings :: Proxy (IdSym0 a6989586621679281044) t -> () Source #

type Apply a a (IdSym0 a) l Source # 
type Apply a a (IdSym0 a) l = Id a l

type IdSym1 (t :: a6989586621679281044) = Id t Source #

data ConstSym0 (l :: TyFun a6989586621679281042 (TyFun b6989586621679281043 a6989586621679281042 -> Type)) Source #

Instances

SuppressUnusedWarnings (TyFun a6989586621679281042 (TyFun b6989586621679281043 a6989586621679281042 -> Type) -> *) (ConstSym0 b6989586621679281043 a6989586621679281042) Source # 

Methods

suppressUnusedWarnings :: Proxy (ConstSym0 b6989586621679281043 a6989586621679281042) t -> () Source #

type Apply a6989586621679281042 (TyFun b6989586621679281043 a6989586621679281042 -> Type) (ConstSym0 b6989586621679281043 a6989586621679281042) l Source # 
type Apply a6989586621679281042 (TyFun b6989586621679281043 a6989586621679281042 -> Type) (ConstSym0 b6989586621679281043 a6989586621679281042) l = ConstSym1 b6989586621679281043 a6989586621679281042 l

data ConstSym1 (l :: a6989586621679281042) (l :: TyFun b6989586621679281043 a6989586621679281042) Source #

Instances

SuppressUnusedWarnings (a6989586621679281042 -> TyFun b6989586621679281043 a6989586621679281042 -> *) (ConstSym1 b6989586621679281043 a6989586621679281042) Source # 

Methods

suppressUnusedWarnings :: Proxy (ConstSym1 b6989586621679281043 a6989586621679281042) t -> () Source #

type Apply b a (ConstSym1 b a l1) l2 Source # 
type Apply b a (ConstSym1 b a l1) l2 = Const b a l1 l2

type ConstSym2 (t :: a6989586621679281042) (t :: b6989586621679281043) = Const t t Source #

data (:.$) (l :: TyFun (TyFun b6989586621679281039 c6989586621679281040 -> Type) (TyFun (TyFun a6989586621679281041 b6989586621679281039 -> Type) (TyFun a6989586621679281041 c6989586621679281040 -> Type) -> Type)) Source #

Instances

SuppressUnusedWarnings (TyFun (TyFun b6989586621679281039 c6989586621679281040 -> Type) (TyFun (TyFun a6989586621679281041 b6989586621679281039 -> Type) (TyFun a6989586621679281041 c6989586621679281040 -> Type) -> Type) -> *) ((:.$) b6989586621679281039 a6989586621679281041 c6989586621679281040) Source # 

Methods

suppressUnusedWarnings :: Proxy ((b6989586621679281039 :.$ a6989586621679281041) c6989586621679281040) t -> () Source #

type Apply (TyFun b6989586621679281039 c6989586621679281040 -> Type) (TyFun (TyFun a6989586621679281041 b6989586621679281039 -> Type) (TyFun a6989586621679281041 c6989586621679281040 -> Type) -> Type) ((:.$) b6989586621679281039 a6989586621679281041 c6989586621679281040) l Source # 
type Apply (TyFun b6989586621679281039 c6989586621679281040 -> Type) (TyFun (TyFun a6989586621679281041 b6989586621679281039 -> Type) (TyFun a6989586621679281041 c6989586621679281040 -> Type) -> Type) ((:.$) b6989586621679281039 a6989586621679281041 c6989586621679281040) l = (:.$$) b6989586621679281039 a6989586621679281041 c6989586621679281040 l

data (l :: TyFun b6989586621679281039 c6989586621679281040 -> Type) :.$$ (l :: TyFun (TyFun a6989586621679281041 b6989586621679281039 -> Type) (TyFun a6989586621679281041 c6989586621679281040 -> Type)) Source #

Instances

SuppressUnusedWarnings ((TyFun b6989586621679281039 c6989586621679281040 -> Type) -> TyFun (TyFun a6989586621679281041 b6989586621679281039 -> Type) (TyFun a6989586621679281041 c6989586621679281040 -> Type) -> *) ((:.$$) b6989586621679281039 a6989586621679281041 c6989586621679281040) Source # 

Methods

suppressUnusedWarnings :: Proxy ((b6989586621679281039 :.$$ a6989586621679281041) c6989586621679281040) t -> () Source #

type Apply (TyFun a6989586621679281041 b6989586621679281039 -> Type) (TyFun a6989586621679281041 c6989586621679281040 -> Type) ((:.$$) b6989586621679281039 a6989586621679281041 c6989586621679281040 l1) l2 Source # 
type Apply (TyFun a6989586621679281041 b6989586621679281039 -> Type) (TyFun a6989586621679281041 c6989586621679281040 -> Type) ((:.$$) b6989586621679281039 a6989586621679281041 c6989586621679281040 l1) l2 = (:.$$$) b6989586621679281039 a6989586621679281041 c6989586621679281040 l1 l2

data ((l :: TyFun b6989586621679281039 c6989586621679281040 -> Type) :.$$$ (l :: TyFun a6989586621679281041 b6989586621679281039 -> Type)) (l :: TyFun a6989586621679281041 c6989586621679281040) Source #

Instances

SuppressUnusedWarnings ((TyFun b6989586621679281039 c6989586621679281040 -> Type) -> (TyFun a6989586621679281041 b6989586621679281039 -> Type) -> TyFun a6989586621679281041 c6989586621679281040 -> *) ((:.$$$) b6989586621679281039 a6989586621679281041 c6989586621679281040) Source # 

Methods

suppressUnusedWarnings :: Proxy ((b6989586621679281039 :.$$$ a6989586621679281041) c6989586621679281040) t -> () Source #

type Apply a c ((:.$$$) b a c l1 l2) l3 Source # 
type Apply a c ((:.$$$) b a c l1 l2) l3 = (:.) b a c l1 l2 l3

type (:.$$$$) (t :: TyFun b6989586621679281039 c6989586621679281040 -> Type) (t :: TyFun a6989586621679281041 b6989586621679281039 -> Type) (t :: a6989586621679281041) = (:.) t t t Source #

data FlipSym0 (l :: TyFun (TyFun a6989586621679281036 (TyFun b6989586621679281037 c6989586621679281038 -> Type) -> Type) (TyFun b6989586621679281037 (TyFun a6989586621679281036 c6989586621679281038 -> Type) -> Type)) Source #

Instances

SuppressUnusedWarnings (TyFun (TyFun a6989586621679281036 (TyFun b6989586621679281037 c6989586621679281038 -> Type) -> Type) (TyFun b6989586621679281037 (TyFun a6989586621679281036 c6989586621679281038 -> Type) -> Type) -> *) (FlipSym0 b6989586621679281037 a6989586621679281036 c6989586621679281038) Source # 

Methods

suppressUnusedWarnings :: Proxy (FlipSym0 b6989586621679281037 a6989586621679281036 c6989586621679281038) t -> () Source #

type Apply (TyFun a6989586621679281036 (TyFun b6989586621679281037 c6989586621679281038 -> Type) -> Type) (TyFun b6989586621679281037 (TyFun a6989586621679281036 c6989586621679281038 -> Type) -> Type) (FlipSym0 b6989586621679281037 a6989586621679281036 c6989586621679281038) l Source # 
type Apply (TyFun a6989586621679281036 (TyFun b6989586621679281037 c6989586621679281038 -> Type) -> Type) (TyFun b6989586621679281037 (TyFun a6989586621679281036 c6989586621679281038 -> Type) -> Type) (FlipSym0 b6989586621679281037 a6989586621679281036 c6989586621679281038) l = FlipSym1 b6989586621679281037 a6989586621679281036 c6989586621679281038 l

data FlipSym1 (l :: TyFun a6989586621679281036 (TyFun b6989586621679281037 c6989586621679281038 -> Type) -> Type) (l :: TyFun b6989586621679281037 (TyFun a6989586621679281036 c6989586621679281038 -> Type)) Source #

Instances

SuppressUnusedWarnings ((TyFun a6989586621679281036 (TyFun b6989586621679281037 c6989586621679281038 -> Type) -> Type) -> TyFun b6989586621679281037 (TyFun a6989586621679281036 c6989586621679281038 -> Type) -> *) (FlipSym1 b6989586621679281037 a6989586621679281036 c6989586621679281038) Source # 

Methods

suppressUnusedWarnings :: Proxy (FlipSym1 b6989586621679281037 a6989586621679281036 c6989586621679281038) t -> () Source #

type Apply b6989586621679281037 (TyFun a6989586621679281036 c6989586621679281038 -> Type) (FlipSym1 b6989586621679281037 a6989586621679281036 c6989586621679281038 l1) l2 Source # 
type Apply b6989586621679281037 (TyFun a6989586621679281036 c6989586621679281038 -> Type) (FlipSym1 b6989586621679281037 a6989586621679281036 c6989586621679281038 l1) l2 = FlipSym2 b6989586621679281037 a6989586621679281036 c6989586621679281038 l1 l2

data FlipSym2 (l :: TyFun a6989586621679281036 (TyFun b6989586621679281037 c6989586621679281038 -> Type) -> Type) (l :: b6989586621679281037) (l :: TyFun a6989586621679281036 c6989586621679281038) Source #

Instances

SuppressUnusedWarnings ((TyFun a6989586621679281036 (TyFun b6989586621679281037 c6989586621679281038 -> Type) -> Type) -> b6989586621679281037 -> TyFun a6989586621679281036 c6989586621679281038 -> *) (FlipSym2 b6989586621679281037 a6989586621679281036 c6989586621679281038) Source # 

Methods

suppressUnusedWarnings :: Proxy (FlipSym2 b6989586621679281037 a6989586621679281036 c6989586621679281038) t -> () Source #

type Apply a c (FlipSym2 b a c l1 l2) l3 Source # 
type Apply a c (FlipSym2 b a c l1 l2) l3 = Flip b a c l1 l2 l3

type FlipSym3 (t :: TyFun a6989586621679281036 (TyFun b6989586621679281037 c6989586621679281038 -> Type) -> Type) (t :: b6989586621679281037) (t :: a6989586621679281036) = Flip t t t Source #

data ($$) :: TyFun (TyFun a b -> *) (TyFun a b -> *) -> * Source #

Instances

type Apply (TyFun a b -> *) (TyFun a b -> *) (($$) a b) arg Source # 
type Apply (TyFun a b -> *) (TyFun a b -> *) (($$) a b) arg = ($$$) a b arg

data ($$$) :: (TyFun a b -> *) -> TyFun a b -> * Source #

Instances

type Apply a k (($$$) a k f) arg Source # 
type Apply a k (($$$) a k f) arg = ($$$$) a k f arg

type ($$$$) a b = ($) a b Source #

data (:&$) (l :: TyFun a6989586621679292901 (TyFun (TyFun a6989586621679292901 b6989586621679292902 -> Type) b6989586621679292902 -> Type)) Source #

Instances

SuppressUnusedWarnings (TyFun a6989586621679292901 (TyFun (TyFun a6989586621679292901 b6989586621679292902 -> Type) b6989586621679292902 -> Type) -> *) ((:&$) a6989586621679292901 b6989586621679292902) Source # 

Methods

suppressUnusedWarnings :: Proxy (a6989586621679292901 :&$ b6989586621679292902) t -> () Source #

type Apply a6989586621679292901 (TyFun (TyFun a6989586621679292901 b6989586621679292902 -> Type) b6989586621679292902 -> Type) ((:&$) a6989586621679292901 b6989586621679292902) l Source # 
type Apply a6989586621679292901 (TyFun (TyFun a6989586621679292901 b6989586621679292902 -> Type) b6989586621679292902 -> Type) ((:&$) a6989586621679292901 b6989586621679292902) l = (:&$$) a6989586621679292901 b6989586621679292902 l

data (l :: a6989586621679292901) :&$$ (l :: TyFun (TyFun a6989586621679292901 b6989586621679292902 -> Type) b6989586621679292902) Source #

Instances

SuppressUnusedWarnings (a6989586621679292901 -> TyFun (TyFun a6989586621679292901 b6989586621679292902 -> Type) b6989586621679292902 -> *) ((:&$$) a6989586621679292901 b6989586621679292902) Source # 

Methods

suppressUnusedWarnings :: Proxy (a6989586621679292901 :&$$ b6989586621679292902) t -> () Source #

type Apply (TyFun a b -> Type) b ((:&$$) a b l1) l2 Source # 
type Apply (TyFun a b -> Type) b ((:&$$) a b l1) l2 = (:&) a b l1 l2

type (:&$$$) (t :: a6989586621679292901) (t :: TyFun a6989586621679292901 b6989586621679292902 -> Type) = (:&) t t Source #

data OnSym0 (l :: TyFun (TyFun b6989586621679292903 (TyFun b6989586621679292903 c6989586621679292904 -> Type) -> Type) (TyFun (TyFun a6989586621679292905 b6989586621679292903 -> Type) (TyFun a6989586621679292905 (TyFun a6989586621679292905 c6989586621679292904 -> Type) -> Type) -> Type)) Source #

Instances

SuppressUnusedWarnings (TyFun (TyFun b6989586621679292903 (TyFun b6989586621679292903 c6989586621679292904 -> Type) -> Type) (TyFun (TyFun a6989586621679292905 b6989586621679292903 -> Type) (TyFun a6989586621679292905 (TyFun a6989586621679292905 c6989586621679292904 -> Type) -> Type) -> Type) -> *) (OnSym0 b6989586621679292903 a6989586621679292905 c6989586621679292904) Source # 

Methods

suppressUnusedWarnings :: Proxy (OnSym0 b6989586621679292903 a6989586621679292905 c6989586621679292904) t -> () Source #

type Apply (TyFun b6989586621679292903 (TyFun b6989586621679292903 c6989586621679292904 -> Type) -> Type) (TyFun (TyFun a6989586621679292905 b6989586621679292903 -> Type) (TyFun a6989586621679292905 (TyFun a6989586621679292905 c6989586621679292904 -> Type) -> Type) -> Type) (OnSym0 b6989586621679292903 a6989586621679292905 c6989586621679292904) l Source # 
type Apply (TyFun b6989586621679292903 (TyFun b6989586621679292903 c6989586621679292904 -> Type) -> Type) (TyFun (TyFun a6989586621679292905 b6989586621679292903 -> Type) (TyFun a6989586621679292905 (TyFun a6989586621679292905 c6989586621679292904 -> Type) -> Type) -> Type) (OnSym0 b6989586621679292903 a6989586621679292905 c6989586621679292904) l = OnSym1 b6989586621679292903 a6989586621679292905 c6989586621679292904 l

data OnSym1 (l :: TyFun b6989586621679292903 (TyFun b6989586621679292903 c6989586621679292904 -> Type) -> Type) (l :: TyFun (TyFun a6989586621679292905 b6989586621679292903 -> Type) (TyFun a6989586621679292905 (TyFun a6989586621679292905 c6989586621679292904 -> Type) -> Type)) Source #

Instances

SuppressUnusedWarnings ((TyFun b6989586621679292903 (TyFun b6989586621679292903 c6989586621679292904 -> Type) -> Type) -> TyFun (TyFun a6989586621679292905 b6989586621679292903 -> Type) (TyFun a6989586621679292905 (TyFun a6989586621679292905 c6989586621679292904 -> Type) -> Type) -> *) (OnSym1 b6989586621679292903 a6989586621679292905 c6989586621679292904) Source # 

Methods

suppressUnusedWarnings :: Proxy (OnSym1 b6989586621679292903 a6989586621679292905 c6989586621679292904) t -> () Source #

type Apply (TyFun a6989586621679292905 b6989586621679292903 -> Type) (TyFun a6989586621679292905 (TyFun a6989586621679292905 c6989586621679292904 -> Type) -> Type) (OnSym1 b6989586621679292903 a6989586621679292905 c6989586621679292904 l1) l2 Source # 
type Apply (TyFun a6989586621679292905 b6989586621679292903 -> Type) (TyFun a6989586621679292905 (TyFun a6989586621679292905 c6989586621679292904 -> Type) -> Type) (OnSym1 b6989586621679292903 a6989586621679292905 c6989586621679292904 l1) l2 = OnSym2 b6989586621679292903 a6989586621679292905 c6989586621679292904 l1 l2

data OnSym2 (l :: TyFun b6989586621679292903 (TyFun b6989586621679292903 c6989586621679292904 -> Type) -> Type) (l :: TyFun a6989586621679292905 b6989586621679292903 -> Type) (l :: TyFun a6989586621679292905 (TyFun a6989586621679292905 c6989586621679292904 -> Type)) Source #

Instances

SuppressUnusedWarnings ((TyFun b6989586621679292903 (TyFun b6989586621679292903 c6989586621679292904 -> Type) -> Type) -> (TyFun a6989586621679292905 b6989586621679292903 -> Type) -> TyFun a6989586621679292905 (TyFun a6989586621679292905 c6989586621679292904 -> Type) -> *) (OnSym2 b6989586621679292903 a6989586621679292905 c6989586621679292904) Source # 

Methods

suppressUnusedWarnings :: Proxy (OnSym2 b6989586621679292903 a6989586621679292905 c6989586621679292904) t -> () Source #

type Apply a6989586621679292905 (TyFun a6989586621679292905 c6989586621679292904 -> Type) (OnSym2 b6989586621679292903 a6989586621679292905 c6989586621679292904 l1 l2) l3 Source # 
type Apply a6989586621679292905 (TyFun a6989586621679292905 c6989586621679292904 -> Type) (OnSym2 b6989586621679292903 a6989586621679292905 c6989586621679292904 l1 l2) l3 = OnSym3 b6989586621679292903 a6989586621679292905 c6989586621679292904 l1 l2 l3

data OnSym3 (l :: TyFun b6989586621679292903 (TyFun b6989586621679292903 c6989586621679292904 -> Type) -> Type) (l :: TyFun a6989586621679292905 b6989586621679292903 -> Type) (l :: a6989586621679292905) (l :: TyFun a6989586621679292905 c6989586621679292904) Source #

Instances

SuppressUnusedWarnings ((TyFun b6989586621679292903 (TyFun b6989586621679292903 c6989586621679292904 -> Type) -> Type) -> (TyFun a6989586621679292905 b6989586621679292903 -> Type) -> a6989586621679292905 -> TyFun a6989586621679292905 c6989586621679292904 -> *) (OnSym3 b6989586621679292903 a6989586621679292905 c6989586621679292904) Source # 

Methods

suppressUnusedWarnings :: Proxy (OnSym3 b6989586621679292903 a6989586621679292905 c6989586621679292904) t -> () Source #

type Apply a c (OnSym3 b a c l1 l2 l3) l4 Source # 
type Apply a c (OnSym3 b a c l1 l2 l3) l4 = On b a c l1 l2 l3 l4

type OnSym4 (t :: TyFun b6989586621679292903 (TyFun b6989586621679292903 c6989586621679292904 -> Type) -> Type) (t :: TyFun a6989586621679292905 b6989586621679292903 -> Type) (t :: a6989586621679292905) (t :: a6989586621679292905) = On t t t t Source #