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 and singled versions of the Applicative
type class.
Synopsis
- class PApplicative f where
- class SFunctor f => SApplicative f where
- sPure :: forall a (t :: a). Sing t -> Sing (Apply PureSym0 t :: f a)
- (%<*>) :: forall a b (t :: f ((~>) a b)) (t :: f a). Sing t -> Sing t -> Sing (Apply (Apply (<*>@#@$) t) t :: f b)
- sLiftA2 :: forall a b c (t :: (~>) a ((~>) b c)) (t :: f a) (t :: f b). Sing t -> Sing t -> Sing t -> Sing (Apply (Apply (Apply LiftA2Sym0 t) t) t :: f c)
- (%*>) :: forall a b (t :: f a) (t :: f b). Sing t -> Sing t -> Sing (Apply (Apply (*>@#@$) t) t :: f b)
- (%<*) :: forall a b (t :: f a) (t :: f b). Sing t -> Sing t -> Sing (Apply (Apply (<*@#@$) t) t :: f a)
- class PAlternative f where
- class SApplicative f => SAlternative f where
- type family Sing
- data SConst c where
- data Const a (b :: k)
- type family GetConst a where ...
- sGetConst :: forall a b (t :: Const a b). Sing t -> Sing (Apply GetConstSym0 t :: a)
- type family a <$> a where ...
- (%<$>) :: forall a b f (t :: (~>) a b) (t :: f a). SFunctor f => Sing t -> Sing t -> Sing (Apply (Apply (<$>@#@$) t) t :: f b)
- type family (arg :: a) <$ (arg :: f b) :: f a
- (%<$) :: forall a b (t :: a) (t :: f b). SFunctor f => Sing t -> Sing t -> Sing (Apply (Apply (<$@#@$) t) t :: f a)
- type family a <**> a where ...
- (%<**>) :: forall f a b (t :: f a) (t :: f ((~>) a b)). SApplicative f => Sing t -> Sing t -> Sing (Apply (Apply (<**>@#@$) t) t :: f b)
- type family LiftA a a where ...
- sLiftA :: forall a b f (t :: (~>) a b) (t :: f a). SApplicative f => Sing t -> Sing t -> Sing (Apply (Apply LiftASym0 t) t :: f b)
- type family LiftA3 a a a a where ...
- sLiftA3 :: forall a b c d f (t :: (~>) a ((~>) b ((~>) c d))) (t :: f a) (t :: f b) (t :: f c). SApplicative f => Sing t -> Sing t -> Sing t -> Sing t -> Sing (Apply (Apply (Apply (Apply LiftA3Sym0 t) t) t) t :: f d)
- type family Optional a where ...
- sOptional :: forall f a (t :: f a). SAlternative f => Sing t -> Sing (Apply OptionalSym0 t :: f (Maybe a))
- data PureSym0 a6989586621679559691
- type PureSym1 (a6989586621679559691 :: a) = Pure a6989586621679559691 :: f a
- data (<*>@#@$) a6989586621679559695
- data a6989586621679559695 <*>@#@$$ a6989586621679559696
- type (<*>@#@$$$) (a6989586621679559695 :: f ((~>) a b)) (a6989586621679559696 :: f a) = (<*>) a6989586621679559695 a6989586621679559696 :: f b
- data (*>@#@$) a6989586621679559707
- data a6989586621679559707 *>@#@$$ a6989586621679559708
- type (*>@#@$$$) (a6989586621679559707 :: f a) (a6989586621679559708 :: f b) = (*>) a6989586621679559707 a6989586621679559708 :: f b
- data (<*@#@$) a6989586621679559712
- data a6989586621679559712 <*@#@$$ a6989586621679559713
- type (<*@#@$$$) (a6989586621679559712 :: f a) (a6989586621679559713 :: f b) = (<*) a6989586621679559712 a6989586621679559713 :: f a
- type EmptySym0 = Empty :: f a
- data (<|>@#@$) a6989586621679559816
- data a6989586621679559816 <|>@#@$$ a6989586621679559817
- type (<|>@#@$$$) (a6989586621679559816 :: f a) (a6989586621679559817 :: f a) = (<|>) a6989586621679559816 a6989586621679559817 :: f a
- data ConstSym0 a6989586621680775209
- type ConstSym1 (a6989586621680775209 :: a) = 'Const a6989586621680775209 :: Const (a :: Type) (b :: k)
- data GetConstSym0 a6989586621680776931
- type GetConstSym1 (a6989586621680776931 :: Const a b) = GetConst a6989586621680776931 :: a
- data (<$>@#@$) a6989586621679731630
- data a6989586621679731630 <$>@#@$$ a6989586621679731631
- type (<$>@#@$$$) (a6989586621679731630 :: (~>) a b) (a6989586621679731631 :: f a) = (<$>) a6989586621679731630 a6989586621679731631 :: f b
- data (<$@#@$) a6989586621679559672
- data a6989586621679559672 <$@#@$$ a6989586621679559673
- type (<$@#@$$$) (a6989586621679559672 :: a) (a6989586621679559673 :: f b) = (<$) a6989586621679559672 a6989586621679559673 :: f a
- data (<**>@#@$) a6989586621679559655
- data a6989586621679559655 <**>@#@$$ a6989586621679559656
- type (<**>@#@$$$) (a6989586621679559655 :: f a) (a6989586621679559656 :: f ((~>) a b)) = (<**>) a6989586621679559655 a6989586621679559656 :: f b
- data LiftASym0 a6989586621679559644
- data LiftASym1 a6989586621679559644 a6989586621679559645
- type LiftASym2 (a6989586621679559644 :: (~>) a b) (a6989586621679559645 :: f a) = LiftA a6989586621679559644 a6989586621679559645 :: f b
- data LiftA2Sym0 a6989586621679559701
- data LiftA2Sym1 a6989586621679559701 a6989586621679559702
- data LiftA2Sym2 a6989586621679559701 a6989586621679559702 a6989586621679559703
- type LiftA2Sym3 (a6989586621679559701 :: (~>) a ((~>) b c)) (a6989586621679559702 :: f a) (a6989586621679559703 :: f b) = LiftA2 a6989586621679559701 a6989586621679559702 a6989586621679559703 :: f c
- data LiftA3Sym0 a6989586621679559633
- data LiftA3Sym1 a6989586621679559633 a6989586621679559634
- data LiftA3Sym2 a6989586621679559633 a6989586621679559634 a6989586621679559635
- data LiftA3Sym3 a6989586621679559633 a6989586621679559634 a6989586621679559635 a6989586621679559636
- data OptionalSym0 a6989586621681282965
- type OptionalSym1 (a6989586621681282965 :: f a) = Optional a6989586621681282965 :: f (Maybe a)
Documentation
class PApplicative f Source #
type Pure (arg :: a) :: f a Source #
type (arg :: f ((~>) a b)) <*> (arg :: f a) :: f b infixl 4 Source #
type LiftA2 (arg :: (~>) a ((~>) b c)) (arg :: f a) (arg :: f b) :: f c Source #
Instances
class SFunctor f => SApplicative f where Source #
sPure :: forall a (t :: a). Sing t -> Sing (Apply PureSym0 t :: f a) Source #
(%<*>) :: forall a b (t :: f ((~>) a b)) (t :: f a). Sing t -> Sing t -> Sing (Apply (Apply (<*>@#@$) t) t :: f b) infixl 4 Source #
default (%<*>) :: forall a b (t :: f ((~>) a b)) (t :: f a). (Apply (Apply (<*>@#@$) t) t :: f b) ~ Apply (Apply TFHelper_6989586621679559716Sym0 t) t => Sing t -> Sing t -> Sing (Apply (Apply (<*>@#@$) t) t :: f b) Source #
sLiftA2 :: forall a b c (t :: (~>) a ((~>) b c)) (t :: f a) (t :: f b). Sing t -> Sing t -> Sing t -> Sing (Apply (Apply (Apply LiftA2Sym0 t) t) t :: f c) Source #
default sLiftA2 :: forall a b c (t :: (~>) a ((~>) b c)) (t :: f a) (t :: f b). (Apply (Apply (Apply LiftA2Sym0 t) t) t :: f c) ~ Apply (Apply (Apply LiftA2_6989586621679559732Sym0 t) t) t => Sing t -> Sing t -> Sing t -> Sing (Apply (Apply (Apply LiftA2Sym0 t) t) t :: f c) Source #
(%*>) :: forall a b (t :: f a) (t :: f b). Sing t -> Sing t -> Sing (Apply (Apply (*>@#@$) t) t :: f b) infixl 4 Source #
default (%*>) :: forall a b (t :: f a) (t :: f b). (Apply (Apply (*>@#@$) t) t :: f b) ~ Apply (Apply TFHelper_6989586621679559748Sym0 t) t => Sing t -> Sing t -> Sing (Apply (Apply (*>@#@$) t) t :: f b) Source #
(%<*) :: forall a b (t :: f a) (t :: f b). Sing t -> Sing t -> Sing (Apply (Apply (<*@#@$) t) t :: f a) infixl 4 Source #
Instances
SApplicative [] Source # | |
Defined in Data.Singletons.Prelude.Monad.Internal sPure :: forall a (t :: a). Sing t -> Sing (Apply PureSym0 t) Source # (%<*>) :: forall a b (t :: [a ~> b]) (t :: [a]). Sing t -> Sing t -> Sing (Apply (Apply (<*>@#@$) t) t) Source # sLiftA2 :: forall a b c (t :: a ~> (b ~> c)) (t :: [a]) (t :: [b]). Sing t -> Sing t -> Sing t -> Sing (Apply (Apply (Apply LiftA2Sym0 t) t) t) Source # (%*>) :: forall a b (t :: [a]) (t :: [b]). Sing t -> Sing t -> Sing (Apply (Apply (*>@#@$) t) t) Source # (%<*) :: forall a b (t :: [a]) (t :: [b]). Sing t -> Sing t -> Sing (Apply (Apply (<*@#@$) t) t) Source # | |
SApplicative Maybe Source # | |
Defined in Data.Singletons.Prelude.Monad.Internal sPure :: forall a (t :: a). Sing t -> Sing (Apply PureSym0 t) Source # (%<*>) :: forall a b (t :: Maybe (a ~> b)) (t :: Maybe a). Sing t -> Sing t -> Sing (Apply (Apply (<*>@#@$) t) t) Source # sLiftA2 :: forall a b c (t :: a ~> (b ~> c)) (t :: Maybe a) (t :: Maybe b). Sing t -> Sing t -> Sing t -> Sing (Apply (Apply (Apply LiftA2Sym0 t) t) t) Source # (%*>) :: forall a b (t :: Maybe a) (t :: Maybe b). Sing t -> Sing t -> Sing (Apply (Apply (*>@#@$) t) t) Source # (%<*) :: forall a b (t :: Maybe a) (t :: Maybe b). Sing t -> Sing t -> Sing (Apply (Apply (<*@#@$) t) t) Source # | |
SApplicative Min Source # | |
Defined in Data.Singletons.Prelude.Semigroup sPure :: forall a (t :: a). Sing t -> Sing (Apply PureSym0 t) Source # (%<*>) :: forall a b (t :: Min (a ~> b)) (t :: Min a). Sing t -> Sing t -> Sing (Apply (Apply (<*>@#@$) t) t) Source # sLiftA2 :: forall a b c (t :: a ~> (b ~> c)) (t :: Min a) (t :: Min b). Sing t -> Sing t -> Sing t -> Sing (Apply (Apply (Apply LiftA2Sym0 t) t) t) Source # (%*>) :: forall a b (t :: Min a) (t :: Min b). Sing t -> Sing t -> Sing (Apply (Apply (*>@#@$) t) t) Source # (%<*) :: forall a b (t :: Min a) (t :: Min b). Sing t -> Sing t -> Sing (Apply (Apply (<*@#@$) t) t) Source # | |
SApplicative Max Source # | |
Defined in Data.Singletons.Prelude.Semigroup sPure :: forall a (t :: a). Sing t -> Sing (Apply PureSym0 t) Source # (%<*>) :: forall a b (t :: Max (a ~> b)) (t :: Max a). Sing t -> Sing t -> Sing (Apply (Apply (<*>@#@$) t) t) Source # sLiftA2 :: forall a b c (t :: a ~> (b ~> c)) (t :: Max a) (t :: Max b). Sing t -> Sing t -> Sing t -> Sing (Apply (Apply (Apply LiftA2Sym0 t) t) t) Source # (%*>) :: forall a b (t :: Max a) (t :: Max b). Sing t -> Sing t -> Sing (Apply (Apply (*>@#@$) t) t) Source # (%<*) :: forall a b (t :: Max a) (t :: Max b). Sing t -> Sing t -> Sing (Apply (Apply (<*@#@$) t) t) Source # | |
SApplicative First Source # | |
Defined in Data.Singletons.Prelude.Semigroup sPure :: forall a (t :: a). Sing t -> Sing (Apply PureSym0 t) Source # (%<*>) :: forall a b (t :: First (a ~> b)) (t :: First a). Sing t -> Sing t -> Sing (Apply (Apply (<*>@#@$) t) t) Source # sLiftA2 :: forall a b c (t :: a ~> (b ~> c)) (t :: First a) (t :: First b). Sing t -> Sing t -> Sing t -> Sing (Apply (Apply (Apply LiftA2Sym0 t) t) t) Source # (%*>) :: forall a b (t :: First a) (t :: First b). Sing t -> Sing t -> Sing (Apply (Apply (*>@#@$) t) t) Source # (%<*) :: forall a b (t :: First a) (t :: First b). Sing t -> Sing t -> Sing (Apply (Apply (<*@#@$) t) t) Source # | |
SApplicative Last Source # | |
Defined in Data.Singletons.Prelude.Semigroup sPure :: forall a (t :: a). Sing t -> Sing (Apply PureSym0 t) Source # (%<*>) :: forall a b (t :: Last (a ~> b)) (t :: Last a). Sing t -> Sing t -> Sing (Apply (Apply (<*>@#@$) t) t) Source # sLiftA2 :: forall a b c (t :: a ~> (b ~> c)) (t :: Last a) (t :: Last b). Sing t -> Sing t -> Sing t -> Sing (Apply (Apply (Apply LiftA2Sym0 t) t) t) Source # (%*>) :: forall a b (t :: Last a) (t :: Last b). Sing t -> Sing t -> Sing (Apply (Apply (*>@#@$) t) t) Source # (%<*) :: forall a b (t :: Last a) (t :: Last b). Sing t -> Sing t -> Sing (Apply (Apply (<*@#@$) t) t) Source # | |
SApplicative Option Source # | |
Defined in Data.Singletons.Prelude.Semigroup sPure :: forall a (t :: a). Sing t -> Sing (Apply PureSym0 t) Source # (%<*>) :: forall a b (t :: Option (a ~> b)) (t :: Option a). Sing t -> Sing t -> Sing (Apply (Apply (<*>@#@$) t) t) Source # sLiftA2 :: forall a b c (t :: a ~> (b ~> c)) (t :: Option a) (t :: Option b). Sing t -> Sing t -> Sing t -> Sing (Apply (Apply (Apply LiftA2Sym0 t) t) t) Source # (%*>) :: forall a b (t :: Option a) (t :: Option b). Sing t -> Sing t -> Sing (Apply (Apply (*>@#@$) t) t) Source # (%<*) :: forall a b (t :: Option a) (t :: Option b). Sing t -> Sing t -> Sing (Apply (Apply (<*@#@$) t) t) Source # | |
SApplicative Identity Source # | |
Defined in Data.Singletons.Prelude.Identity sPure :: forall a (t :: a). Sing t -> Sing (Apply PureSym0 t) Source # (%<*>) :: forall a b (t :: Identity (a ~> b)) (t :: Identity a). Sing t -> Sing t -> Sing (Apply (Apply (<*>@#@$) t) t) Source # sLiftA2 :: forall a b c (t :: a ~> (b ~> c)) (t :: Identity a) (t :: Identity b). Sing t -> Sing t -> Sing t -> Sing (Apply (Apply (Apply LiftA2Sym0 t) t) t) Source # (%*>) :: forall a b (t :: Identity a) (t :: Identity b). Sing t -> Sing t -> Sing (Apply (Apply (*>@#@$) t) t) Source # (%<*) :: forall a b (t :: Identity a) (t :: Identity b). Sing t -> Sing t -> Sing (Apply (Apply (<*@#@$) t) t) Source # | |
SApplicative First Source # | |
Defined in Data.Singletons.Prelude.Monoid sPure :: forall a (t :: a). Sing t -> Sing (Apply PureSym0 t) Source # (%<*>) :: forall a b (t :: First (a ~> b)) (t :: First a). Sing t -> Sing t -> Sing (Apply (Apply (<*>@#@$) t) t) Source # sLiftA2 :: forall a b c (t :: a ~> (b ~> c)) (t :: First a) (t :: First b). Sing t -> Sing t -> Sing t -> Sing (Apply (Apply (Apply LiftA2Sym0 t) t) t) Source # (%*>) :: forall a b (t :: First a) (t :: First b). Sing t -> Sing t -> Sing (Apply (Apply (*>@#@$) t) t) Source # (%<*) :: forall a b (t :: First a) (t :: First b). Sing t -> Sing t -> Sing (Apply (Apply (<*@#@$) t) t) Source # | |
SApplicative Last Source # | |
Defined in Data.Singletons.Prelude.Monoid sPure :: forall a (t :: a). Sing t -> Sing (Apply PureSym0 t) Source # (%<*>) :: forall a b (t :: Last (a ~> b)) (t :: Last a). Sing t -> Sing t -> Sing (Apply (Apply (<*>@#@$) t) t) Source # sLiftA2 :: forall a b c (t :: a ~> (b ~> c)) (t :: Last a) (t :: Last b). Sing t -> Sing t -> Sing t -> Sing (Apply (Apply (Apply LiftA2Sym0 t) t) t) Source # (%*>) :: forall a b (t :: Last a) (t :: Last b). Sing t -> Sing t -> Sing (Apply (Apply (*>@#@$) t) t) Source # (%<*) :: forall a b (t :: Last a) (t :: Last b). Sing t -> Sing t -> Sing (Apply (Apply (<*@#@$) t) t) Source # | |
SApplicative Dual Source # | |
Defined in Data.Singletons.Prelude.Semigroup.Internal sPure :: forall a (t :: a). Sing t -> Sing (Apply PureSym0 t) Source # (%<*>) :: forall a b (t :: Dual (a ~> b)) (t :: Dual a). Sing t -> Sing t -> Sing (Apply (Apply (<*>@#@$) t) t) Source # sLiftA2 :: forall a b c (t :: a ~> (b ~> c)) (t :: Dual a) (t :: Dual b). Sing t -> Sing t -> Sing t -> Sing (Apply (Apply (Apply LiftA2Sym0 t) t) t) Source # (%*>) :: forall a b (t :: Dual a) (t :: Dual b). Sing t -> Sing t -> Sing (Apply (Apply (*>@#@$) t) t) Source # (%<*) :: forall a b (t :: Dual a) (t :: Dual b). Sing t -> Sing t -> Sing (Apply (Apply (<*@#@$) t) t) Source # | |
SApplicative Sum Source # | |
Defined in Data.Singletons.Prelude.Semigroup.Internal sPure :: forall a (t :: a). Sing t -> Sing (Apply PureSym0 t) Source # (%<*>) :: forall a b (t :: Sum (a ~> b)) (t :: Sum a). Sing t -> Sing t -> Sing (Apply (Apply (<*>@#@$) t) t) Source # sLiftA2 :: forall a b c (t :: a ~> (b ~> c)) (t :: Sum a) (t :: Sum b). Sing t -> Sing t -> Sing t -> Sing (Apply (Apply (Apply LiftA2Sym0 t) t) t) Source # (%*>) :: forall a b (t :: Sum a) (t :: Sum b). Sing t -> Sing t -> Sing (Apply (Apply (*>@#@$) t) t) Source # (%<*) :: forall a b (t :: Sum a) (t :: Sum b). Sing t -> Sing t -> Sing (Apply (Apply (<*@#@$) t) t) Source # | |
SApplicative Product Source # | |
Defined in Data.Singletons.Prelude.Semigroup.Internal sPure :: forall a (t :: a). Sing t -> Sing (Apply PureSym0 t) Source # (%<*>) :: forall a b (t :: Product (a ~> b)) (t :: Product a). Sing t -> Sing t -> Sing (Apply (Apply (<*>@#@$) t) t) Source # sLiftA2 :: forall a b c (t :: a ~> (b ~> c)) (t :: Product a) (t :: Product b). Sing t -> Sing t -> Sing t -> Sing (Apply (Apply (Apply LiftA2Sym0 t) t) t) Source # (%*>) :: forall a b (t :: Product a) (t :: Product b). Sing t -> Sing t -> Sing (Apply (Apply (*>@#@$) t) t) Source # (%<*) :: forall a b (t :: Product a) (t :: Product b). Sing t -> Sing t -> Sing (Apply (Apply (<*@#@$) t) t) Source # | |
SApplicative Down Source # | |
Defined in Data.Singletons.Prelude.Applicative sPure :: forall a (t :: a). Sing t -> Sing (Apply PureSym0 t) Source # (%<*>) :: forall a b (t :: Down (a ~> b)) (t :: Down a). Sing t -> Sing t -> Sing (Apply (Apply (<*>@#@$) t) t) Source # sLiftA2 :: forall a b c (t :: a ~> (b ~> c)) (t :: Down a) (t :: Down b). Sing t -> Sing t -> Sing t -> Sing (Apply (Apply (Apply LiftA2Sym0 t) t) t) Source # (%*>) :: forall a b (t :: Down a) (t :: Down b). Sing t -> Sing t -> Sing (Apply (Apply (*>@#@$) t) t) Source # (%<*) :: forall a b (t :: Down a) (t :: Down b). Sing t -> Sing t -> Sing (Apply (Apply (<*@#@$) t) t) Source # | |
SApplicative NonEmpty Source # | |
Defined in Data.Singletons.Prelude.Monad.Internal sPure :: forall a (t :: a). Sing t -> Sing (Apply PureSym0 t) Source # (%<*>) :: forall a b (t :: NonEmpty (a ~> b)) (t :: NonEmpty a). Sing t -> Sing t -> Sing (Apply (Apply (<*>@#@$) t) t) Source # sLiftA2 :: forall a b c (t :: a ~> (b ~> c)) (t :: NonEmpty a) (t :: NonEmpty b). Sing t -> Sing t -> Sing t -> Sing (Apply (Apply (Apply LiftA2Sym0 t) t) t) Source # (%*>) :: forall a b (t :: NonEmpty a) (t :: NonEmpty b). Sing t -> Sing t -> Sing (Apply (Apply (*>@#@$) t) t) Source # (%<*) :: forall a b (t :: NonEmpty a) (t :: NonEmpty b). Sing t -> Sing t -> Sing (Apply (Apply (<*@#@$) t) t) Source # | |
SApplicative (Either e) Source # | |
Defined in Data.Singletons.Prelude.Monad.Internal sPure :: forall a (t :: a). Sing t -> Sing (Apply PureSym0 t) Source # (%<*>) :: forall a b (t :: Either e (a ~> b)) (t :: Either e a). Sing t -> Sing t -> Sing (Apply (Apply (<*>@#@$) t) t) Source # sLiftA2 :: forall a b c (t :: a ~> (b ~> c)) (t :: Either e a) (t :: Either e b). Sing t -> Sing t -> Sing t -> Sing (Apply (Apply (Apply LiftA2Sym0 t) t) t) Source # (%*>) :: forall a b (t :: Either e a) (t :: Either e b). Sing t -> Sing t -> Sing (Apply (Apply (*>@#@$) t) t) Source # (%<*) :: forall a b (t :: Either e a) (t :: Either e b). Sing t -> Sing t -> Sing (Apply (Apply (<*@#@$) t) t) Source # | |
SMonoid a => SApplicative ((,) a) Source # | |
Defined in Data.Singletons.Prelude.Applicative sPure :: forall a0 (t :: a0). Sing t -> Sing (Apply PureSym0 t) Source # (%<*>) :: forall a0 b (t :: (a, a0 ~> b)) (t :: (a, a0)). Sing t -> Sing t -> Sing (Apply (Apply (<*>@#@$) t) t) Source # sLiftA2 :: forall a0 b c (t :: a0 ~> (b ~> c)) (t :: (a, a0)) (t :: (a, b)). Sing t -> Sing t -> Sing t -> Sing (Apply (Apply (Apply LiftA2Sym0 t) t) t) Source # (%*>) :: forall a0 b (t :: (a, a0)) (t :: (a, b)). Sing t -> Sing t -> Sing (Apply (Apply (*>@#@$) t) t) Source # (%<*) :: forall a0 b (t :: (a, a0)) (t :: (a, b)). Sing t -> Sing t -> Sing (Apply (Apply (<*@#@$) t) t) Source # | |
SApplicative (Proxy :: Type -> Type) Source # | |
Defined in Data.Singletons.Prelude.Proxy sPure :: forall a (t :: a). Sing t -> Sing (Apply PureSym0 t) Source # (%<*>) :: forall a b (t :: Proxy (a ~> b)) (t :: Proxy a). Sing t -> Sing t -> Sing (Apply (Apply (<*>@#@$) t) t) Source # sLiftA2 :: forall a b c (t :: a ~> (b ~> c)) (t :: Proxy a) (t :: Proxy b). Sing t -> Sing t -> Sing t -> Sing (Apply (Apply (Apply LiftA2Sym0 t) t) t) Source # (%*>) :: forall a b (t :: Proxy a) (t :: Proxy b). Sing t -> Sing t -> Sing (Apply (Apply (*>@#@$) t) t) Source # (%<*) :: forall a b (t :: Proxy a) (t :: Proxy b). Sing t -> Sing t -> Sing (Apply (Apply (<*@#@$) t) t) Source # | |
SMonoid m => SApplicative (Const m :: Type -> Type) Source # | |
Defined in Data.Singletons.Prelude.Const sPure :: forall a (t :: a). Sing t -> Sing (Apply PureSym0 t) Source # (%<*>) :: forall a b (t :: Const m (a ~> b)) (t :: Const m a). Sing t -> Sing t -> Sing (Apply (Apply (<*>@#@$) t) t) Source # sLiftA2 :: forall a b c (t :: a ~> (b ~> c)) (t :: Const m a) (t :: Const m b). Sing t -> Sing t -> Sing t -> Sing (Apply (Apply (Apply LiftA2Sym0 t) t) t) Source # (%*>) :: forall a b (t :: Const m a) (t :: Const m b). Sing t -> Sing t -> Sing (Apply (Apply (*>@#@$) t) t) Source # (%<*) :: forall a b (t :: Const m a) (t :: Const m b). Sing t -> Sing t -> Sing (Apply (Apply (<*@#@$) t) t) Source # |
class PAlternative f Source #
Instances
PAlternative (Proxy :: k -> Type) Source # | |
PAlternative [] Source # | |
PAlternative Maybe Source # | |
PAlternative Option Source # | |
class SApplicative f => SAlternative f where Source #
sEmpty :: forall a. Sing (EmptySym0 :: f a) Source #
(%<|>) :: forall a (t :: f a) (t :: f a). Sing t -> Sing t -> Sing (Apply (Apply (<|>@#@$) t) t :: f a) infixl 3 Source #
Instances
SAlternative [] Source # | |
SAlternative Maybe Source # | |
SAlternative Option Source # | |
SAlternative (Proxy :: Type -> Type) Source # | |
The singleton kind-indexed type family.
Instances
Instances
SDecide a => TestCoercion (SConst :: Const a b -> Type) Source # | |
Defined in Data.Singletons.Prelude.Const | |
SDecide a => TestEquality (SConst :: Const a b -> Type) Source # | |
Defined in Data.Singletons.Prelude.Const |
The Const
functor.
Instances
(%<$>) :: forall a b f (t :: (~>) a b) (t :: f a). SFunctor f => Sing t -> Sing t -> Sing (Apply (Apply (<$>@#@$) t) t :: f b) infixl 4 Source #
type family (arg :: a) <$ (arg :: f b) :: f a infixl 4 Source #
Instances
(%<$) :: forall a b (t :: a) (t :: f b). SFunctor f => Sing t -> Sing t -> Sing (Apply (Apply (<$@#@$) t) t :: f a) infixl 4 Source #
(%<**>) :: forall f a b (t :: f a) (t :: f ((~>) a b)). SApplicative f => Sing t -> Sing t -> Sing (Apply (Apply (<**>@#@$) t) t :: f b) infixl 4 Source #
sLiftA :: forall a b f (t :: (~>) a b) (t :: f a). SApplicative f => Sing t -> Sing t -> Sing (Apply (Apply LiftASym0 t) t :: f b) Source #
sLiftA3 :: forall a b c d f (t :: (~>) a ((~>) b ((~>) c d))) (t :: f a) (t :: f b) (t :: f c). SApplicative f => Sing t -> Sing t -> Sing t -> Sing t -> Sing (Apply (Apply (Apply (Apply LiftA3Sym0 t) t) t) t :: f d) Source #
sOptional :: forall f a (t :: f a). SAlternative f => Sing t -> Sing (Apply OptionalSym0 t :: f (Maybe a)) Source #
Defunctionalization symbols
data PureSym0 a6989586621679559691 Source #
Instances
SApplicative f => SingI (PureSym0 :: TyFun a (f a) -> Type) Source # | |
SuppressUnusedWarnings (PureSym0 :: TyFun a (f a) -> Type) Source # | |
Defined in Data.Singletons.Prelude.Monad.Internal suppressUnusedWarnings :: () Source # | |
type Apply (PureSym0 :: TyFun a (f a) -> Type) (a6989586621679559691 :: a) Source # | |
data (<*>@#@$) a6989586621679559695 infixl 4 Source #
Instances
SApplicative f => SingI ((<*>@#@$) :: TyFun (f (a ~> b)) (f a ~> f b) -> Type) Source # | |
SuppressUnusedWarnings ((<*>@#@$) :: TyFun (f (a ~> b)) (f a ~> f b) -> Type) Source # | |
Defined in Data.Singletons.Prelude.Monad.Internal suppressUnusedWarnings :: () Source # | |
type Apply ((<*>@#@$) :: TyFun (f (a ~> b)) (f a ~> f b) -> Type) (a6989586621679559695 :: f (a ~> b)) Source # | |
Defined in Data.Singletons.Prelude.Monad.Internal |
data a6989586621679559695 <*>@#@$$ a6989586621679559696 infixl 4 Source #
Instances
(SApplicative f, SingI d) => SingI ((<*>@#@$$) d :: TyFun (f a) (f b) -> Type) Source # | |
Defined in Data.Singletons.Prelude.Monad.Internal sing :: Sing ((<*>@#@$$) d) Source # | |
SuppressUnusedWarnings ((<*>@#@$$) a6989586621679559695 :: TyFun (f a) (f b) -> Type) Source # | |
Defined in Data.Singletons.Prelude.Monad.Internal suppressUnusedWarnings :: () Source # | |
type Apply ((<*>@#@$$) a6989586621679559695 :: TyFun (f a) (f b) -> Type) (a6989586621679559696 :: f a) Source # | |
Defined in Data.Singletons.Prelude.Monad.Internal type Apply ((<*>@#@$$) a6989586621679559695 :: TyFun (f a) (f b) -> Type) (a6989586621679559696 :: f a) = a6989586621679559695 <*>@#@$$$ a6989586621679559696 |
type (<*>@#@$$$) (a6989586621679559695 :: f ((~>) a b)) (a6989586621679559696 :: f a) = (<*>) a6989586621679559695 a6989586621679559696 :: f b infixl 4 Source #
data (*>@#@$) a6989586621679559707 infixl 4 Source #
Instances
SApplicative f => SingI ((*>@#@$) :: TyFun (f a) (f b ~> f b) -> Type) Source # | |
SuppressUnusedWarnings ((*>@#@$) :: TyFun (f a) (f b ~> f b) -> Type) Source # | |
Defined in Data.Singletons.Prelude.Monad.Internal suppressUnusedWarnings :: () Source # | |
type Apply ((*>@#@$) :: TyFun (f a) (f b ~> f b) -> Type) (a6989586621679559707 :: f a) Source # | |
data a6989586621679559707 *>@#@$$ a6989586621679559708 infixl 4 Source #
Instances
(SApplicative f, SingI d) => SingI ((*>@#@$$) d :: TyFun (f b) (f b) -> Type) Source # | |
SuppressUnusedWarnings ((*>@#@$$) a6989586621679559707 :: TyFun (f b) (f b) -> Type) Source # | |
Defined in Data.Singletons.Prelude.Monad.Internal suppressUnusedWarnings :: () Source # | |
type Apply ((*>@#@$$) a6989586621679559707 :: TyFun (f b) (f b) -> Type) (a6989586621679559708 :: f b) Source # | |
type (*>@#@$$$) (a6989586621679559707 :: f a) (a6989586621679559708 :: f b) = (*>) a6989586621679559707 a6989586621679559708 :: f b infixl 4 Source #
data (<*@#@$) a6989586621679559712 infixl 4 Source #
Instances
SApplicative f => SingI ((<*@#@$) :: TyFun (f a) (f b ~> f a) -> Type) Source # | |
SuppressUnusedWarnings ((<*@#@$) :: TyFun (f a) (f b ~> f a) -> Type) Source # | |
Defined in Data.Singletons.Prelude.Monad.Internal suppressUnusedWarnings :: () Source # | |
type Apply ((<*@#@$) :: TyFun (f a) (f b ~> f a) -> Type) (a6989586621679559712 :: f a) Source # | |
data a6989586621679559712 <*@#@$$ a6989586621679559713 infixl 4 Source #
Instances
(SApplicative f, SingI d) => SingI ((<*@#@$$) d :: TyFun (f b) (f a) -> Type) Source # | |
SuppressUnusedWarnings ((<*@#@$$) a6989586621679559712 :: TyFun (f b) (f a) -> Type) Source # | |
Defined in Data.Singletons.Prelude.Monad.Internal suppressUnusedWarnings :: () Source # | |
type Apply ((<*@#@$$) a6989586621679559712 :: TyFun (f b) (f a) -> Type) (a6989586621679559713 :: f b) Source # | |
type (<*@#@$$$) (a6989586621679559712 :: f a) (a6989586621679559713 :: f b) = (<*) a6989586621679559712 a6989586621679559713 :: f a infixl 4 Source #
data (<|>@#@$) a6989586621679559816 infixl 3 Source #
Instances
SAlternative f => SingI ((<|>@#@$) :: TyFun (f a) (f a ~> f a) -> Type) Source # | |
SuppressUnusedWarnings ((<|>@#@$) :: TyFun (f a) (f a ~> f a) -> Type) Source # | |
Defined in Data.Singletons.Prelude.Monad.Internal suppressUnusedWarnings :: () Source # | |
type Apply ((<|>@#@$) :: TyFun (f a) (f a ~> f a) -> Type) (a6989586621679559816 :: f a) Source # | |
Defined in Data.Singletons.Prelude.Monad.Internal |
data a6989586621679559816 <|>@#@$$ a6989586621679559817 infixl 3 Source #
Instances
(SAlternative f, SingI d) => SingI ((<|>@#@$$) d :: TyFun (f a) (f a) -> Type) Source # | |
Defined in Data.Singletons.Prelude.Monad.Internal sing :: Sing ((<|>@#@$$) d) Source # | |
SuppressUnusedWarnings ((<|>@#@$$) a6989586621679559816 :: TyFun (f a) (f a) -> Type) Source # | |
Defined in Data.Singletons.Prelude.Monad.Internal suppressUnusedWarnings :: () Source # | |
type Apply ((<|>@#@$$) a6989586621679559816 :: TyFun (f a) (f a) -> Type) (a6989586621679559817 :: f a) Source # | |
Defined in Data.Singletons.Prelude.Monad.Internal type Apply ((<|>@#@$$) a6989586621679559816 :: TyFun (f a) (f a) -> Type) (a6989586621679559817 :: f a) = a6989586621679559816 <|>@#@$$$ a6989586621679559817 |
type (<|>@#@$$$) (a6989586621679559816 :: f a) (a6989586621679559817 :: f a) = (<|>) a6989586621679559816 a6989586621679559817 :: f a infixl 3 Source #
data ConstSym0 a6989586621680775209 Source #
Instances
SingI (ConstSym0 :: TyFun a (Const a b) -> Type) Source # | |
SuppressUnusedWarnings (ConstSym0 :: TyFun a (Const a b) -> Type) Source # | |
Defined in Data.Singletons.Prelude.Const suppressUnusedWarnings :: () Source # | |
type Apply (ConstSym0 :: TyFun a (Const a b) -> Type) (a6989586621680775209 :: a) Source # | |
type ConstSym1 (a6989586621680775209 :: a) = 'Const a6989586621680775209 :: Const (a :: Type) (b :: k) Source #
data GetConstSym0 a6989586621680776931 Source #
Instances
SingI (GetConstSym0 :: TyFun (Const a b) a -> Type) Source # | |
Defined in Data.Singletons.Prelude.Const sing :: Sing GetConstSym0 Source # | |
SuppressUnusedWarnings (GetConstSym0 :: TyFun (Const a b) a -> Type) Source # | |
Defined in Data.Singletons.Prelude.Const suppressUnusedWarnings :: () Source # | |
type Apply (GetConstSym0 :: TyFun (Const a b) a -> Type) (a6989586621680776931 :: Const a b) Source # | |
Defined in Data.Singletons.Prelude.Const type Apply (GetConstSym0 :: TyFun (Const a b) a -> Type) (a6989586621680776931 :: Const a b) = GetConstSym1 a6989586621680776931 |
type GetConstSym1 (a6989586621680776931 :: Const a b) = GetConst a6989586621680776931 :: a Source #
data (<$>@#@$) a6989586621679731630 infixl 4 Source #
Instances
SFunctor f => SingI ((<$>@#@$) :: TyFun (a ~> b) (f a ~> f b) -> Type) Source # | |
SuppressUnusedWarnings ((<$>@#@$) :: TyFun (a ~> b) (f a ~> f b) -> Type) Source # | |
Defined in Data.Singletons.Prelude.Functor suppressUnusedWarnings :: () Source # | |
type Apply ((<$>@#@$) :: TyFun (a ~> b) (f a ~> f b) -> Type) (a6989586621679731630 :: a ~> b) Source # | |
data a6989586621679731630 <$>@#@$$ a6989586621679731631 infixl 4 Source #
Instances
(SFunctor f, SingI d) => SingI ((<$>@#@$$) d :: TyFun (f a) (f b) -> Type) Source # | |
Defined in Data.Singletons.Prelude.Functor sing :: Sing ((<$>@#@$$) d) Source # | |
SuppressUnusedWarnings ((<$>@#@$$) a6989586621679731630 :: TyFun (f a) (f b) -> Type) Source # | |
Defined in Data.Singletons.Prelude.Functor suppressUnusedWarnings :: () Source # | |
type Apply ((<$>@#@$$) a6989586621679731630 :: TyFun (f a) (f b) -> Type) (a6989586621679731631 :: f a) Source # | |
Defined in Data.Singletons.Prelude.Functor type Apply ((<$>@#@$$) a6989586621679731630 :: TyFun (f a) (f b) -> Type) (a6989586621679731631 :: f a) = a6989586621679731630 <$>@#@$$$ a6989586621679731631 |
type (<$>@#@$$$) (a6989586621679731630 :: (~>) a b) (a6989586621679731631 :: f a) = (<$>) a6989586621679731630 a6989586621679731631 :: f b infixl 4 Source #
data (<$@#@$) a6989586621679559672 infixl 4 Source #
Instances
SFunctor f => SingI ((<$@#@$) :: TyFun a (f b ~> f a) -> Type) Source # | |
SuppressUnusedWarnings ((<$@#@$) :: TyFun a (f b ~> f a) -> Type) Source # | |
Defined in Data.Singletons.Prelude.Monad.Internal suppressUnusedWarnings :: () Source # | |
type Apply ((<$@#@$) :: TyFun a (f b ~> f a) -> Type) (a6989586621679559672 :: a) Source # | |
data a6989586621679559672 <$@#@$$ a6989586621679559673 infixl 4 Source #
Instances
(SFunctor f, SingI d) => SingI ((<$@#@$$) d :: TyFun (f b) (f a) -> Type) Source # | |
SuppressUnusedWarnings ((<$@#@$$) a6989586621679559672 :: TyFun (f b) (f a) -> Type) Source # | |
Defined in Data.Singletons.Prelude.Monad.Internal suppressUnusedWarnings :: () Source # | |
type Apply ((<$@#@$$) a6989586621679559672 :: TyFun (f b) (f a) -> Type) (a6989586621679559673 :: f b) Source # | |
type (<$@#@$$$) (a6989586621679559672 :: a) (a6989586621679559673 :: f b) = (<$) a6989586621679559672 a6989586621679559673 :: f a infixl 4 Source #
data (<**>@#@$) a6989586621679559655 infixl 4 Source #
Instances
SApplicative f => SingI ((<**>@#@$) :: TyFun (f a) (f (a ~> b) ~> f b) -> Type) Source # | |
Defined in Data.Singletons.Prelude.Monad.Internal sing :: Sing (<**>@#@$) Source # | |
SuppressUnusedWarnings ((<**>@#@$) :: TyFun (f a) (f (a ~> b) ~> f b) -> Type) Source # | |
Defined in Data.Singletons.Prelude.Monad.Internal suppressUnusedWarnings :: () Source # | |
type Apply ((<**>@#@$) :: TyFun (f a) (f (a ~> b) ~> f b) -> Type) (a6989586621679559655 :: f a) Source # | |
Defined in Data.Singletons.Prelude.Monad.Internal type Apply ((<**>@#@$) :: TyFun (f a) (f (a ~> b) ~> f b) -> Type) (a6989586621679559655 :: f a) = (<**>@#@$$) a6989586621679559655 :: TyFun (f (a ~> b)) (f b) -> Type |
data a6989586621679559655 <**>@#@$$ a6989586621679559656 infixl 4 Source #
Instances
(SApplicative f, SingI d) => SingI ((<**>@#@$$) d :: TyFun (f (a ~> b)) (f b) -> Type) Source # | |
Defined in Data.Singletons.Prelude.Monad.Internal sing :: Sing ((<**>@#@$$) d) Source # | |
SuppressUnusedWarnings ((<**>@#@$$) a6989586621679559655 :: TyFun (f (a ~> b)) (f b) -> Type) Source # | |
Defined in Data.Singletons.Prelude.Monad.Internal suppressUnusedWarnings :: () Source # | |
type Apply ((<**>@#@$$) a6989586621679559655 :: TyFun (f (a ~> b)) (f b) -> Type) (a6989586621679559656 :: f (a ~> b)) Source # | |
Defined in Data.Singletons.Prelude.Monad.Internal type Apply ((<**>@#@$$) a6989586621679559655 :: TyFun (f (a ~> b)) (f b) -> Type) (a6989586621679559656 :: f (a ~> b)) = a6989586621679559655 <**>@#@$$$ a6989586621679559656 |
type (<**>@#@$$$) (a6989586621679559655 :: f a) (a6989586621679559656 :: f ((~>) a b)) = (<**>) a6989586621679559655 a6989586621679559656 :: f b infixl 4 Source #
data LiftASym0 a6989586621679559644 Source #
Instances
SApplicative f => SingI (LiftASym0 :: TyFun (a ~> b) (f a ~> f b) -> Type) Source # | |
SuppressUnusedWarnings (LiftASym0 :: TyFun (a ~> b) (f a ~> f b) -> Type) Source # | |
Defined in Data.Singletons.Prelude.Monad.Internal suppressUnusedWarnings :: () Source # | |
type Apply (LiftASym0 :: TyFun (a ~> b) (f a ~> f b) -> Type) (a6989586621679559644 :: a ~> b) Source # | |
data LiftASym1 a6989586621679559644 a6989586621679559645 Source #
Instances
(SApplicative f, SingI d) => SingI (LiftASym1 d :: TyFun (f a) (f b) -> Type) Source # | |
SuppressUnusedWarnings (LiftASym1 a6989586621679559644 :: TyFun (f a) (f b) -> Type) Source # | |
Defined in Data.Singletons.Prelude.Monad.Internal suppressUnusedWarnings :: () Source # | |
type Apply (LiftASym1 a6989586621679559644 :: TyFun (f a) (f b) -> Type) (a6989586621679559645 :: f a) Source # | |
type LiftASym2 (a6989586621679559644 :: (~>) a b) (a6989586621679559645 :: f a) = LiftA a6989586621679559644 a6989586621679559645 :: f b Source #
data LiftA2Sym0 a6989586621679559701 Source #
Instances
SApplicative f => SingI (LiftA2Sym0 :: TyFun (a ~> (b ~> c)) (f a ~> (f b ~> f c)) -> Type) Source # | |
Defined in Data.Singletons.Prelude.Monad.Internal sing :: Sing LiftA2Sym0 Source # | |
SuppressUnusedWarnings (LiftA2Sym0 :: TyFun (a ~> (b ~> c)) (f a ~> (f b ~> f c)) -> Type) Source # | |
Defined in Data.Singletons.Prelude.Monad.Internal suppressUnusedWarnings :: () Source # | |
type Apply (LiftA2Sym0 :: TyFun (a ~> (b ~> c)) (f a ~> (f b ~> f c)) -> Type) (a6989586621679559701 :: a ~> (b ~> c)) Source # | |
Defined in Data.Singletons.Prelude.Monad.Internal |
data LiftA2Sym1 a6989586621679559701 a6989586621679559702 Source #
Instances
(SApplicative f, SingI d) => SingI (LiftA2Sym1 d :: TyFun (f a) (f b ~> f c) -> Type) Source # | |
Defined in Data.Singletons.Prelude.Monad.Internal sing :: Sing (LiftA2Sym1 d) Source # | |
SuppressUnusedWarnings (LiftA2Sym1 a6989586621679559701 :: TyFun (f a) (f b ~> f c) -> Type) Source # | |
Defined in Data.Singletons.Prelude.Monad.Internal suppressUnusedWarnings :: () Source # | |
type Apply (LiftA2Sym1 a6989586621679559701 :: TyFun (f a) (f b ~> f c) -> Type) (a6989586621679559702 :: f a) Source # | |
Defined in Data.Singletons.Prelude.Monad.Internal type Apply (LiftA2Sym1 a6989586621679559701 :: TyFun (f a) (f b ~> f c) -> Type) (a6989586621679559702 :: f a) = LiftA2Sym2 a6989586621679559701 a6989586621679559702 |
data LiftA2Sym2 a6989586621679559701 a6989586621679559702 a6989586621679559703 Source #
Instances
(SApplicative f, SingI d1, SingI d2) => SingI (LiftA2Sym2 d1 d2 :: TyFun (f b) (f c) -> Type) Source # | |
Defined in Data.Singletons.Prelude.Monad.Internal sing :: Sing (LiftA2Sym2 d1 d2) Source # | |
SuppressUnusedWarnings (LiftA2Sym2 a6989586621679559701 a6989586621679559702 :: TyFun (f b) (f c) -> Type) Source # | |
Defined in Data.Singletons.Prelude.Monad.Internal suppressUnusedWarnings :: () Source # | |
type Apply (LiftA2Sym2 a6989586621679559701 a6989586621679559702 :: TyFun (f b) (f c) -> Type) (a6989586621679559703 :: f b) Source # | |
Defined in Data.Singletons.Prelude.Monad.Internal type Apply (LiftA2Sym2 a6989586621679559701 a6989586621679559702 :: TyFun (f b) (f c) -> Type) (a6989586621679559703 :: f b) = LiftA2Sym3 a6989586621679559701 a6989586621679559702 a6989586621679559703 |
type LiftA2Sym3 (a6989586621679559701 :: (~>) a ((~>) b c)) (a6989586621679559702 :: f a) (a6989586621679559703 :: f b) = LiftA2 a6989586621679559701 a6989586621679559702 a6989586621679559703 :: f c Source #
data LiftA3Sym0 a6989586621679559633 Source #
Instances
SApplicative f => SingI (LiftA3Sym0 :: TyFun (a ~> (b ~> (c ~> d))) (f a ~> (f b ~> (f c ~> f d))) -> Type) Source # | |
Defined in Data.Singletons.Prelude.Monad.Internal sing :: Sing LiftA3Sym0 Source # | |
SuppressUnusedWarnings (LiftA3Sym0 :: TyFun (a ~> (b ~> (c ~> d))) (f a ~> (f b ~> (f c ~> f d))) -> Type) Source # | |
Defined in Data.Singletons.Prelude.Monad.Internal suppressUnusedWarnings :: () Source # | |
type Apply (LiftA3Sym0 :: TyFun (a ~> (b ~> (c ~> d))) (f a ~> (f b ~> (f c ~> f d))) -> Type) (a6989586621679559633 :: a ~> (b ~> (c ~> d))) Source # | |
data LiftA3Sym1 a6989586621679559633 a6989586621679559634 Source #
Instances
(SApplicative f, SingI d2) => SingI (LiftA3Sym1 d2 :: TyFun (f a) (f b ~> (f c ~> f d1)) -> Type) Source # | |
Defined in Data.Singletons.Prelude.Monad.Internal sing :: Sing (LiftA3Sym1 d2) Source # | |
SuppressUnusedWarnings (LiftA3Sym1 a6989586621679559633 :: TyFun (f a) (f b ~> (f c ~> f d)) -> Type) Source # | |
Defined in Data.Singletons.Prelude.Monad.Internal suppressUnusedWarnings :: () Source # | |
type Apply (LiftA3Sym1 a6989586621679559633 :: TyFun (f a) (f b ~> (f c ~> f d)) -> Type) (a6989586621679559634 :: f a) Source # | |
Defined in Data.Singletons.Prelude.Monad.Internal type Apply (LiftA3Sym1 a6989586621679559633 :: TyFun (f a) (f b ~> (f c ~> f d)) -> Type) (a6989586621679559634 :: f a) = LiftA3Sym2 a6989586621679559633 a6989586621679559634 |
data LiftA3Sym2 a6989586621679559633 a6989586621679559634 a6989586621679559635 Source #
Instances
(SApplicative f, SingI d2, SingI d3) => SingI (LiftA3Sym2 d2 d3 :: TyFun (f b) (f c ~> f d1) -> Type) Source # | |
Defined in Data.Singletons.Prelude.Monad.Internal sing :: Sing (LiftA3Sym2 d2 d3) Source # | |
SuppressUnusedWarnings (LiftA3Sym2 a6989586621679559633 a6989586621679559634 :: TyFun (f b) (f c ~> f d) -> Type) Source # | |
Defined in Data.Singletons.Prelude.Monad.Internal suppressUnusedWarnings :: () Source # | |
type Apply (LiftA3Sym2 a6989586621679559633 a6989586621679559634 :: TyFun (f b) (f c ~> f d) -> Type) (a6989586621679559635 :: f b) Source # | |
Defined in Data.Singletons.Prelude.Monad.Internal type Apply (LiftA3Sym2 a6989586621679559633 a6989586621679559634 :: TyFun (f b) (f c ~> f d) -> Type) (a6989586621679559635 :: f b) = LiftA3Sym3 a6989586621679559633 a6989586621679559634 a6989586621679559635 |
data LiftA3Sym3 a6989586621679559633 a6989586621679559634 a6989586621679559635 a6989586621679559636 Source #
Instances
(SApplicative f, SingI d2, SingI d3, SingI d4) => SingI (LiftA3Sym3 d2 d3 d4 :: TyFun (f c) (f d1) -> Type) Source # | |
Defined in Data.Singletons.Prelude.Monad.Internal sing :: Sing (LiftA3Sym3 d2 d3 d4) Source # | |
SuppressUnusedWarnings (LiftA3Sym3 a6989586621679559633 a6989586621679559634 a6989586621679559635 :: TyFun (f c) (f d) -> Type) Source # | |
Defined in Data.Singletons.Prelude.Monad.Internal suppressUnusedWarnings :: () Source # | |
type Apply (LiftA3Sym3 a6989586621679559633 a6989586621679559634 a6989586621679559635 :: TyFun (f c) (f d) -> Type) (a6989586621679559636 :: f c) Source # | |
Defined in Data.Singletons.Prelude.Monad.Internal type Apply (LiftA3Sym3 a6989586621679559633 a6989586621679559634 a6989586621679559635 :: TyFun (f c) (f d) -> Type) (a6989586621679559636 :: f c) |
data OptionalSym0 a6989586621681282965 Source #
Instances
SAlternative f => SingI (OptionalSym0 :: TyFun (f a) (f (Maybe a)) -> Type) Source # | |
Defined in Data.Singletons.Prelude.Applicative sing :: Sing OptionalSym0 Source # | |
SuppressUnusedWarnings (OptionalSym0 :: TyFun (f a) (f (Maybe a)) -> Type) Source # | |
Defined in Data.Singletons.Prelude.Applicative suppressUnusedWarnings :: () Source # | |
type Apply (OptionalSym0 :: TyFun (f a) (f (Maybe a)) -> Type) (a6989586621681282965 :: f a) Source # | |
Defined in Data.Singletons.Prelude.Applicative type Apply (OptionalSym0 :: TyFun (f a) (f (Maybe a)) -> Type) (a6989586621681282965 :: f a) = OptionalSym1 a6989586621681282965 |
type OptionalSym1 (a6989586621681282965 :: f a) = Optional a6989586621681282965 :: f (Maybe a) Source #
Orphan instances
SApplicative Down Source # | |
sPure :: forall a (t :: a). Sing t -> Sing (Apply PureSym0 t) Source # (%<*>) :: forall a b (t :: Down (a ~> b)) (t :: Down a). Sing t -> Sing t -> Sing (Apply (Apply (<*>@#@$) t) t) Source # sLiftA2 :: forall a b c (t :: a ~> (b ~> c)) (t :: Down a) (t :: Down b). Sing t -> Sing t -> Sing t -> Sing (Apply (Apply (Apply LiftA2Sym0 t) t) t) Source # (%*>) :: forall a b (t :: Down a) (t :: Down b). Sing t -> Sing t -> Sing (Apply (Apply (*>@#@$) t) t) Source # (%<*) :: forall a b (t :: Down a) (t :: Down b). Sing t -> Sing t -> Sing (Apply (Apply (<*@#@$) t) t) Source # | |
PApplicative Down Source # | |
SMonoid a => SApplicative ((,) a) Source # | |
sPure :: forall a0 (t :: a0). Sing t -> Sing (Apply PureSym0 t) Source # (%<*>) :: forall a0 b (t :: (a, a0 ~> b)) (t :: (a, a0)). Sing t -> Sing t -> Sing (Apply (Apply (<*>@#@$) t) t) Source # sLiftA2 :: forall a0 b c (t :: a0 ~> (b ~> c)) (t :: (a, a0)) (t :: (a, b)). Sing t -> Sing t -> Sing t -> Sing (Apply (Apply (Apply LiftA2Sym0 t) t) t) Source # (%*>) :: forall a0 b (t :: (a, a0)) (t :: (a, b)). Sing t -> Sing t -> Sing (Apply (Apply (*>@#@$) t) t) Source # (%<*) :: forall a0 b (t :: (a, a0)) (t :: (a, b)). Sing t -> Sing t -> Sing (Apply (Apply (<*@#@$) t) t) Source # | |
PApplicative ((,) a) Source # | |