singletons-2.3: 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.Promotion.Prelude.Function

Contents

Description

Defines promoted functions from 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 

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

Equations

Const x _z_6989586621679278034 = x 

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

Equations

(f :. g) a_6989586621679277997 = Apply (Apply (Apply (Apply Lambda_6989586621679278002Sym0 f) g) a_6989586621679277997) a_6989586621679277997 

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 

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

Other combinators

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

Equations

x :& f = Apply f x 

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_6989586621679289818 a_6989586621679289820 = Apply (Apply (Apply (Apply (Apply (Apply Lambda_6989586621679289826Sym0 ty) f) a_6989586621679289818) a_6989586621679289820) a_6989586621679289818) a_6989586621679289820 

Defunctionalization symbols

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

Instances

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

Methods

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

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

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

data ConstSym0 (l :: TyFun a6989586621679277913 (TyFun b6989586621679277914 a6989586621679277913 -> Type)) Source #

Instances

SuppressUnusedWarnings (TyFun a6989586621679277913 (TyFun b6989586621679277914 a6989586621679277913 -> Type) -> *) (ConstSym0 b6989586621679277914 a6989586621679277913) Source # 

Methods

suppressUnusedWarnings :: Proxy (ConstSym0 b6989586621679277914 a6989586621679277913) t -> () Source #

type Apply a6989586621679277913 (TyFun b6989586621679277914 a6989586621679277913 -> Type) (ConstSym0 b6989586621679277914 a6989586621679277913) l Source # 
type Apply a6989586621679277913 (TyFun b6989586621679277914 a6989586621679277913 -> Type) (ConstSym0 b6989586621679277914 a6989586621679277913) l = ConstSym1 b6989586621679277914 a6989586621679277913 l

data ConstSym1 (l :: a6989586621679277913) (l :: TyFun b6989586621679277914 a6989586621679277913) Source #

Instances

SuppressUnusedWarnings (a6989586621679277913 -> TyFun b6989586621679277914 a6989586621679277913 -> *) (ConstSym1 b6989586621679277914 a6989586621679277913) Source # 

Methods

suppressUnusedWarnings :: Proxy (ConstSym1 b6989586621679277914 a6989586621679277913) 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 :: a6989586621679277913) (t :: b6989586621679277914) = Const t t Source #

data (:.$) (l :: TyFun (TyFun b6989586621679277910 c6989586621679277911 -> Type) (TyFun (TyFun a6989586621679277912 b6989586621679277910 -> Type) (TyFun a6989586621679277912 c6989586621679277911 -> Type) -> Type)) Source #

Instances

SuppressUnusedWarnings (TyFun (TyFun b6989586621679277910 c6989586621679277911 -> Type) (TyFun (TyFun a6989586621679277912 b6989586621679277910 -> Type) (TyFun a6989586621679277912 c6989586621679277911 -> Type) -> Type) -> *) ((:.$) b6989586621679277910 a6989586621679277912 c6989586621679277911) Source # 

Methods

suppressUnusedWarnings :: Proxy ((b6989586621679277910 :.$ a6989586621679277912) c6989586621679277911) t -> () Source #

type Apply (TyFun b6989586621679277910 c6989586621679277911 -> Type) (TyFun (TyFun a6989586621679277912 b6989586621679277910 -> Type) (TyFun a6989586621679277912 c6989586621679277911 -> Type) -> Type) ((:.$) b6989586621679277910 a6989586621679277912 c6989586621679277911) l Source # 
type Apply (TyFun b6989586621679277910 c6989586621679277911 -> Type) (TyFun (TyFun a6989586621679277912 b6989586621679277910 -> Type) (TyFun a6989586621679277912 c6989586621679277911 -> Type) -> Type) ((:.$) b6989586621679277910 a6989586621679277912 c6989586621679277911) l = (:.$$) b6989586621679277910 a6989586621679277912 c6989586621679277911 l

data (l :: TyFun b6989586621679277910 c6989586621679277911 -> Type) :.$$ (l :: TyFun (TyFun a6989586621679277912 b6989586621679277910 -> Type) (TyFun a6989586621679277912 c6989586621679277911 -> Type)) Source #

Instances

SuppressUnusedWarnings ((TyFun b6989586621679277910 c6989586621679277911 -> Type) -> TyFun (TyFun a6989586621679277912 b6989586621679277910 -> Type) (TyFun a6989586621679277912 c6989586621679277911 -> Type) -> *) ((:.$$) b6989586621679277910 a6989586621679277912 c6989586621679277911) Source # 

Methods

