singletons-2.4.1: A framework for generating singleton types

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

Data.Singletons.Prelude.Show

Contents

Description

Defines the SShow singleton version of the Show type class.

Synopsis

Documentation

class PShow (a :: Type) Source #

Associated Types

type ShowsPrec (arg :: Nat) (arg :: a) (arg :: Symbol) :: Symbol Source #

type Show_ (arg :: a) :: Symbol Source #

type ShowList (arg :: [a]) (arg :: Symbol) :: Symbol Source #

Instances
PShow Bool Source # 
Instance details

Defined in Data.Singletons.Prelude.Show

Associated Types

type ShowsPrec arg arg arg :: Symbol Source #

type Show_ arg :: Symbol Source #

type ShowList arg arg :: Symbol Source #

PShow Ordering Source # 
Instance details

Defined in Data.Singletons.Prelude.Show

Associated Types

type ShowsPrec arg arg arg :: Symbol Source #

type Show_ arg :: Symbol Source #

type ShowList arg arg :: Symbol Source #

PShow Nat Source #

Note that this instance is really, really slow, since it uses an inefficient, inductive definition of division behind the hood.

Instance details

Defined in Data.Singletons.Prelude.Show

Associated Types

type ShowsPrec arg arg arg :: Symbol Source #

type Show_ arg :: Symbol Source #

type ShowList arg arg :: Symbol Source #

PShow Symbol Source # 
Instance details

Defined in Data.Singletons.Prelude.Show

Associated Types

type ShowsPrec arg arg arg :: Symbol Source #

type Show_ arg :: Symbol Source #

type ShowList arg arg :: Symbol Source #

PShow () Source # 
Instance details

Defined in Data.Singletons.Prelude.Show

Associated Types

type ShowsPrec arg arg arg :: Symbol Source #

type Show_ arg :: Symbol Source #

type ShowList arg arg :: Symbol Source #

PShow Void Source # 
Instance details

Defined in Data.Singletons.Prelude.Show

Associated Types

type ShowsPrec arg arg arg :: Symbol Source #

type Show_ arg :: Symbol Source #

type ShowList arg arg :: Symbol Source #

PShow [a] Source # 
Instance details

Defined in Data.Singletons.Prelude.Show

Associated Types

type ShowsPrec arg arg arg :: Symbol Source #

type Show_ arg :: Symbol Source #

type ShowList arg arg :: Symbol Source #

PShow (Maybe a) Source # 
Instance details

Defined in Data.Singletons.Prelude.Show

Associated Types

type ShowsPrec arg arg arg :: Symbol Source #

type Show_ arg :: Symbol Source #

type ShowList arg arg :: Symbol Source #

PShow (NonEmpty a) Source # 
Instance details

Defined in Data.Singletons.Prelude.Show

Associated Types

type ShowsPrec arg arg arg :: Symbol Source #

type Show_ arg :: Symbol Source #

type ShowList arg arg :: Symbol Source #

PShow (Either a b) Source # 
Instance details

Defined in Data.Singletons.Prelude.Show

Associated Types

type ShowsPrec arg arg arg :: Symbol Source #

type Show_ arg :: Symbol Source #

type ShowList arg arg :: Symbol Source #

PShow (a, b) Source # 
Instance details

Defined in Data.Singletons.Prelude.Show

Associated Types

type ShowsPrec arg arg arg :: Symbol Source #

type Show_ arg :: Symbol Source #

type ShowList arg arg :: Symbol Source #

PShow (a, b, c) Source # 
Instance details

Defined in Data.Singletons.Prelude.Show

Associated Types

type ShowsPrec arg arg arg :: Symbol Source #

type Show_ arg :: Symbol Source #

type ShowList arg arg :: Symbol Source #

PShow (a, b, c, d) Source # 
Instance details

Defined in Data.Singletons.Prelude.Show

Associated Types

type ShowsPrec arg arg arg :: Symbol Source #

type Show_ arg :: Symbol Source #

type ShowList arg arg :: Symbol Source #

PShow (a, b, c, d, e) Source # 
Instance details

Defined in Data.Singletons.Prelude.Show

Associated Types

type ShowsPrec arg arg arg :: Symbol Source #

type Show_ arg :: Symbol Source #

