Copyright | (C) 2018 Ryan Scott |
---|---|
License | BSD-style (see LICENSE) |
Maintainer | Ryan Scott |
Stability | experimental |
Portability | non-portable |
Safe Haskell | None |
Language | Haskell2010 |
Defines the promoted version of Semigroup
, PSemigroup
, and the
singleton version, SSemigroup
.
Synopsis
- class PSemigroup (a :: Type) where
- class SSemigroup a where
- type family Sing :: k -> Type
- data SMin :: forall a. Min a -> Type where
- data SMax :: forall a. Max a -> Type where
- data SFirst :: forall a. First a -> Type where
- data SLast :: forall a. Last a -> Type where
- data SWrappedMonoid :: forall m. WrappedMonoid m -> Type where
- SWrapMonoid :: forall m (n :: m). {..} -> SWrappedMonoid ('WrapMonoid n)
- data SDual :: forall a. Dual a -> Type where
- data SAll :: All -> Type where
- data SAny :: Any -> Type where
- data SSum :: forall a. Sum a -> Type where
- data SProduct :: forall a. Product a -> Type where
- data SOption :: forall a. Option a -> Type where
- data SArg :: forall a b. Arg a b -> Type where
- type family GetMin (a :: Min (a :: Type)) :: a where ...
- type family GetMax (a :: Max (a :: Type)) :: a where ...
- type family GetFirst (a :: First (a :: Type)) :: a where ...
- type family GetLast (a :: Last (a :: Type)) :: a where ...
- type family UnwrapMonoid (a :: WrappedMonoid (m :: Type)) :: m where ...
- type family GetDual (a :: Dual (a :: Type)) :: a where ...
- type family GetAll (a :: All) :: Bool where ...
- type family GetAny (a :: Any) :: Bool where ...
- type family GetSum (a :: Sum (a :: Type)) :: a where ...
- type family GetProduct (a :: Product (a :: Type)) :: a where ...
- type family GetOption (a :: Option (a :: Type)) :: Maybe a where ...
- option_ :: b -> (a -> b) -> Option a -> b
- sOption_ :: forall b a (t :: b) (t :: (~>) a b) (t :: Option a). Sing t -> Sing t -> Sing t -> Sing (Apply (Apply (Apply Option_Sym0 t) t) t :: b)
- type family Option_ (a :: b) (a :: (~>) a b) (a :: Option a) :: b where ...
- data (<>@#@$) :: forall a6989586621679840612. (~>) a6989586621679840612 ((~>) a6989586621679840612 a6989586621679840612)
- data (<>@#@$$) (arg6989586621679840847 :: a6989586621679840612) :: (~>) a6989586621679840612 a6989586621679840612
- type (<>@#@$$$) (arg6989586621679840847 :: a6989586621679840612) (arg6989586621679840848 :: a6989586621679840612) = (<>) arg6989586621679840847 arg6989586621679840848
- data SconcatSym0 :: forall a6989586621679840612. (~>) (NonEmpty a6989586621679840612) a6989586621679840612
- type SconcatSym1 (arg6989586621679840851 :: NonEmpty a6989586621679840612) = Sconcat arg6989586621679840851
- data MinSym0 :: forall (a6989586621679069715 :: Type). (~>) a6989586621679069715 (Min (a6989586621679069715 :: Type))
- type MinSym1 (t6989586621679850232 :: a6989586621679069715) = 'Min t6989586621679850232
- data GetMinSym0 :: forall (a6989586621679069715 :: Type). (~>) (Min (a6989586621679069715 :: Type)) a6989586621679069715
- type GetMinSym1 (a6989586621679850229 :: Min (a6989586621679069715 :: Type)) = GetMin a6989586621679850229
- data MaxSym0 :: forall (a6989586621679069719 :: Type). (~>) a6989586621679069719 (Max (a6989586621679069719 :: Type))
- type MaxSym1 (t6989586621679850251 :: a6989586621679069719) = 'Max t6989586621679850251
- data GetMaxSym0 :: forall (a6989586621679069719 :: Type). (~>) (Max (a6989586621679069719 :: Type)) a6989586621679069719
- type GetMaxSym1 (a6989586621679850248 :: Max (a6989586621679069719 :: Type)) = GetMax a6989586621679850248
- data FirstSym0 :: forall (a6989586621679069727 :: Type). (~>) a6989586621679069727 (First (a6989586621679069727 :: Type))
- type FirstSym1 (t6989586621679850270 :: a6989586621679069727) = 'First t6989586621679850270
- data GetFirstSym0 :: forall (a6989586621679069727 :: Type). (~>) (First (a6989586621679069727 :: Type)) a6989586621679069727
- type GetFirstSym1 (a6989586621679850267 :: First (a6989586621679069727 :: Type)) = GetFirst a6989586621679850267
- data LastSym0 :: forall (a6989586621679069723 :: Type). (~>) a6989586621679069723 (Last (a6989586621679069723 :: Type))
- type LastSym1 (t6989586621679850289 :: a6989586621679069723) = 'Last t6989586621679850289
- data GetLastSym0 :: forall (a6989586621679069723 :: Type). (~>) (Last (a6989586621679069723 :: Type)) a6989586621679069723
- type GetLastSym1 (a6989586621679850286 :: Last (a6989586621679069723 :: Type)) = GetLast a6989586621679850286
- data WrapMonoidSym0 :: forall (m6989586621679093626 :: Type). (~>) m6989586621679093626 (WrappedMonoid (m6989586621679093626 :: Type))
- type WrapMonoidSym1 (t6989586621679850308 :: m6989586621679093626) = 'WrapMonoid t6989586621679850308
- data UnwrapMonoidSym0 :: forall (m6989586621679093626 :: Type). (~>) (WrappedMonoid (m6989586621679093626 :: Type)) m6989586621679093626
- type UnwrapMonoidSym1 (a6989586621679850305 :: WrappedMonoid (m6989586621679093626 :: Type)) = UnwrapMonoid a6989586621679850305
- data DualSym0 :: forall (a6989586621679091700 :: Type). (~>) a6989586621679091700 (Dual (a6989586621679091700 :: Type))
- type DualSym1 (t6989586621679850147 :: a6989586621679091700) = 'Dual t6989586621679850147
- data GetDualSym0 :: forall (a6989586621679091700 :: Type). (~>) (Dual (a6989586621679091700 :: Type)) a6989586621679091700
- type GetDualSym1 (a6989586621679850144 :: Dual (a6989586621679091700 :: Type)) = GetDual a6989586621679850144
- data AllSym0 :: (~>) Bool All
- type AllSym1 (t6989586621679850161 :: Bool) = 'All t6989586621679850161
- data GetAllSym0 :: (~>) All Bool
- type GetAllSym1 (a6989586621679850158 :: All) = GetAll a6989586621679850158
- data AnySym0 :: (~>) Bool Any
- type AnySym1 (t6989586621679850175 :: Bool) = 'Any t6989586621679850175
- data GetAnySym0 :: (~>) Any Bool
- type GetAnySym1 (a6989586621679850172 :: Any) = GetAny a6989586621679850172
- data SumSym0 :: forall (a6989586621679091685 :: Type). (~>) a6989586621679091685 (Sum (a6989586621679091685 :: Type))
- type SumSym1 (t6989586621679850194 :: a6989586621679091685) = 'Sum t6989586621679850194
- data GetSumSym0 :: forall (a6989586621679091685 :: Type). (~>) (Sum (a6989586621679091685 :: Type)) a6989586621679091685
- type GetSumSym1 (a6989586621679850191 :: Sum (a6989586621679091685 :: Type)) = GetSum a6989586621679850191
- data ProductSym0 :: forall (a6989586621679091690 :: Type). (~>) a6989586621679091690 (Product (a6989586621679091690 :: Type))
- type ProductSym1 (t6989586621679850213 :: a6989586621679091690) = 'Product t6989586621679850213
- data GetProductSym0 :: forall (a6989586621679091690 :: Type). (~>) (Product (a6989586621679091690 :: Type)) a6989586621679091690
- type GetProductSym1 (a6989586621679850210 :: Product (a6989586621679091690 :: Type)) = GetProduct a6989586621679850210
- data OptionSym0 :: forall (a6989586621679069711 :: Type). (~>) (Maybe a6989586621679069711) (Option (a6989586621679069711 :: Type))
- type OptionSym1 (t6989586621679850128 :: Maybe a6989586621679069711) = 'Option t6989586621679850128
- data GetOptionSym0 :: forall (a6989586621679069711 :: Type). (~>) (Option (a6989586621679069711 :: Type)) (Maybe a6989586621679069711)
- type GetOptionSym1 (a6989586621679850125 :: Option (a6989586621679069711 :: Type)) = GetOption a6989586621679850125
- data ArgSym0 :: forall (a6989586621679070612 :: Type) (b6989586621679070613 :: Type). (~>) a6989586621679070612 ((~>) b6989586621679070613 (Arg (a6989586621679070612 :: Type) (b6989586621679070613 :: Type)))
- data ArgSym1 (t6989586621680915597 :: a6989586621679070612 :: Type) :: forall (b6989586621679070613 :: Type). (~>) b6989586621679070613 (Arg (a6989586621679070612 :: Type) (b6989586621679070613 :: Type))
- type ArgSym2 (t6989586621680915597 :: a6989586621679070612) (t6989586621680915598 :: b6989586621679070613) = 'Arg t6989586621680915597 t6989586621680915598
Documentation
class PSemigroup (a :: Type) Source #
Instances
PSemigroup Ordering Source # | |
PSemigroup Symbol Source # | |
PSemigroup () Source # | |
PSemigroup Void Source # | |
PSemigroup All Source # | |
PSemigroup Any Source # | |
PSemigroup [a] Source # | |
PSemigroup (Maybe a) Source # | |
PSemigroup (Min a) Source # | |
PSemigroup (Max a) Source # | |
PSemigroup (First a) Source # | |
PSemigroup (Last a) Source # | |
PSemigroup (WrappedMonoid m) Source # | |
PSemigroup (Option a) Source # | |
PSemigroup (Identity a) Source # | |
PSemigroup (First a) Source # | |
PSemigroup (Last a) Source # | |
PSemigroup (Dual a) Source # | |
PSemigroup (Sum a) Source # | |
PSemigroup (Product a) Source # | |
PSemigroup (Down a) Source # | |
PSemigroup (NonEmpty a) Source # | |
PSemigroup (Either a b) Source # | |
PSemigroup (a, b) Source # | |
PSemigroup (a ~> b) Source # | |
PSemigroup (a, b, c) Source # | |
PSemigroup (Const a b) Source # | |
PSemigroup (a, b, c, d) Source # | |
PSemigroup (a, b, c, d, e) Source # | |
class SSemigroup a where Source #
(%<>) :: forall (t :: a) (t :: a). Sing t -> Sing t -> Sing (Apply (Apply (<>@#@$) t) t :: a) infixr 6 Source #
sSconcat :: forall (t :: NonEmpty a). Sing t -> Sing (Apply SconcatSym0 t :: a) Source #
Instances
type family Sing :: k -> Type Source #
The singleton kind-indexed type family.
Instances
data SWrappedMonoid :: forall m. WrappedMonoid m -> Type where Source #
SWrapMonoid | |
|
Instances
SDecide m => TestCoercion (SWrappedMonoid :: WrappedMonoid m -> Type) Source # | |
Defined in Data.Singletons.Prelude.Semigroup.Internal testCoercion :: forall (a :: k) (b :: k). SWrappedMonoid a -> SWrappedMonoid b -> Maybe (Coercion a b) # | |
SDecide m => TestEquality (SWrappedMonoid :: WrappedMonoid m -> Type) Source # | |
Defined in Data.Singletons.Prelude.Semigroup.Internal testEquality :: forall (a :: k) (b :: k). SWrappedMonoid a -> SWrappedMonoid b -> Maybe (a :~: b) # | |
ShowSing m => Show (SWrappedMonoid z) Source # | |
Defined in Data.Singletons.Prelude.Semigroup showsPrec :: Int -> SWrappedMonoid z -> ShowS # show :: SWrappedMonoid z -> String # showList :: [SWrappedMonoid z] -> ShowS # |
data SAll :: All -> Type where Source #
Instances
SDecide Bool => TestCoercion SAll Source # | |
Defined in Data.Singletons.Prelude.Semigroup.Internal | |
SDecide Bool => TestEquality SAll Source # | |
Defined in Data.Singletons.Prelude.Semigroup.Internal | |
ShowSing Bool => Show (SAll z) Source # | |
data SAny :: Any -> Type where Source #
Instances
SDecide Bool => TestCoercion SAny Source # | |
Defined in Data.Singletons.Prelude.Semigroup.Internal | |
SDecide Bool => TestEquality SAny Source # | |
Defined in Data.Singletons.Prelude.Semigroup.Internal | |
ShowSing Bool => Show (SAny z) Source # | |
data SProduct :: forall a. Product a -> Type where Source #
SProduct | |
|
data SOption :: forall a. Option a -> Type where Source #
Instances
SDecide (Maybe a) => TestCoercion (SOption :: Option a -> Type) Source # | |
Defined in Data.Singletons.Prelude.Semigroup.Internal | |
SDecide (Maybe a) => TestEquality (SOption :: Option a -> Type) Source # | |
Defined in Data.Singletons.Prelude.Semigroup.Internal | |
ShowSing (Maybe a) => Show (SOption z) Source # | |
type family UnwrapMonoid (a :: WrappedMonoid (m :: Type)) :: m where ... Source #
UnwrapMonoid ('WrapMonoid field) = field |
type family GetProduct (a :: Product (a :: Type)) :: a where ... Source #
GetProduct ('Product field) = field |
sOption_ :: forall b a (t :: b) (t :: (~>) a b) (t :: Option a). Sing t -> Sing t -> Sing t -> Sing (Apply (Apply (Apply Option_Sym0 t) t) t :: b) Source #
Defunctionalization symbols
data (<>@#@$) :: forall a6989586621679840612. (~>) a6989586621679840612 ((~>) a6989586621679840612 a6989586621679840612) infixr 6 Source #
Instances
SSemigroup a => SingI ((<>@#@$) :: TyFun a (a ~> a) -> Type) Source # | |
SuppressUnusedWarnings ((<>@#@$) :: TyFun a6989586621679840612 (a6989586621679840612 ~> a6989586621679840612) -> Type) Source # | |
Defined in Data.Singletons.Prelude.Semigroup.Internal suppressUnusedWarnings :: () Source # | |
type Apply ((<>@#@$) :: TyFun a6989586621679840612 (a6989586621679840612 ~> a6989586621679840612) -> Type) (arg6989586621679840847 :: a6989586621679840612) Source # | |
data (<>@#@$$) (arg6989586621679840847 :: a6989586621679840612) :: (~>) a6989586621679840612 a6989586621679840612 infixr 6 Source #
Instances
(SSemigroup a, SingI d) => SingI ((<>@#@$$) d :: TyFun a a -> Type) Source # | |
SuppressUnusedWarnings ((<>@#@$$) arg6989586621679840847 :: TyFun a6989586621679840612 a6989586621679840612 -> Type) Source # | |
Defined in Data.Singletons.Prelude.Semigroup.Internal suppressUnusedWarnings :: () Source # | |
type Apply ((<>@#@$$) arg6989586621679840847 :: TyFun a a -> Type) (arg6989586621679840848 :: a) Source # | |
type (<>@#@$$$) (arg6989586621679840847 :: a6989586621679840612) (arg6989586621679840848 :: a6989586621679840612) = (<>) arg6989586621679840847 arg6989586621679840848 Source #
data SconcatSym0 :: forall a6989586621679840612. (~>) (NonEmpty a6989586621679840612) a6989586621679840612 Source #
Instances
SSemigroup a => SingI (SconcatSym0 :: TyFun (NonEmpty a) a -> Type) Source # | |
Defined in Data.Singletons.Prelude.Semigroup.Internal sing :: Sing SconcatSym0 Source # | |
SuppressUnusedWarnings (SconcatSym0 :: TyFun (NonEmpty a6989586621679840612) a6989586621679840612 -> Type) Source # | |
Defined in Data.Singletons.Prelude.Semigroup.Internal suppressUnusedWarnings :: () Source # | |
type Apply (SconcatSym0 :: TyFun (NonEmpty a) a -> Type) (arg6989586621679840851 :: NonEmpty a) Source # | |
Defined in Data.Singletons.Prelude.Semigroup.Internal |
type SconcatSym1 (arg6989586621679840851 :: NonEmpty a6989586621679840612) = Sconcat arg6989586621679840851 Source #
data MinSym0 :: forall (a6989586621679069715 :: Type). (~>) a6989586621679069715 (Min (a6989586621679069715 :: Type)) Source #
Instances
SingI (MinSym0 :: TyFun a (Min a) -> Type) Source # | |
SuppressUnusedWarnings (MinSym0 :: TyFun a6989586621679069715 (Min a6989586621679069715) -> Type) Source # | |
Defined in Data.Singletons.Prelude.Semigroup.Internal suppressUnusedWarnings :: () Source # | |
type Apply (MinSym0 :: TyFun a (Min a) -> Type) (t6989586621679850232 :: a) Source # | |
data GetMinSym0 :: forall (a6989586621679069715 :: Type). (~>) (Min (a6989586621679069715 :: Type)) a6989586621679069715 Source #
Instances
SuppressUnusedWarnings (GetMinSym0 :: TyFun (Min a6989586621679069715) a6989586621679069715 -> Type) Source # | |
Defined in Data.Singletons.Prelude.Semigroup.Internal suppressUnusedWarnings :: () Source # | |
type Apply (GetMinSym0 :: TyFun (Min a) a -> Type) (a6989586621679850229 :: Min a) Source # | |
Defined in Data.Singletons.Prelude.Semigroup.Internal |
type GetMinSym1 (a6989586621679850229 :: Min (a6989586621679069715 :: Type)) = GetMin a6989586621679850229 Source #
data MaxSym0 :: forall (a6989586621679069719 :: Type). (~>) a6989586621679069719 (Max (a6989586621679069719 :: Type)) Source #
Instances
SingI (MaxSym0 :: TyFun a (Max a) -> Type) Source # | |
SuppressUnusedWarnings (MaxSym0 :: TyFun a6989586621679069719 (Max a6989586621679069719) -> Type) Source # | |
Defined in Data.Singletons.Prelude.Semigroup.Internal suppressUnusedWarnings :: () Source # | |
type Apply (MaxSym0 :: TyFun a (Max a) -> Type) (t6989586621679850251 :: a) Source # | |
data GetMaxSym0 :: forall (a6989586621679069719 :: Type). (~>) (Max (a6989586621679069719 :: Type)) a6989586621679069719 Source #
Instances
SuppressUnusedWarnings (GetMaxSym0 :: TyFun (Max a6989586621679069719) a6989586621679069719 -> Type) Source # | |
Defined in Data.Singletons.Prelude.Semigroup.Internal suppressUnusedWarnings :: () Source # | |
type Apply (GetMaxSym0 :: TyFun (Max a) a -> Type) (a6989586621679850248 :: Max a) Source # | |
Defined in Data.Singletons.Prelude.Semigroup.Internal |
type GetMaxSym1 (a6989586621679850248 :: Max (a6989586621679069719 :: Type)) = GetMax a6989586621679850248 Source #
data FirstSym0 :: forall (a6989586621679069727 :: Type). (~>) a6989586621679069727 (First (a6989586621679069727 :: Type)) Source #
Instances
SingI (FirstSym0 :: TyFun a (First a) -> Type) Source # | |
SuppressUnusedWarnings (FirstSym0 :: TyFun a6989586621679069727 (First a6989586621679069727) -> Type) Source # | |
Defined in Data.Singletons.Prelude.Semigroup.Internal suppressUnusedWarnings :: () Source # | |
type Apply (FirstSym0 :: TyFun a (First a) -> Type) (t6989586621679850270 :: a) Source # | |
type FirstSym1 (t6989586621679850270 :: a6989586621679069727) = 'First t6989586621679850270 Source #
data GetFirstSym0 :: forall (a6989586621679069727 :: Type). (~>) (First (a6989586621679069727 :: Type)) a6989586621679069727 Source #
Instances
SuppressUnusedWarnings (GetFirstSym0 :: TyFun (First a6989586621679069727) a6989586621679069727 -> Type) Source # | |
Defined in Data.Singletons.Prelude.Semigroup.Internal suppressUnusedWarnings :: () Source # | |
type Apply (GetFirstSym0 :: TyFun (First a) a -> Type) (a6989586621679850267 :: First a) Source # | |
Defined in Data.Singletons.Prelude.Semigroup.Internal |
type GetFirstSym1 (a6989586621679850267 :: First (a6989586621679069727 :: Type)) = GetFirst a6989586621679850267 Source #
data LastSym0 :: forall (a6989586621679069723 :: Type). (~>) a6989586621679069723 (Last (a6989586621679069723 :: Type)) Source #
Instances
SingI (LastSym0 :: TyFun a (Last a) -> Type) Source # | |
SuppressUnusedWarnings (LastSym0 :: TyFun a6989586621679069723 (Last a6989586621679069723) -> Type) Source # | |
Defined in Data.Singletons.Prelude.Semigroup.Internal suppressUnusedWarnings :: () Source # | |
type Apply (LastSym0 :: TyFun a (Last a) -> Type) (t6989586621679850289 :: a) Source # | |
data GetLastSym0 :: forall (a6989586621679069723 :: Type). (~>) (Last (a6989586621679069723 :: Type)) a6989586621679069723 Source #
Instances
SuppressUnusedWarnings (GetLastSym0 :: TyFun (Last a6989586621679069723) a6989586621679069723 -> Type) Source # | |
Defined in Data.Singletons.Prelude.Semigroup.Internal suppressUnusedWarnings :: () Source # | |
type Apply (GetLastSym0 :: TyFun (Last a) a -> Type) (a6989586621679850286 :: Last a) Source # | |
Defined in Data.Singletons.Prelude.Semigroup.Internal |
type GetLastSym1 (a6989586621679850286 :: Last (a6989586621679069723 :: Type)) = GetLast a6989586621679850286 Source #
data WrapMonoidSym0 :: forall (m6989586621679093626 :: Type). (~>) m6989586621679093626 (WrappedMonoid (m6989586621679093626 :: Type)) Source #
Instances
SingI (WrapMonoidSym0 :: TyFun m (WrappedMonoid m) -> Type) Source # | |
Defined in Data.Singletons.Prelude.Semigroup.Internal | |
SuppressUnusedWarnings (WrapMonoidSym0 :: TyFun m6989586621679093626 (WrappedMonoid m6989586621679093626) -> Type) Source # | |
Defined in Data.Singletons.Prelude.Semigroup.Internal suppressUnusedWarnings :: () Source # | |
type Apply (WrapMonoidSym0 :: TyFun m (WrappedMonoid m) -> Type) (t6989586621679850308 :: m) Source # | |
Defined in Data.Singletons.Prelude.Semigroup.Internal type Apply (WrapMonoidSym0 :: TyFun m (WrappedMonoid m) -> Type) (t6989586621679850308 :: m) = 'WrapMonoid t6989586621679850308 |
type WrapMonoidSym1 (t6989586621679850308 :: m6989586621679093626) = 'WrapMonoid t6989586621679850308 Source #
data UnwrapMonoidSym0 :: forall (m6989586621679093626 :: Type). (~>) (WrappedMonoid (m6989586621679093626 :: Type)) m6989586621679093626 Source #
Instances
SuppressUnusedWarnings (UnwrapMonoidSym0 :: TyFun (WrappedMonoid m6989586621679093626) m6989586621679093626 -> Type) Source # | |
Defined in Data.Singletons.Prelude.Semigroup.Internal suppressUnusedWarnings :: () Source # | |
type Apply (UnwrapMonoidSym0 :: TyFun (WrappedMonoid m) m -> Type) (a6989586621679850305 :: WrappedMonoid m) Source # | |
Defined in Data.Singletons.Prelude.Semigroup.Internal type Apply (UnwrapMonoidSym0 :: TyFun (WrappedMonoid m) m -> Type) (a6989586621679850305 :: WrappedMonoid m) = UnwrapMonoid a6989586621679850305 |
type UnwrapMonoidSym1 (a6989586621679850305 :: WrappedMonoid (m6989586621679093626 :: Type)) = UnwrapMonoid a6989586621679850305 Source #
data DualSym0 :: forall (a6989586621679091700 :: Type). (~>) a6989586621679091700 (Dual (a6989586621679091700 :: Type)) Source #
Instances
SingI (DualSym0 :: TyFun a (Dual a) -> Type) Source # | |
SuppressUnusedWarnings (DualSym0 :: TyFun a6989586621679091700 (Dual a6989586621679091700) -> Type) Source # | |
Defined in Data.Singletons.Prelude.Semigroup.Internal suppressUnusedWarnings :: () Source # | |
type Apply (DualSym0 :: TyFun a (Dual a) -> Type) (t6989586621679850147 :: a) Source # | |
data GetDualSym0 :: forall (a6989586621679091700 :: Type). (~>) (Dual (a6989586621679091700 :: Type)) a6989586621679091700 Source #
Instances
SuppressUnusedWarnings (GetDualSym0 :: TyFun (Dual a6989586621679091700) a6989586621679091700 -> Type) Source # | |
Defined in Data.Singletons.Prelude.Semigroup.Internal suppressUnusedWarnings :: () Source # | |
type Apply (GetDualSym0 :: TyFun (Dual a) a -> Type) (a6989586621679850144 :: Dual a) Source # | |
Defined in Data.Singletons.Prelude.Semigroup.Internal |
type GetDualSym1 (a6989586621679850144 :: Dual (a6989586621679091700 :: Type)) = GetDual a6989586621679850144 Source #
data AllSym0 :: (~>) Bool All Source #
Instances
SingI AllSym0 Source # | |
SuppressUnusedWarnings AllSym0 Source # | |
Defined in Data.Singletons.Prelude.Semigroup.Internal suppressUnusedWarnings :: () Source # | |
type Apply AllSym0 (t6989586621679850161 :: Bool) Source # | |
Defined in Data.Singletons.Prelude.Semigroup.Internal |
data GetAllSym0 :: (~>) All Bool Source #
Instances
SuppressUnusedWarnings GetAllSym0 Source # | |
Defined in Data.Singletons.Prelude.Semigroup.Internal suppressUnusedWarnings :: () Source # | |
type Apply GetAllSym0 (a6989586621679850158 :: All) Source # | |
Defined in Data.Singletons.Prelude.Semigroup.Internal |
type GetAllSym1 (a6989586621679850158 :: All) = GetAll a6989586621679850158 Source #
data AnySym0 :: (~>) Bool Any Source #
Instances
SingI AnySym0 Source # | |
SuppressUnusedWarnings AnySym0 Source # | |
Defined in Data.Singletons.Prelude.Semigroup.Internal suppressUnusedWarnings :: () Source # | |
type Apply AnySym0 (t6989586621679850175 :: Bool) Source # | |
Defined in Data.Singletons.Prelude.Semigroup.Internal |
data GetAnySym0 :: (~>) Any Bool Source #
Instances
SuppressUnusedWarnings GetAnySym0 Source # | |
Defined in Data.Singletons.Prelude.Semigroup.Internal suppressUnusedWarnings :: () Source # | |
type Apply GetAnySym0 (a6989586621679850172 :: Any) Source # | |
Defined in Data.Singletons.Prelude.Semigroup.Internal |
type GetAnySym1 (a6989586621679850172 :: Any) = GetAny a6989586621679850172 Source #
data SumSym0 :: forall (a6989586621679091685 :: Type). (~>) a6989586621679091685 (Sum (a6989586621679091685 :: Type)) Source #
Instances
SingI (SumSym0 :: TyFun a (Sum a) -> Type) Source # | |
SuppressUnusedWarnings (SumSym0 :: TyFun a6989586621679091685 (Sum a6989586621679091685) -> Type) Source # | |
Defined in Data.Singletons.Prelude.Semigroup.Internal suppressUnusedWarnings :: () Source # | |
type Apply (SumSym0 :: TyFun a (Sum a) -> Type) (t6989586621679850194 :: a) Source # | |
data GetSumSym0 :: forall (a6989586621679091685 :: Type). (~>) (Sum (a6989586621679091685 :: Type)) a6989586621679091685 Source #
Instances
SuppressUnusedWarnings (GetSumSym0 :: TyFun (Sum a6989586621679091685) a6989586621679091685 -> Type) Source # | |
Defined in Data.Singletons.Prelude.Semigroup.Internal suppressUnusedWarnings :: () Source # | |
type Apply (GetSumSym0 :: TyFun (Sum a) a -> Type) (a6989586621679850191 :: Sum a) Source # | |
Defined in Data.Singletons.Prelude.Semigroup.Internal |
type GetSumSym1 (a6989586621679850191 :: Sum (a6989586621679091685 :: Type)) = GetSum a6989586621679850191 Source #
data ProductSym0 :: forall (a6989586621679091690 :: Type). (~>) a6989586621679091690 (Product (a6989586621679091690 :: Type)) Source #
Instances
SingI (ProductSym0 :: TyFun a (Product a) -> Type) Source # | |
Defined in Data.Singletons.Prelude.Semigroup.Internal sing :: Sing ProductSym0 Source # | |
SuppressUnusedWarnings (ProductSym0 :: TyFun a6989586621679091690 (Product a6989586621679091690) -> Type) Source # | |
Defined in Data.Singletons.Prelude.Semigroup.Internal suppressUnusedWarnings :: () Source # | |
type Apply (ProductSym0 :: TyFun a (Product a) -> Type) (t6989586621679850213 :: a) Source # | |
Defined in Data.Singletons.Prelude.Semigroup.Internal |
type ProductSym1 (t6989586621679850213 :: a6989586621679091690) = 'Product t6989586621679850213 Source #
data GetProductSym0 :: forall (a6989586621679091690 :: Type). (~>) (Product (a6989586621679091690 :: Type)) a6989586621679091690 Source #
Instances
SuppressUnusedWarnings (GetProductSym0 :: TyFun (Product a6989586621679091690) a6989586621679091690 -> Type) Source # | |
Defined in Data.Singletons.Prelude.Semigroup.Internal suppressUnusedWarnings :: () Source # | |
type Apply (GetProductSym0 :: TyFun (Product a) a -> Type) (a6989586621679850210 :: Product a) Source # | |
Defined in Data.Singletons.Prelude.Semigroup.Internal type Apply (GetProductSym0 :: TyFun (Product a) a -> Type) (a6989586621679850210 :: Product a) = GetProduct a6989586621679850210 |
type GetProductSym1 (a6989586621679850210 :: Product (a6989586621679091690 :: Type)) = GetProduct a6989586621679850210 Source #
data OptionSym0 :: forall (a6989586621679069711 :: Type). (~>) (Maybe a6989586621679069711) (Option (a6989586621679069711 :: Type)) Source #
Instances
SingI (OptionSym0 :: TyFun (Maybe a) (Option a) -> Type) Source # | |
Defined in Data.Singletons.Prelude.Semigroup.Internal sing :: Sing OptionSym0 Source # | |
SuppressUnusedWarnings (OptionSym0 :: TyFun (Maybe a6989586621679069711) (Option a6989586621679069711) -> Type) Source # | |
Defined in Data.Singletons.Prelude.Semigroup.Internal suppressUnusedWarnings :: () Source # | |
type Apply (OptionSym0 :: TyFun (Maybe a) (Option a) -> Type) (t6989586621679850128 :: Maybe a) Source # | |
Defined in Data.Singletons.Prelude.Semigroup.Internal |
type OptionSym1 (t6989586621679850128 :: Maybe a6989586621679069711) = 'Option t6989586621679850128 Source #
data GetOptionSym0 :: forall (a6989586621679069711 :: Type). (~>) (Option (a6989586621679069711 :: Type)) (Maybe a6989586621679069711) Source #
Instances
SuppressUnusedWarnings (GetOptionSym0 :: TyFun (Option a6989586621679069711) (Maybe a6989586621679069711) -> Type) Source # | |
Defined in Data.Singletons.Prelude.Semigroup.Internal suppressUnusedWarnings :: () Source # | |
type Apply (GetOptionSym0 :: TyFun (Option a) (Maybe a) -> Type) (a6989586621679850125 :: Option a) Source # | |
Defined in Data.Singletons.Prelude.Semigroup.Internal |
type GetOptionSym1 (a6989586621679850125 :: Option (a6989586621679069711 :: Type)) = GetOption a6989586621679850125 Source #
data ArgSym0 :: forall (a6989586621679070612 :: Type) (b6989586621679070613 :: Type). (~>) a6989586621679070612 ((~>) b6989586621679070613 (Arg (a6989586621679070612 :: Type) (b6989586621679070613 :: Type))) Source #
Instances
SingI (ArgSym0 :: TyFun a (b ~> Arg a b) -> Type) Source # | |
SuppressUnusedWarnings (ArgSym0 :: TyFun a6989586621679070612 (b6989586621679070613 ~> Arg a6989586621679070612 b6989586621679070613) -> Type) Source # | |
Defined in Data.Singletons.Prelude.Semigroup suppressUnusedWarnings :: () Source # | |
type Apply (ArgSym0 :: TyFun a6989586621679070612 (b6989586621679070613 ~> Arg a6989586621679070612 b6989586621679070613) -> Type) (t6989586621680915597 :: a6989586621679070612) Source # | |
Defined in Data.Singletons.Prelude.Semigroup type Apply (ArgSym0 :: TyFun a6989586621679070612 (b6989586621679070613 ~> Arg a6989586621679070612 b6989586621679070613) -> Type) (t6989586621680915597 :: a6989586621679070612) = ArgSym1 t6989586621680915597 b6989586621679070613 :: TyFun b6989586621679070613 (Arg a6989586621679070612 b6989586621679070613) -> Type |
data ArgSym1 (t6989586621680915597 :: a6989586621679070612 :: Type) :: forall (b6989586621679070613 :: Type). (~>) b6989586621679070613 (Arg (a6989586621679070612 :: Type) (b6989586621679070613 :: Type)) Source #
Instances
SingI d => SingI (ArgSym1 d b :: TyFun b (Arg a b) -> Type) Source # | |
SuppressUnusedWarnings (ArgSym1 t6989586621680915597 b6989586621679070613 :: TyFun b6989586621679070613 (Arg a6989586621679070612 b6989586621679070613) -> Type) Source # | |
Defined in Data.Singletons.Prelude.Semigroup suppressUnusedWarnings :: () Source # | |
type Apply (ArgSym1 t6989586621680915597 b :: TyFun b (Arg a b) -> Type) (t6989586621680915598 :: b) Source # | |
type ArgSym2 (t6989586621680915597 :: a6989586621679070612) (t6989586621680915598 :: b6989586621679070613) = 'Arg t6989586621680915597 t6989586621680915598 Source #