suppressUnusedWarnings :: Proxy ((b6989586621679277910 :.$$ a6989586621679277912) c6989586621679277911) t -> () Source #

type Apply (TyFun a6989586621679277912 b6989586621679277910 -> Type) (TyFun a6989586621679277912 c6989586621679277911 -> Type) ((:.$$) b6989586621679277910 a6989586621679277912 c6989586621679277911 l1) l2 Source # 
type Apply (TyFun a6989586621679277912 b6989586621679277910 -> Type) (TyFun a6989586621679277912 c6989586621679277911 -> Type) ((:.$$) b6989586621679277910 a6989586621679277912 c6989586621679277911 l1) l2 = (:.$$$) b6989586621679277910 a6989586621679277912 c6989586621679277911 l1 l2

data ((l :: TyFun b6989586621679277910 c6989586621679277911 -> Type) :.$$$ (l :: TyFun a6989586621679277912 b6989586621679277910 -> Type)) (l :: TyFun a6989586621679277912 c6989586621679277911) Source #

Instances

SuppressUnusedWarnings ((TyFun b6989586621679277910 c6989586621679277911 -> Type) -> (TyFun a6989586621679277912 b6989586621679277910 -> Type) -> TyFun a6989586621679277912 c6989586621679277911 -> *) ((:.$$$) b6989586621679277910 a6989586621679277912 c6989586621679277911) Source # 

Methods

suppressUnusedWarnings :: Proxy ((b6989586621679277910 :.$$$ a6989586621679277912) c6989586621679277911) 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 b6989586621679277910 c6989586621679277911 -> Type) (t :: TyFun a6989586621679277912 b6989586621679277910 -> Type) (t :: a6989586621679277912) = (:.) t t t Source #

data FlipSym0 (l :: TyFun (TyFun a6989586621679277907 (TyFun b6989586621679277908 c6989586621679277909 -> Type) -> Type) (TyFun b6989586621679277908 (TyFun a6989586621679277907 c6989586621679277909 -> Type) -> Type)) Source #

Instances

SuppressUnusedWarnings (TyFun (TyFun a6989586621679277907 (TyFun b6989586621679277908 c6989586621679277909 -> Type) -> Type) (TyFun b6989586621679277908 (TyFun a6989586621679277907 c6989586621679277909 -> Type) -> Type) -> *) (FlipSym0 b6989586621679277908 a6989586621679277907 c6989586621679277909) Source # 

Methods

suppressUnusedWarnings :: Proxy (FlipSym0 b6989586621679277908 a6989586621679277907 c6989586621679277909) t -> () Source #

type Apply (TyFun a6989586621679277907 (TyFun b6989586621679277908 c6989586621679277909 -> Type) -> Type) (TyFun b6989586621679277908 (TyFun a6989586621679277907 c6989586621679277909 -> Type) -> Type) (FlipSym0 b6989586621679277908 a6989586621679277907 c6989586621679277909) l Source # 
type Apply (TyFun a6989586621679277907 (TyFun b6989586621679277908 c6989586621679277909 -> Type) -> Type) (TyFun b6989586621679277908 (TyFun a6989586621679277907 c6989586621679277909 -> Type) -> Type) (FlipSym0 b6989586621679277908 a6989586621679277907 c6989586621679277909) l = FlipSym1 b6989586621679277908 a6989586621679277907 c6989586621679277909 l

data FlipSym1 (l :: TyFun a6989586621679277907 (TyFun b6989586621679277908 c6989586621679277909 -> Type) -> Type) (l :: TyFun b6989586621679277908 (TyFun a6989586621679277907 c6989586621679277909 -> Type)) Source #

Instances

SuppressUnusedWarnings ((TyFun a6989586621679277907 (TyFun b6989586621679277908 c6989586621679277909 -> Type) -> Type) -> TyFun b6989586621679277908 (TyFun a6989586621679277907 c6989586621679277909 -> Type) -> *) (FlipSym1 b6989586621679277908 a6989586621679277907 c6989586621679277909) Source # 

Methods

suppressUnusedWarnings :: Proxy (FlipSym1 b6989586621679277908 a6989586621679277907 c6989586621679277909) t -> () Source #

type Apply b6989586621679277908 (TyFun a6989586621679277907 c6989586621679277909 -> Type) (FlipSym1 b6989586621679277908 a6989586621679277907 c6989586621679277909 l1) l2 Source # 
type Apply b6989586621679277908 (TyFun a6989586621679277907 c6989586621679277909 -> Type) (FlipSym1 b6989586621679277908 a6989586621679277907 c6989586621679277909 l1) l2 = FlipSym2 b6989586621679277908 a6989586621679277907 c6989586621679277909 l1 l2