type ShowList arg arg :: Symbol Source #

PShow (a, b, c, d, e, f) Source # 
Instance details

Defined in Data.Singletons.Prelude.Show

Associated Types

type ShowsPrec arg arg arg :: Symbol Source #

type Show_ arg :: Symbol Source #

type ShowList arg arg :: Symbol Source #

PShow (a, b, c, d, e, f, g) Source # 
Instance details

Defined in Data.Singletons.Prelude.Show

Associated Types

type ShowsPrec arg arg arg :: Symbol Source #

type Show_ arg :: Symbol Source #

type ShowList arg arg :: Symbol Source #

class SShow a where Source #

Methods

sShowsPrec :: forall (t :: Nat) (t :: a) (t :: Symbol). Sing t -> Sing t -> Sing t -> Sing (Apply (Apply (Apply ShowsPrecSym0 t) t) t :: Symbol) Source #

sShow_ :: forall (t :: a). Sing t -> Sing (Apply Show_Sym0 t :: Symbol) Source #

sShowList :: forall (t :: [a]) (t :: Symbol). Sing t -> Sing t -> Sing (Apply (Apply ShowListSym0 t) t :: Symbol) Source #

sShowsPrec :: forall (t :: Nat) (t :: a) (t :: Symbol). ((Apply (Apply (Apply ShowsPrecSym0 t) t) t :: Symbol) ~ Apply (Apply (Apply ShowsPrec_6989586621679731952Sym0 t) t) t) => Sing t -> Sing t -> Sing t -> Sing (Apply (Apply (Apply ShowsPrecSym0 t) t) t :: Symbol) Source #

sShow_ :: forall (t :: a). ((Apply Show_Sym0 t :: Symbol) ~ Apply Show__6989586621679731972Sym0 t) => Sing t -> Sing (Apply Show_Sym0 t :: Symbol) Source #

sShowList :: forall (t :: [a]) (t :: Symbol). ((Apply (Apply ShowListSym0 t) t :: Symbol) ~ Apply (Apply ShowList_6989586621679731990Sym0 t) t) => Sing t -> Sing t -> Sing (Apply (Apply ShowListSym0 t) t :: Symbol) Source #

Instances
SShow Bool Source # 
Instance details

Defined in Data.Singletons.Prelude.Show

SShow Ordering Source # 
Instance details

Defined in Data.Singletons.Prelude.Show

SShow Nat Source # 
Instance details

Defined in Data.Singletons.Prelude.Show

SShow Symbol Source # 
Instance details

Defined in Data.Singletons.Prelude.Show

SShow () Source # 
Instance details

Defined in Data.Singletons.Prelude.Show

SShow Void Source # 
Instance details

Defined in Data.Singletons.Prelude.Show

SShow a => SShow [a] Source # 
Instance details

Defined in Data.Singletons.Prelude.Show

SShow a => SShow (Maybe a) Source # 
Instance details

Defined in Data.Singletons.Prelude.Show

(SShow a, SShow [a]) => SShow (NonEmpty a) Source # 
Instance details

Defined in Data.Singletons.Prelude.Show

(SShow a, SShow b) => SShow (Either a b) Source # 
Instance details

Defined in Data.Singletons.Prelude.Show

(SShow a, SShow b) => SShow (a, b) Source # 
Instance details

Defined in Data.Singletons.Prelude.Show

(SShow a, SShow b, SShow c) => SShow (a, b, c) Source # 
Instance details

Defined in Data.Singletons.Prelude.Show

(SShow a, SShow b, SShow c, SShow d) => SShow (a, b, c, d) Source # 
Instance details

Defined in Data.Singletons.Prelude.Show

(SShow a, SShow b, SShow c, SShow d, SShow e) => SShow (a, b, c, d, e) Source # 
Instance details

Defined in Data.Singletons.Prelude.Show

(SShow a, SShow b, SShow c, SShow d, SShow e, SShow f) => SShow (a, b, c, d, e, f) Source # 
Instance details

Defined in Data.Singletons.Prelude.Show

(SShow a, SShow b, SShow c, SShow d, SShow e, SShow f, SShow g) => SShow (a, b, c, d, e, f, g) Source # 
Instance details

Defined in Data.Singletons.Prelude.Show

