Safe Haskell | Safe-Inferred |
---|---|
Language | Haskell2010 |
This module is intended for internal use only, and may change without warning in subsequent releases.
Synopsis
- type IxList = [Type]
- type NoIx = '[] :: IxList
- type WithIx i = '[i] :: IxList
- type family ShowSymbolWithOrigin symbol origin :: ErrorMessage where ...
- type family ShowSymbolsWithOrigin (fs :: [(Symbol, Symbol)]) :: ErrorMessage where ...
- type family ShowOperators (ops :: [Symbol]) :: ErrorMessage where ...
- type family AppendEliminations a b where ...
- type family ShowEliminations forms :: ErrorMessage where ...
- type family Reverse (xs :: [k]) (acc :: [k]) :: [k] where ...
- type family Curry (xs :: IxList) (y :: Type) :: Type where ...
- type family Append (xs :: [k]) (ys :: [k]) :: [k] where ...
- class CurryCompose xs where
- data IxEq i is js where
- class AppendIndices xs ys ks | xs ys -> ks where
- appendIndices :: IxEq i (Curry xs (Curry ys i)) (Curry ks i)
- type family FirstRight (m1 :: Either e a) (m2 :: Either e a) :: Either e a where ...
- type family FromRight (def :: b) (e :: Either a b) :: b where ...
- type family IsLeft (e :: Either a b) :: Bool where ...
- type family When (p :: Bool) (err :: Constraint) :: Constraint where ...
- type family Unless (p :: Bool) (err :: Constraint) :: Constraint where ...
- type family Defined (f :: k) :: Bool where ...
- type family QuoteType (x :: t) :: ErrorMessage where ...
- type family QuoteSymbol (x :: Symbol) :: ErrorMessage where ...
- type family ToOrdinal (n :: Nat) :: ErrorMessage where ...
- class HasShapeOf (a :: k) (b :: k)
Documentation
type family ShowSymbolWithOrigin symbol origin :: ErrorMessage where ... Source #
ShowSymbolWithOrigin symbol origin = ((('Text " " :<>: QuoteSymbol symbol) :<>: 'Text " (from ") :<>: 'Text origin) :<>: 'Text ")" |
type family ShowSymbolsWithOrigin (fs :: [(Symbol, Symbol)]) :: ErrorMessage where ... Source #
ShowSymbolsWithOrigin '['(symbol, origin)] = ShowSymbolWithOrigin symbol origin | |
ShowSymbolsWithOrigin ('(symbol, origin) ': rest) = ShowSymbolWithOrigin symbol origin :$$: ShowSymbolsWithOrigin rest |
type family ShowOperators (ops :: [Symbol]) :: ErrorMessage where ... Source #
ShowOperators '[op] = QuoteSymbol op :<>: 'Text " (from Optics.Operators)" | |
ShowOperators (op ': rest) = (QuoteSymbol op :<>: 'Text " ") :<>: ShowOperators rest |
type family AppendEliminations a b where ... Source #
AppendEliminations '(fs1, ops1) '(fs2, ops2) = '(Append fs1 fs2, Append ops1 ops2) |
type family ShowEliminations forms :: ErrorMessage where ... Source #
ShowEliminations '(fs, ops) = ShowSymbolsWithOrigin fs :$$: ('Text " " :<>: ShowOperators ops) |
type family Append (xs :: [k]) (ys :: [k]) :: [k] where ... Source #
Append two type-level lists together.
class CurryCompose xs where Source #
Class that is inhabited by all type-level lists xs
, providing the ability
to compose a function under
.Curry
xs
Instances
CurryCompose ('[] :: [Type]) Source # | |
CurryCompose xs => CurryCompose (x ': xs) Source # | |
data IxEq i is js where Source #
Tagged version of 'Data.Type.Equality.(:~:)' for carrying evidence that two index lists in a curried form are equal.
class AppendIndices xs ys ks | xs ys -> ks where Source #
In pseudo (dependent-)Haskell, provide a witness
foldr f (foldr f init xs) ys = foldr f init (ys ++ xs) where f = (->)
Since: 0.4
Instances
xs ~ zs => AppendIndices xs ('[] :: [Type]) zs Source # | If the second list is empty, we can pick the first list even if nothing is known about it. |
Defined in Optics.Internal.Optic.TypeLevel | |
ys ~ zs => AppendIndices ('[] :: [Type]) ys zs Source # | |
Defined in Optics.Internal.Optic.TypeLevel | |
AppendIndices xs ys ks => AppendIndices (x ': xs) ys (x ': ks) Source # | |
Defined in Optics.Internal.Optic.TypeLevel |
type family FirstRight (m1 :: Either e a) (m2 :: Either e a) :: Either e a where ... Source #
If lhs is Right
, return it. Otherwise check rhs.
FirstRight ('Right a) _ = 'Right a | |
FirstRight _ b = b |
type family When (p :: Bool) (err :: Constraint) :: Constraint where ... Source #
Show a custom type error if p
is true.
type family Unless (p :: Bool) (err :: Constraint) :: Constraint where ... Source #
Show a custom type error if p
is false (or stuck).
type family Defined (f :: k) :: Bool where ... Source #
Use with Unless
to detect stuck (undefined) type families.
type family QuoteType (x :: t) :: ErrorMessage where ... Source #
Show a type surrounded by quote marks.
type family QuoteSymbol (x :: Symbol) :: ErrorMessage where ... Source #
Show a symbol surrounded by quote marks.
type family ToOrdinal (n :: Nat) :: ErrorMessage where ... Source #
class HasShapeOf (a :: k) (b :: k) Source #
Derive the shape of a
from the shape of b
.
Instances
a ~ b => HasShapeOf (a :: k) (b :: k) Source # | |
Defined in Optics.Internal.Optic.TypeLevel | |
(fa ~ f a, HasShapeOf f g) => HasShapeOf (fa :: k1) (g b :: k1) Source # | |
Defined in Optics.Internal.Optic.TypeLevel |