data FlipSym2 (l :: TyFun a6989586621679277907 (TyFun b6989586621679277908 c6989586621679277909 -> Type) -> Type) (l :: b6989586621679277908) (l :: TyFun a6989586621679277907 c6989586621679277909) Source #

Instances

SuppressUnusedWarnings ((TyFun a6989586621679277907 (TyFun b6989586621679277908 c6989586621679277909 -> Type) -> Type) -> b6989586621679277908 -> TyFun a6989586621679277907 c6989586621679277909 -> *) (FlipSym2 b6989586621679277908 a6989586621679277907 c6989586621679277909) Source # 

Methods

suppressUnusedWarnings :: Proxy (FlipSym2 b6989586621679277908 a6989586621679277907 c6989586621679277909) 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 a6989586621679277907 (TyFun b6989586621679277908 c6989586621679277909 -> Type) -> Type) (t :: b6989586621679277908) (t :: a6989586621679277907) = 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 a6989586621679289772 (TyFun (TyFun a6989586621679289772 b6989586621679289773 -> Type) b6989586621679289773 -> Type)) Source #

Instances

SuppressUnusedWarnings (TyFun a6989586621679289772 (TyFun (TyFun a6989586621679289772 b6989586621679289773 -> Type) b6989586621679289773 -> Type) -> *) ((:&$) a6989586621679289772 b6989586621679289773) Source # 

Methods

suppressUnusedWarnings :: Proxy (a6989586621679289772 :&$ b6989586621679289773) t -> () Source #

type Apply a6989586621679289772 (TyFun (TyFun a6989586621679289772 b6989586621679289773 -> Type) b6989586621679289773 -> Type) ((:&$) a6989586621679289772 b6989586621679289773) l Source # 
type Apply a6989586621679289772 (TyFun (TyFun a6989586621679289772 b6989586621679289773 -> Type) b6989586621679289773 -> Type) ((:&$) a6989586621679289772 b6989586621679289773) l = (:&$$) a6989586621679289772 b6989586621679289773 l

data (l :: a6989586621679289772) :&$$ (l :: TyFun (TyFun a6989586621679289772 b6989586621679289773 -> Type) b6989586621679289773) Source #

Instances

SuppressUnusedWarnings (a6989586621679289772 -> TyFun (TyFun a6989586621679289772 b6989586621679289773 -> Type) b6989586621679289773 -> *) ((:&$$) a6989586621679289772 b6989586621679289773) Source # 

Methods

suppressUnusedWarnings :: Proxy (a6989586621679289772 :&$$ b6989586621679289773) 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 :: a6989586621679289772) (t :: TyFun a6989586621679289772 b6989586621679289773 -> Type) = (:&) t t Source #

data OnSym0 (l :: TyFun (TyFun b6989586621679289774 (TyFun b6989586621679289774 c6989586621679289775 -> Type) -> Type) (TyFun (TyFun a6989586621679289776 b6989586621679289774 -> Type) (TyFun a6989586621679289776 (TyFun a6989586621679289776 c6989586621679289775 -> Type) -> Type) -> Type)) Source #

Instances

SuppressUnusedWarnings (TyFun (TyFun b6989586621679289774 (TyFun b6989586621679289774 c6989586621679289775 -> Type) -> Type) (TyFun (TyFun a6989586621679289776 b6989586621679289774 -> Type) (TyFun a6989586621679289776 (TyFun a6989586621679289776 c6989586621679289775 -> Type) -> Type) -> Type) -> *) (OnSym0 b6989586621679289774 a6989586621679289776 c6989586621679289775) Source # 

Methods

suppressUnusedWarnings :: Proxy (OnSym0 b6989586621679289774 a6989586621679289776 c6989586621679289775) t -> () Source #

type Apply (TyFun b6989586621679289774 (TyFun b6989586621679289774 c6989586621679289775 -> Type) -> Type) (TyFun (TyFun a6989586621679289776 b6989586621679289774 -> Type) (TyFun a6989586621679289776 (TyFun a6989586621679289776 c6989586621679289775 -> Type) -> Type) -> Type) (OnSym0 b6989586621679289774 a6989586621679289776 c6989586621679289775) l Source # 
type Apply (TyFun b6989586621679289774 (TyFun b6989586621679289774 c6989586621679289775 -> Type) -> Type) (TyFun (TyFun a6989586621679289776 b6989586621679289774 -> Type) (TyFun a6989586621679289776 (TyFun a6989586621679289776 c6989586621679289775 -> Type) -> Type) -> Type) (OnSym0 b6989586621679289774 a6989586621679289776 c6989586621679289775) l = OnSym1 b6989586621679289774 a6989586621679289776 c6989586621679289775 l