type SymbolS = Symbol -> Symbol Source #

The shows functions return a function that prepends the output Symbol to an existing Symbol. This allows constant-time concatenation of results using function composition.

type SChar = Symbol Source #

GHC currently has no notion of type-level Chars, so we fake them with single-character Symbols.

show_ :: Show a => a -> String Source #

show, but with an extra underscore so that its promoted counterpart (Show_) will not clash with the Show class.

type (<>) a b = AppendSymbol a b infixr 6 Source #

The promoted analogue of '(<>)' for Symbols. This uses the special AppendSymbol type family from GHC.TypeLits.

(%<>) :: Sing a -> Sing b -> Sing (a <> b) infixr 6 Source #

The singleton analogue of '(<>)' for Symbols.

type family Shows (a :: a) (a :: Symbol) :: Symbol where ... Source #

Equations

Shows s a_6989586621679731900 = Apply (Apply (Apply ShowsPrecSym0 (FromInteger 0)) s) a_6989586621679731900 

sShows :: forall (t :: a) (t :: Symbol). SShow a => Sing t -> Sing t -> Sing (Apply (Apply ShowsSym0 t) t :: Symbol) Source #

type family ShowListWith (a :: TyFun a (TyFun Symbol Symbol -> Type) -> Type) (a :: [a]) (a :: Symbol) :: Symbol where ... Source #

Equations

