singletons-2.4: 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

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

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

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

Associated Types

type ShowsPrec arg arg arg :: Symbol Source #

type Show_ arg :: Symbol Source #

type ShowList arg arg :: Symbol Source #

PShow () Source # 
Instance details

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

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

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

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

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

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

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

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

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

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

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

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_6989586621679674410Sym0 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__6989586621679674430Sym0 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_6989586621679674448Sym0 t) t) => Sing t -> Sing t -> Sing (Apply (Apply ShowListSym0 t) t :: Symbol) Source #

Instances
SShow Bool Source # 
Instance details
SShow Ordering Source # 
Instance details
SShow Nat Source # 
Instance details
SShow Symbol Source # 
Instance details
SShow () Source # 
Instance details
SShow Void Source # 
Instance details
SShow a => SShow [a] Source # 
Instance details
SShow a => SShow (Maybe a) Source # 
Instance details
(SShow a, SShow [a]) => SShow (NonEmpty a) Source # 
Instance details
(SShow a, SShow b) => SShow (Either a b) Source # 
Instance details
(SShow a, SShow b) => SShow (a, b) Source # 
Instance details
(SShow a, SShow b, SShow c) => SShow (a, b, c) Source # 
Instance details
(SShow a, SShow b, SShow c, SShow d) => SShow (a, b, c, d) Source # 
Instance details
(SShow a, SShow b, SShow c, SShow d, SShow e) => SShow (a, b, c, d, e) Source # 
Instance details
(SShow a, SShow b, SShow c, SShow d, SShow e, SShow f) => SShow (a, b, c, d, e, f) Source # 
Instance details
(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

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_6989586621679674358 = Apply (Apply (Apply ShowsPrecSym0 (FromInteger 0)) s) a_6989586621679674358 

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 (Let6989586621679674320ShowlSym4 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_6989586621679674225 a_6989586621679674227 = Apply (Apply (<>@#@$) a_6989586621679674225) a_6989586621679674227 

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_6989586621679674203 a_6989586621679674205 = Apply (Apply (<>@#@$) a_6989586621679674203) a_6989586621679674205 

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_6989586621679674255 = Apply (Case_6989586621679674260 b p a_6989586621679674255 b) a_6989586621679674255 

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_6989586621679674185 = Apply (Apply Lambda_6989586621679674192Sym0 a_6989586621679674185) a_6989586621679674185 

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

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

Equations

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

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 a6989586621679672338 (TyFun Symbol Symbol -> Type) -> Type)) Source #

Instances
SuppressUnusedWarnings (ShowsPrecSym0 :: TyFun Nat (TyFun a6989586621679672338 (TyFun Symbol Symbol -> Type) -> Type) -> *) Source # 
Instance details
type Apply (ShowsPrecSym0 :: TyFun Nat (TyFun a6989586621679672338 (TyFun Symbol Symbol -> Type) -> Type) -> *) (l :: Nat) Source # 
Instance details
type Apply (ShowsPrecSym0 :: TyFun Nat (TyFun a6989586621679672338 (TyFun Symbol Symbol -> Type) -> Type) -> *) (l :: Nat) = (ShowsPrecSym1 l :: TyFun a6989586621679672338 (TyFun Symbol Symbol -> Type) -> *)

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

Instances
SuppressUnusedWarnings (ShowsPrecSym1 :: Nat -> TyFun a6989586621679672338 (TyFun Symbol Symbol -> Type) -> *) Source # 
Instance details
type Apply (ShowsPrecSym1 l1 :: TyFun a6989586621679672338 (TyFun Symbol Symbol -> Type) -> *) (l2 :: a6989586621679672338) Source # 
Instance details
type Apply (ShowsPrecSym1 l1 :: TyFun a6989586621679672338 (TyFun Symbol Symbol -> Type) -> *) (l2 :: a6989586621679672338) = ShowsPrecSym2 l1 l2

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

Instances
SuppressUnusedWarnings (ShowsPrecSym2 :: Nat -> a6989586621679672338 -> TyFun Symbol Symbol -> *) Source # 
Instance details
type Apply (ShowsPrecSym2 l1 l2 :: TyFun Symbol Symbol -> *) (l3 :: Symbol) Source # 
Instance details
type Apply (ShowsPrecSym2 l1 l2 :: TyFun Symbol Symbol -> *) (l3 :: Symbol) = ShowsPrec l1 l2 l3

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

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

Instances
SuppressUnusedWarnings (Show_Sym0 :: TyFun a6989586621679672338 Symbol -> *) Source # 
Instance details
type Apply (Show_Sym0 :: TyFun a Symbol -> *) (l :: a) Source # 
Instance details
type Apply (Show_Sym0 :: TyFun a Symbol -> *) (l :: a) = Show_ l

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

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

Instances
SuppressUnusedWarnings (ShowListSym0 :: TyFun [a6989586621679672338] (TyFun Symbol Symbol -> Type) -> *) Source # 
Instance details
type Apply (ShowListSym0 :: TyFun [a6989586621679672338] (TyFun Symbol Symbol -> Type) -> *) (l :: [a6989586621679672338]) Source # 
Instance details
type Apply (ShowListSym0 :: TyFun [a6989586621679672338] (TyFun Symbol Symbol -> Type) -> *) (l :: [a6989586621679672338]) = ShowListSym1 l

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

Instances
SuppressUnusedWarnings (ShowListSym1 :: [a6989586621679672338] -> TyFun Symbol Symbol -> *) Source # 
Instance details
type Apply (ShowListSym1 l1 :: TyFun Symbol Symbol -> *) (l2 :: Symbol) Source # 
Instance details
type Apply (ShowListSym1 l1 :: TyFun Symbol Symbol -> *) (l2 :: Symbol) = ShowList l1 l2

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

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

Instances
SuppressUnusedWarnings (<>@#@$) Source # 
Instance details
type Apply (<>@#@$) (l :: Symbol) Source # 
Instance details
type Apply (<>@#@$) (l :: Symbol) = (<>@#@$$) l

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

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

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

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

Instances
SuppressUnusedWarnings (ShowsSym0 :: TyFun a6989586621679672323 (TyFun Symbol Symbol -> Type) -> *) Source # 
Instance details
type Apply (ShowsSym0 :: TyFun a6989586621679672323 (TyFun Symbol Symbol -> Type) -> *) (l :: a6989586621679672323) Source # 
Instance details
type Apply (ShowsSym0 :: TyFun a6989586621679672323 (TyFun Symbol Symbol -> Type) -> *) (l :: a6989586621679672323) = ShowsSym1 l

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

Instances
SuppressUnusedWarnings (ShowsSym1 :: a6989586621679672323 -> TyFun Symbol Symbol -> *) Source # 
Instance details
type Apply (ShowsSym1 l1 :: TyFun Symbol Symbol -> *) (l2 :: Symbol) Source # 
Instance details
type Apply (ShowsSym1 l1 :: TyFun Symbol Symbol -> *) (l2 :: Symbol) = Shows l1 l2

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

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

Instances
SuppressUnusedWarnings (ShowListWithSym0 :: TyFun (TyFun a6989586621679672322 (TyFun Symbol Symbol -> Type) -> Type) (TyFun [a6989586621679672322] (TyFun Symbol Symbol -> Type) -> Type) -> *) Source # 
Instance details
type Apply (ShowListWithSym0 :: TyFun (TyFun a6989586621679672322 (TyFun Symbol Symbol -> Type) -> Type) (TyFun [a6989586621679672322] (TyFun Symbol Symbol -> Type) -> Type) -> *) (l :: TyFun a6989586621679672322 (TyFun Symbol Symbol -> Type) -> Type) Source # 
Instance details
type Apply (ShowListWithSym0 :: TyFun (TyFun a6989586621679672322 (TyFun Symbol Symbol -> Type) -> Type) (TyFun [a6989586621679672322] (TyFun Symbol Symbol -> Type) -> Type) -> *) (l :: TyFun a6989586621679672322 (TyFun Symbol Symbol -> Type) -> Type) = ShowListWithSym1 l

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

Instances
SuppressUnusedWarnings (ShowListWithSym1 :: (TyFun a6989586621679672322 (TyFun Symbol Symbol -> Type) -> Type) -> TyFun [a6989586621679672322] (TyFun Symbol Symbol -> Type) -> *) Source # 
Instance details
type Apply (ShowListWithSym1 l1 :: TyFun [a6989586621679672322] (TyFun Symbol Symbol -> Type) -> *) (l2 :: [a6989586621679672322]) Source # 
Instance details
type Apply (ShowListWithSym1 l1 :: TyFun [a6989586621679672322] (TyFun Symbol Symbol -> Type) -> *) (l2 :: [a6989586621679672322]) = ShowListWithSym2 l1 l2

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

Instances
SuppressUnusedWarnings (ShowListWithSym2 :: (TyFun a6989586621679672322 (TyFun Symbol Symbol -> Type) -> Type) -> [a6989586621679672322] -> TyFun Symbol Symbol -> *) Source # 
Instance details
type Apply (ShowListWithSym2 l1 l2 :: TyFun Symbol Symbol -> *) (l3 :: Symbol) Source # 
Instance details
type Apply (ShowListWithSym2 l1 l2 :: TyFun Symbol Symbol -> *) (l3 :: Symbol) = ShowListWith l1 l2 l3

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

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

Instances
SuppressUnusedWarnings ShowCharSym0 Source # 
Instance details
type Apply ShowCharSym0 (l :: Symbol) Source # 
Instance details

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

Instances
SuppressUnusedWarnings ShowCharSym1 Source # 
Instance details
type Apply (ShowCharSym1 l1 :: TyFun Symbol Symbol -> *) (l2 :: Symbol) Source # 
Instance details
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
type Apply (ShowStringSym1 l1 :: TyFun Symbol Symbol -> *) (l2 :: Symbol) Source # 
Instance details
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
type Apply (ShowParenSym2 l1 l2 :: TyFun Symbol Symbol -> *) (l3 :: Symbol) Source # 
Instance details
type Apply (ShowParenSym2 l1 l2 :: TyFun Symbol Symbol -> *) (l3 :: Symbol) = ShowParen l1 l2 l3

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

Instances
SuppressUnusedWarnings ShowSpaceSym0 Source # 
Instance details
type Apply ShowSpaceSym0 (l :: Symbol) Source # 
Instance details