data OnSym1 (l :: TyFun b6989586621679289774 (TyFun b6989586621679289774 c6989586621679289775 -> Type) -> Type) (l :: TyFun (TyFun a6989586621679289776 b6989586621679289774 -> Type) (TyFun a6989586621679289776 (TyFun a6989586621679289776 c6989586621679289775 -> Type) -> Type)) Source #

Instances

SuppressUnusedWarnings ((TyFun b6989586621679289774 (TyFun b6989586621679289774 c6989586621679289775 -> Type) -> Type) -> TyFun (TyFun a6989586621679289776 b6989586621679289774 -> Type) (TyFun a6989586621679289776 (TyFun a6989586621679289776 c6989586621679289775 -> Type) -> Type) -> *) (OnSym1 b6989586621679289774 a6989586621679289776 c6989586621679289775) Source # 

Methods

suppressUnusedWarnings :: Proxy (OnSym1 b6989586621679289774 a6989586621679289776 c6989586621679289775) t -> () Source #

type Apply (TyFun a6989586621679289776 b6989586621679289774 -> Type) (TyFun a6989586621679289776 (TyFun a6989586621679289776 c6989586621679289775 -> Type) -> Type) (OnSym1 b6989586621679289774 a6989586621679289776 c6989586621679289775 l1) l2 Source # 
type Apply (TyFun a6989586621679289776 b6989586621679289774 -> Type) (TyFun a6989586621679289776 (TyFun a6989586621679289776 c6989586621679289775 -> Type) -> Type) (OnSym1 b6989586621679289774 a6989586621679289776 c6989586621679289775 l1) l2 = OnSym2 b6989586621679289774 a6989586621679289776 c6989586621679289775 l1 l2

data OnSym2 (l :: TyFun b6989586621679289774 (TyFun b6989586621679289774 c6989586621679289775 -> Type) -> Type) (l :: TyFun a6989586621679289776 b6989586621679289774 -> Type) (l :: TyFun a6989586621679289776 (TyFun a6989586621679289776 c6989586621679289775 -> Type)) Source #

Instances

SuppressUnusedWarnings ((TyFun b6989586621679289774 (TyFun b6989586621679289774 c6989586621679289775 -> Type) -> Type) -> (TyFun a6989586621679289776 b6989586621679289774 -> Type) -> TyFun a6989586621679289776 (TyFun a6989586621679289776 c6989586621679289775 -> Type) -> *) (OnSym2 b6989586621679289774 a6989586621679289776 c6989586621679289775) Source # 

Methods

suppressUnusedWarnings :: Proxy (OnSym2 b6989586621679289774 a6989586621679289776 c6989586621679289775) t -> () Source #

type Apply a6989586621679289776 (TyFun a6989586621679289776 c6989586621679289775 -> Type) (OnSym2 b6989586621679289774 a6989586621679289776 c6989586621679289775 l1 l2) l3 Source # 
type Apply a6989586621679289776 (TyFun a6989586621679289776 c6989586621679289775 -> Type) (OnSym2 b6989586621679289774 a6989586621679289776 c6989586621679289775 l1 l2) l3 = OnSym3 b6989586621679289774 a6989586621679289776 c6989586621679289775 l1 l2 l3

data OnSym3 (l :: TyFun b6989586621679289774 (TyFun b6989586621679289774 c6989586621679289775 -> Type) -> Type) (l :: TyFun a6989586621679289776 b6989586621679289774 -> Type) (l :: a6989586621679289776) (l :: TyFun a6989586621679289776 c6989586621679289775) Source #

Instances

SuppressUnusedWarnings ((TyFun b6989586621679289774 (TyFun b6989586621679289774 c6989586621679289775 -> Type) -> Type) -> (TyFun a6989586621679289776 b6989586621679289774 -> Type) -> a6989586621679289776 -> TyFun a6989586621679289776 c6989586621679289775 -> *) (OnSym3 b6989586621679289774 a6989586621679289776 c6989586621679289775) Source # 

Methods

suppressUnusedWarnings :: Proxy (OnSym3 b6989586621679289774 a6989586621679289776 c6989586621679289775) 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 b6989586621679289774 (TyFun b6989586621679289774 c6989586621679289775 -> Type) -> Type) (t :: TyFun a6989586621679289776 b6989586621679289774 -> Type) (t :: a6989586621679289776) (t :: a6989586621679289776) = On t t t t Source #