ShowListWith _ '[] s = Apply (Apply (<>@#@$) "[]") s 
ShowListWith showx ((:) x xs) s = Apply (Apply (<>@#@$) "[") (Apply (Apply showx x) (Apply (Let6989586621679731862ShowlSym4 showx x xs s) xs)) 

sShowListWith :: forall (t :: TyFun a (TyFun Symbol Symbol -> Type) -> Type) (t :: [a]) (t :: Symbol). Sing t -> Sing t -> Sing t -> Sing (Apply (Apply (Apply ShowListWithSym0 t) t) t :: Symbol) Source #

type family ShowChar (a :: Symbol) (a :: Symbol) :: Symbol where ... Source #

Equations

ShowChar a_6989586621679731767 a_6989586621679731769 = Apply (Apply (<>@#@$) a_6989586621679731767) a_6989586621679731769 

sShowChar :: forall (t :: Symbol) (t :: Symbol). Sing t -> Sing t -> Sing (Apply (Apply ShowCharSym0 t) t :: Symbol) Source #

type family ShowString (a :: Symbol) (a :: Symbol) :: Symbol where ... Source #

Equations

ShowString a_6989586621679731745 a_6989586621679731747 = Apply (Apply (<>@#@$) a_6989586621679731745) a_6989586621679731747 

sShowString :: forall (t :: Symbol) (t :: Symbol). Sing t -> Sing t -> Sing (Apply (Apply ShowStringSym0 t) t :: Symbol) Source #

type family ShowParen (a :: Bool) (a :: TyFun Symbol Symbol -> Type) (a :: Symbol) :: Symbol where ... Source #

Equations

ShowParen b p a_6989586621679731797 = Apply (Case_6989586621679731802 b p a_6989586621679731797 b) a_6989586621679731797 

sShowParen :: forall (t :: Bool) (t :: TyFun Symbol Symbol -> Type) (t :: Symbol). Sing t -> Sing t -> Sing t -> Sing (Apply (Apply (Apply ShowParenSym0 t) t) t :: Symbol) Source #

type family ShowSpace (a :: Symbol) :: Symbol where ... Source #

Equations

ShowSpace a_6989586621679731727 = Apply (Apply Lambda_6989586621679731734Sym0 a_6989586621679731727) a_6989586621679731727 

sShowSpace :: forall (t :: Symbol). Sing t -> Sing (Apply ShowSpaceSym0 t :: Symbol) Source #

type family ShowCommaSpace (a :: Symbol) :: Symbol where ... Source #

Equations

ShowCommaSpace a_6989586621679731760 = Apply (Apply ShowStringSym0 ", ") a_6989586621679731760 

type family AppPrec :: Nat where ... Source #

Equations

AppPrec = FromInteger 10 

type family AppPrec1 :: Nat where ... Source #

Equations

AppPrec1 = FromInteger 11 

Defunctionalization symbols

data ShowsPrecSym0 (l :: TyFun Nat (TyFun a6989586621679729880 (TyFun Symbol Symbol -> Type) -> Type)) Source #

Instances
SuppressUnusedWarnings (ShowsPrecSym0 :: TyFun Nat (TyFun a6989586621679729880 (TyFun Symbol Symbol -> Type) -> Type) -> *) Source # 
Instance details

Defined in Data.Singletons.Prelude.Show

type Apply (ShowsPrecSym0 :: TyFun Nat (TyFun a6989586621679729880 (TyFun Symbol Symbol -> Type) -> Type) -> *) (l :: Nat) Source # 
Instance details

Defined in Data.Singletons.Prelude.Show

type Apply (ShowsPrecSym0 :: TyFun Nat (TyFun a6989586621679729880 (TyFun Symbol Symbol -> Type) -> Type) -> *) (l :: Nat) = (ShowsPrecSym1 l :: TyFun a6989586621679729880 (TyFun Symbol Symbol -> Type) -> *)

data ShowsPrecSym1 (l :: Nat) (l :: TyFun a6989586621679729880 (TyFun Symbol Symbol -> Type)) Source #

Instances
SuppressUnusedWarnings (ShowsPrecSym1 :: Nat -> TyFun a6989586621679729880 (TyFun Symbol Symbol -> Type) -> *) Source # 
Instance details

Defined in Data.Singletons.Prelude.Show

type Apply (ShowsPrecSym1 l1 :: TyFun a6989586621679729880 (TyFun Symbol Symbol -> Type) -> *) (l2 :: a6989586621679729880) Source # 
Instance details

Defined in Data.Singletons.Prelude.Show

type Apply (ShowsPrecSym1 l1 :: TyFun a6989586621679729880 (TyFun Symbol Symbol -> Type) -> *) (l2 :: a6989586621679729880) = ShowsPrecSym2 l1 l2

data ShowsPrecSym2 (l :: Nat) (l :: a6989586621679729880) (l :: TyFun Symbol Symbol) Source #

Instances
SuppressUnusedWarnings (ShowsPrecSym2 :: Nat -> a6989586621679729880 -> TyFun Symbol Symbol -> *) Source # 
Instance details

Defined in Data.Singletons.Prelude.Show

type Apply (ShowsPrecSym2 l1 l2 :: TyFun Symbol Symbol -> *) (l3 :: Symbol) Source # 
Instance details

Defined in Data.Singletons.Prelude.Show

type Apply (ShowsPrecSym2 l1 l2 :: TyFun Symbol Symbol -> *) (l3 :: Symbol) = ShowsPrec l1 l2 l3

type ShowsPrecSym3 (t :: Nat) (t :: a6989586621679729880) (t :: Symbol) = ShowsPrec t t t Source #

data Show_Sym0 (l :: TyFun a6989586621679729880 Symbol) Source #

Instances
SuppressUnusedWarnings (Show_Sym0 :: TyFun a6989586621679729880 Symbol -> *) Source # 
Instance details

Defined in Data.Singletons.Prelude.Show

type Apply (Show_Sym0 :: TyFun a Symbol -> *) (l :: a) Source # 
Instance details

Defined in Data.Singletons.Prelude.Show

type Apply (Show_Sym0 :: TyFun a Symbol -> *) (l :: a) = Show_ l

type Show_Sym1 (t :: a6989586621679729880) = Show_ t Source #

data ShowListSym0 (l :: TyFun [a6989586621679729880] (TyFun Symbol Symbol -> Type)) Source #

Instances
SuppressUnusedWarnings (ShowListSym0 :: TyFun [a6989586621679729880] (TyFun Symbol Symbol -> Type) -> *) Source # 
Instance details

Defined in Data.Singletons.Prelude.Show

type Apply (ShowListSym0 :: TyFun [a6989586621679729880] (TyFun Symbol Symbol -> Type) -> *) (l :: [a6989586621679729880]) Source # 
Instance details

Defined in Data.Singletons.Prelude.Show

type Apply (ShowListSym0 :: TyFun [a6989586621679729880] (TyFun Symbol Symbol -> Type) -> *) (l :: [a6989586621679729880]) = ShowListSym1 l

data ShowListSym1 (l :: [a6989586621679729880]) (l :: TyFun Symbol Symbol) Source #

Instances
SuppressUnusedWarnings (ShowListSym1 :: [a6989586621679729880] -> TyFun Symbol Symbol -> *) Source # 
Instance details

Defined in Data.Singletons.Prelude.Show

type Apply (ShowListSym1 l1 :: TyFun Symbol Symbol -> *) (l2 :: Symbol) Source # 
Instance details

Defined in Data.Singletons.Prelude.Show

type Apply (ShowListSym1 l1 :: TyFun Symbol Symbol -> *) (l2 :: Symbol) = ShowList l1 l2

type ShowListSym2 (t :: [a6989586621679729880]) (t :: Symbol) = ShowList t t Source #

data (l :: Symbol) <>@#@$$ l Source #

Instances
SuppressUnusedWarnings (<>@#@$$) Source # 
Instance details

Defined in Data.Singletons.TypeLits.Internal

type Apply ((<>@#@$$) l1 :: TyFun Symbol Symbol -> *) (l2 :: Symbol) Source # 
Instance details

Defined in Data.Singletons.TypeLits.Internal

type Apply ((<>@#@$$) l1 :: TyFun Symbol Symbol -> *) (l2 :: Symbol) = l1 <> l2

type (<>@#@$$$) (t :: Symbol) (t :: Symbol) = (<>) t t Source #

data ShowsSym0 (l :: TyFun a6989586621679729865 (TyFun Symbol Symbol -> Type)) Source #

Instances
SuppressUnusedWarnings (ShowsSym0 :: TyFun a6989586621679729865 (TyFun Symbol Symbol -> Type) -> *) Source # 
Instance details

Defined in Data.Singletons.Prelude.Show

type Apply (ShowsSym0 :: TyFun a6989586621679729865 (TyFun Symbol Symbol -> Type) -> *) (l :: a6989586621679729865) Source # 
Instance details

Defined in Data.Singletons.Prelude.Show

type Apply (ShowsSym0 :: TyFun a6989586621679729865 (TyFun Symbol Symbol -> Type) -> *) (l :: a6989586621679729865) = ShowsSym1 l

data ShowsSym1 (l :: a6989586621679729865) (l :: TyFun Symbol Symbol) Source #

Instances
SuppressUnusedWarnings (ShowsSym1 :: a6989586621679729865 -> TyFun Symbol Symbol -> *) Source # 
Instance details

Defined in Data.Singletons.Prelude.Show

type Apply (ShowsSym1 l1 :: TyFun Symbol Symbol -> *) (l2 :: Symbol) Source # 
Instance details

Defined in Data.Singletons.Prelude.Show

type Apply (ShowsSym1 l1 :: TyFun Symbol Symbol -> *) (l2 :: Symbol) = Shows l1 l2

type ShowsSym2 (t :: a6989586621679729865) (t :: Symbol) = Shows t t Source #

data ShowListWithSym0 (l :: TyFun (TyFun a6989586621679729864 (TyFun Symbol Symbol -> Type) -> Type) (TyFun [a6989586621679729864] (TyFun Symbol Symbol -> Type) -> Type)) Source #

Instances
SuppressUnusedWarnings (ShowListWithSym0 :: TyFun (TyFun a6989586621679729864 (TyFun Symbol Symbol -> Type) -> Type) (TyFun [a6989586621679729864] (TyFun Symbol Symbol -> Type) -> Type) -> *) Source # 
Instance details

Defined in Data.Singletons.Prelude.Show

type Apply (ShowListWithSym0 :: TyFun (TyFun a6989586621679729864 (TyFun Symbol Symbol -> Type) -> Type) (TyFun [a6989586621679729864] (TyFun Symbol Symbol -> Type) -> Type) -> *) (l :: TyFun a6989586621679729864 (TyFun Symbol Symbol -> Type) -> Type) Source # 
Instance details

Defined in Data.Singletons.Prelude.Show

type Apply (ShowListWithSym0 :: TyFun (TyFun a6989586621679729864 (TyFun Symbol Symbol -> Type) -> Type) (TyFun [a6989586621679729864] (TyFun Symbol Symbol -> Type) -> Type) -> *) (l :: TyFun a6989586621679729864 (TyFun Symbol Symbol -> Type) -> Type) = ShowListWithSym1 l

data ShowListWithSym1 (l :: TyFun a6989586621679729864 (TyFun Symbol Symbol -> Type) -> Type) (l :: TyFun [a6989586621679729864] (TyFun Symbol Symbol -> Type)) Source #

Instances
SuppressUnusedWarnings (ShowListWithSym1 :: (TyFun a6989586621679729864 (TyFun Symbol Symbol -> Type) -> Type) -> TyFun [a6989586621679729864] (TyFun Symbol Symbol -> Type) -> *) Source # 
Instance details

Defined in Data.Singletons.Prelude.Show

type Apply (ShowListWithSym1 l1 :: TyFun [a6989586621679729864] (TyFun Symbol Symbol -> Type) -> *) (l2 :: [a6989586621679729864]) Source # 
Instance details

Defined in Data.Singletons.Prelude.Show

type Apply (ShowListWithSym1 l1 :: TyFun [a6989586621679729864] (TyFun Symbol Symbol -> Type) -> *) (l2 :: [a6989586621679729864]) = ShowListWithSym2 l1 l2

data ShowListWithSym2 (l :: TyFun a6989586621679729864 (TyFun Symbol Symbol -> Type) -> Type) (l :: [a6989586621679729864]) (l :: TyFun Symbol Symbol) Source #

Instances
SuppressUnusedWarnings (ShowListWithSym2 :: (TyFun a6989586621679729864 (TyFun Symbol Symbol -> Type) -> Type) -> [a6989586621679729864] -> TyFun Symbol Symbol -> *) Source # 
Instance details

Defined in Data.Singletons.Prelude.Show

type Apply (ShowListWithSym2 l1 l2 :: TyFun Symbol Symbol -> *) (l3 :: Symbol) Source # 
Instance details

Defined in Data.Singletons.Prelude.Show

type Apply (ShowListWithSym2 l1 l2 :: TyFun Symbol Symbol -> *) (l3 :: Symbol) = ShowListWith l1 l2 l3

type ShowListWithSym3 (t :: TyFun a6989586621679729864 (TyFun Symbol Symbol -> Type) -> Type) (t :: [a6989586621679729864]) (t :: Symbol) = ShowListWith t t t Source #

data ShowCharSym1 (l :: Symbol) (l :: TyFun Symbol Symbol) Source #

Instances
SuppressUnusedWarnings ShowCharSym1 Source # 
Instance details

Defined in Data.Singletons.Prelude.Show

type Apply (ShowCharSym1 l1 :: TyFun Symbol Symbol -> *) (l2 :: Symbol) Source # 
Instance details

Defined in Data.Singletons.Prelude.Show

type Apply (ShowCharSym1 l1 :: TyFun Symbol Symbol -> *) (l2 :: Symbol) = ShowChar l1 l2

type ShowCharSym2 (t :: Symbol) (t :: Symbol) = ShowChar t t Source #

data ShowStringSym1 (l :: Symbol) (l :: TyFun Symbol Symbol) Source #

Instances
SuppressUnusedWarnings ShowStringSym1 Source # 
Instance details

Defined in Data.Singletons.Prelude.Show

type Apply (ShowStringSym1 l1 :: TyFun Symbol Symbol -> *) (l2 :: Symbol) Source # 
Instance details

Defined in Data.Singletons.Prelude.Show

type Apply (ShowStringSym1 l1 :: TyFun Symbol Symbol -> *) (l2 :: Symbol) = ShowString l1 l2

type ShowStringSym2 (t :: Symbol) (t :: Symbol) = ShowString t t Source #

data ShowParenSym2 (l :: Bool) (l :: TyFun Symbol Symbol -> Type) (l :: TyFun Symbol Symbol) Source #

Instances
SuppressUnusedWarnings ShowParenSym2 Source # 
Instance details

Defined in Data.Singletons.Prelude.Show

type Apply (ShowParenSym2 l1 l2 :: TyFun Symbol Symbol -> *) (l3 :: Symbol) Source # 
Instance details

Defined in Data.Singletons.Prelude.Show

type Apply (ShowParenSym2 l1 l2 :: TyFun Symbol Symbol -> *) (l3 :: Symbol) = ShowParen l1 l2 l3