-- Hoogle documentation, generated by Haddock -- See Hoogle, http://www.haskell.org/hoogle/ -- | A box of patterns and paradigms -- -- Humble attempt to define a library for problem solving based on math -- abstractions. @package pandora @version 0.1.1 module Pandora.Core.Morphism identity :: a -> a fix :: (a -> a) -> a (.) :: (b -> c) -> (a -> b) -> a -> c infixr 8 . ($) :: (a -> b) -> a -> b infixr 0 $ (&) :: a -> (a -> b) -> b infixl 1 & (!) :: a -> b -> a infixr 2 ! (?) :: (a -> b -> c) -> b -> a -> c infixr 9 ? module Pandora.Paradigm.Basis.Fix newtype Fix t Fix :: t (Fix t) -> Fix t [unfix] :: Fix t -> t (Fix t) module Pandora.Pattern.Functor.Contravariant -- |
-- When providing a new instance, you should ensure it satisfies the two laws: -- * Identity morphism: contramap identity ≡ identity -- * Composition of morphisms: contramap f . contramap g ≡ contramap (g . f) --class Contravariant (t :: * -> *) -- | Infix version of contramap (>$<) :: Contravariant t => (a -> b) -> t b -> t a -- | Prefix version of >$< contramap :: Contravariant t => (a -> b) -> t b -> t a -- | Replace all locations in the output with the same value (>$) :: Contravariant t => b -> t b -> t a -- | Flipped version of >$ ($<) :: Contravariant t => t b -> b -> t a -- | Fill the input of evaluation full :: Contravariant t => t () -> t a infixl 4 >$< infixl 4 $< infixl 4 >$ module Pandora.Pattern.Functor.Covariant -- |
-- When providing a new instance, you should ensure it satisfies the two laws: -- * Identity morphism: comap identity ≡ identity -- * Composition of morphisms: comap (f . g) ≡ comap f . comap g --class Covariant (t :: * -> *) -- | Infix version of comap (<$>) :: Covariant t => (a -> b) -> t a -> t b -- | Prefix version of <$> comap :: Covariant t => (a -> b) -> t a -> t b -- | Replace all locations in the input with the same value (<$) :: Covariant t => a -> t b -> t a -- | Flipped version of <$ ($>) :: Covariant t => t a -> b -> t b -- | Discards the result of evaluation void :: Covariant t => t a -> t () infixl 4 <$> infixl 4 <$ infixl 4 $> instance Pandora.Pattern.Functor.Covariant.Covariant ((->) a) module Pandora.Pattern.Functor.Applicative -- |
-- When providing a new instance, you should ensure it satisfies the three laws: -- * Composition: (.) <$> u <*> v <*> w ≡ u <*> (v <*> w) -- * Left interchange: x <*> (f <$> y) ≡ (. f) <$> x <*> y -- * Right interchange: f <$> (x <*> y) ≡ (f .) <$> x <*> y --class Covariant t => Applicative t -- | Infix version of apply (<*>) :: Applicative t => t (a -> b) -> t a -> t b -- | Prefix version of <*> apply :: Applicative t => t (a -> b) -> t a -> t b -- | Sequence actions, discarding the value of the first argument (*>) :: Applicative t => t a -> t b -> t b -- | Sequence actions, discarding the value of the second argument (<*) :: Applicative t => t a -> t b -> t a -- | Repeat an action indefinitely forever :: Applicative t => t a -> t b infixl 4 <*> infixl 4 *> infixl 4 <* module Pandora.Pattern.Functor.Alternative -- |
-- When providing a new instance, you should ensure it satisfies the two laws: -- * Associativity of <+>: (x <+> y) <+> z ≡ x <+> (y <+> z) -- * Left-distributes <$> over <+>: f <$> (x <+> y) ≡ (f <$> x) <+> (f <$> y) --class Covariant t => Alternative t -- | Infix version of alter (<+>) :: Alternative t => t a -> t a -> t a -- | Prefix version of <+> alter :: Alternative t => t a -> t a -> t a infixl 3 <+> module Pandora.Paradigm.Junction.Kan newtype Lan (t :: * -> *) (u :: * -> *) (b :: *) (a :: *) Lan :: ((t b -> a) -> u b) -> Lan [lan] :: Lan -> (t b -> a) -> u b newtype Ran (t :: * -> *) (u :: * -> *) (b :: *) (a :: *) Ran :: ((a -> t b) -> u b) -> Ran [ran] :: Ran -> (a -> t b) -> u b instance Pandora.Pattern.Functor.Covariant.Covariant (Pandora.Paradigm.Junction.Kan.Ran t u b) instance Pandora.Pattern.Functor.Contravariant.Contravariant (Pandora.Paradigm.Junction.Kan.Lan t u b) module Pandora.Core.Functor data Variant Co :: Variant Contra :: Variant type Natural t u = forall a. (Covariant t, Covariant u) => t a -> u a type (~>) t u = Natural t u type (:.:) t u a = t (u a) infixr 0 :.: module Pandora.Pattern.Functor.Bindable -- |
-- When providing a new instance, you should ensure it satisfies the one law: -- * Interchange: t >>= f = join (f <$> t) --class Covariant t => Bindable t -- | Infix and flipped version of bind, the dual of -- =>> (>>=) :: Bindable t => t a -> (a -> t b) -> t b -- | Flipped version of >>=, the dual of <<= (=<<) :: Bindable t => (a -> t b) -> t a -> t b -- | Prefix and flipped version of >>=, the dual of -- extend bind :: Bindable t => (a -> t b) -> t a -> t b -- | Merge effects/contexts, the dual of duplicate join :: Bindable t => (t :.: t) a -> t a -- | Left-to-right Kleisli composition (>=>) :: Bindable t => (a -> t b) -> (b -> t c) -> a -> t c -- | Right-to-left Kleisli composition (<=<) :: Bindable t => (b -> t c) -> (a -> t b) -> a -> t c infixl 1 >>= infixr 1 =<< infixr 1 <=< infixr 1 >=> module Pandora.Pattern.Functor.Adjoint -- |
-- When providing a new instance, you should ensure it satisfies the four laws: -- * Left adjunction identity: phi counit ≡ identity -- * Right adjunction identity: psi unit ≡ identity -- * Left adjunction interchange: phi f ≡ comap f . eta -- * Right adjunction interchange: psi f ≡ epsilon . comap f --class (Covariant t, Covariant u) => Adjoint t u -- | Left adjunction phi :: Adjoint t u => (t a -> b) -> a -> u b -- | Right adjunction psi :: Adjoint t u => (a -> u b) -> t a -> b eta :: Adjoint t u => a -> (u :.: t) a epsilon :: Adjoint t u => (t :.: u) a -> a type (-|) = Adjoint module Pandora.Pattern.Functor.Distributive -- |
-- Let f :: Distributive g => (a -> g b) ---- --
-- When providing a new instance, you should ensure it satisfies the two laws: -- * Identity morphism: distribute . distribute ≡ identity -- * Interchange collection: collect f ≡ distribute . comap f --class Covariant u => Distributive u -- | Infix version of collect (>>-) :: (Distributive u, Covariant t) => t a -> (a -> u b) -> (u :.: t) b -- | Prefix version of >>- collect :: (Distributive u, Covariant t) => (a -> u b) -> t a -> (u :.: t) b -- | The dual of sequence distribute :: (Distributive u, Covariant t) => (t :.: u) a -> (u :.: t) a module Pandora.Pattern.Functor.Exclusive -- |
-- When providing a new instance, you should ensure it satisfies the two laws: -- * Left absorption: x <+> exclusive ≡ x -- * Right absorption: exclusive <+> x ≡ x --class Alternative t => Exclusive t exclusive :: Exclusive t => t a module Pandora.Pattern.Functor.Extendable -- |
-- When providing a new instance, you should ensure it satisfies the three laws: -- * Duplication interchange: comap (comap f) . duplicate ≡ duplicate . comap f -- * Extension interchange: extend f ≡ comap f . duplicate --class Covariant t => Extendable t -- | Infix and flipped version of extend, the dual of -- >>= (=>>) :: Extendable t => t a -> (t a -> b) -> t b -- | Flipped version of >>=, the dual of =<< (<<=) :: Extendable t => (t a -> b) -> t a -> t b -- | Prefix and flipped version of =>>, the dual of -- bind extend :: Extendable t => (t a -> b) -> t a -> t b -- | Clone existing structure, the dual of join duplicate :: Extendable t => t a -> (t :.: t) a -- | Right-to-left Cokleisli composition (=<=) :: Extendable t => (t b -> c) -> (t a -> b) -> t a -> c -- | Left-to-right Cokleisli composition (=>=) :: Extendable t => (t a -> b) -> (t b -> c) -> t a -> c infixl 1 =>> infixr 1 <<= infixr 1 =<= infixr 1 =>= module Pandora.Pattern.Functor.Extractable class Covariant t => Extractable t extract :: Extractable t => t a -> a module Pandora.Pattern.Functor.Comonad -- |
-- Let f :: (Pointable t, Bindable t) => t a -> b -- Let g :: (Pointable t, Bindable t) => t a -> b ---- --
-- When providing a new instance, you should ensure it satisfies the three laws: -- * Left identity: extend extract ≡ identity -- * Right identity: extract . extend f ≡ f -- * Associativity: extend f . extend g ≡ extend (f . extend g) --class (Extractable t, Extendable t) => Comonad t module Pandora.Paradigm.Basis.Product data Product a b (:*) :: a -> b -> Product a b infixr 1 :* type (:*) = Product infixr 1 :* delta :: a -> a :* a swap :: (a :* b) -> b :* a attached :: (a :* b) -> a instance Pandora.Pattern.Functor.Covariant.Covariant (Pandora.Paradigm.Basis.Product.Product a) instance Pandora.Pattern.Functor.Extractable.Extractable (Pandora.Paradigm.Basis.Product.Product a) instance Pandora.Pattern.Functor.Extendable.Extendable (Pandora.Paradigm.Basis.Product.Product a) instance Pandora.Pattern.Functor.Comonad.Comonad (Pandora.Paradigm.Basis.Product.Product a) instance Pandora.Pattern.Functor.Adjoint.Adjoint (Pandora.Paradigm.Basis.Product.Product a) ((->) a) module Pandora.Pattern.Functor.Invariant -- |
-- When providing a new instance, you should ensure it satisfies the two laws: -- Identity morphisms: invmap identity identity = identity -- Composition of morphisms: invmap g j . invmap f h = invmap (g . f) (h . j) --class Invariant (t :: * -> *) invmap :: Invariant t => (a -> b) -> (b -> a) -> t a -> t b module Pandora.Pattern.Functor.Liftable class Liftable t lift :: (Liftable t, Covariant u) => u ~> t u module Pandora.Pattern.Functor.Lowerable class Lowerable t lower :: (Lowerable t, Covariant u) => t u ~> u module Pandora.Pattern.Functor.Pointable class Covariant t => Pointable t point :: Pointable t => a -> t a module Pandora.Pattern.Functor.Monad -- |
-- Let f :: (Pointable t, Bindable t) => a -> t a -- Let g :: (Pointable t, Bindable t) => a -> t a -- Let h :: (Pointable t, Bindable t) => t a ---- --
-- When providing a new instance, you should ensure it satisfies the three laws: -- * Left identity: point a >>= f ≡ f a -- * Right identity: h >>= point ≡ h -- * Associativity: h >>= (\x -> f x >>= g) ≡ (h >>= f) >>= g --class (Pointable t, Bindable t) => Monad t module Pandora.Paradigm.Basis.Yoneda newtype Yoneda t a Yoneda :: (forall b. (a -> b) -> t b) -> Yoneda t a [yoneda] :: Yoneda t a -> forall b. (a -> b) -> t b instance Pandora.Pattern.Functor.Covariant.Covariant (Pandora.Paradigm.Basis.Yoneda.Yoneda t) instance Pandora.Pattern.Functor.Alternative.Alternative t => Pandora.Pattern.Functor.Alternative.Alternative (Pandora.Paradigm.Basis.Yoneda.Yoneda t) instance Pandora.Pattern.Functor.Applicative.Applicative t => Pandora.Pattern.Functor.Applicative.Applicative (Pandora.Paradigm.Basis.Yoneda.Yoneda t) instance Pandora.Pattern.Functor.Exclusive.Exclusive t => Pandora.Pattern.Functor.Exclusive.Exclusive (Pandora.Paradigm.Basis.Yoneda.Yoneda t) instance Pandora.Pattern.Functor.Pointable.Pointable t => Pandora.Pattern.Functor.Pointable.Pointable (Pandora.Paradigm.Basis.Yoneda.Yoneda t) instance Pandora.Pattern.Functor.Extractable.Extractable t => Pandora.Pattern.Functor.Extractable.Extractable (Pandora.Paradigm.Basis.Yoneda.Yoneda t) instance (Pandora.Pattern.Functor.Extractable.Extractable t, Pandora.Pattern.Functor.Pointable.Pointable t, Pandora.Pattern.Functor.Extractable.Extractable u, Pandora.Pattern.Functor.Pointable.Pointable u) => Pandora.Pattern.Functor.Adjoint.Adjoint (Pandora.Paradigm.Basis.Yoneda.Yoneda t) (Pandora.Paradigm.Basis.Yoneda.Yoneda u) module Pandora.Paradigm.Basis.Continuation newtype Continuation r t a Continuation :: ((a -> t r) -> t r) -> Continuation r t a [continue] :: Continuation r t a -> (a -> t r) -> t r -- | Make any bindable action continue oblige :: Bindable t => t a -> Continuation r t a -- | Call with current continuation cwcc :: ((a -> Continuation r t b) -> Continuation r t a) -> Continuation r t a instance Pandora.Pattern.Functor.Covariant.Covariant t => Pandora.Pattern.Functor.Covariant.Covariant (Pandora.Paradigm.Basis.Continuation.Continuation r t) instance Pandora.Pattern.Functor.Covariant.Covariant t => Pandora.Pattern.Functor.Pointable.Pointable (Pandora.Paradigm.Basis.Continuation.Continuation r t) instance Pandora.Pattern.Functor.Covariant.Covariant t => Pandora.Pattern.Functor.Applicative.Applicative (Pandora.Paradigm.Basis.Continuation.Continuation r t) instance Pandora.Pattern.Functor.Covariant.Covariant t => Pandora.Pattern.Functor.Bindable.Bindable (Pandora.Paradigm.Basis.Continuation.Continuation r t) instance Pandora.Pattern.Functor.Monad.Monad t => Pandora.Pattern.Functor.Monad.Monad (Pandora.Paradigm.Basis.Continuation.Continuation r t) module Pandora.Paradigm.Controlflow.Observable type Observable t a r = Continuation r (Capture r t) a -- | Make continuation observable observe :: Continuation r t a -> Observable t a r -- | Listen only first event, call back just once notify :: Observable t a r -> (a -> t r) -> t r -- | Listen only first event, call back forever follow :: Applicative t => Observable t a r -> (a -> t r) -> t r -- | Listen all events from action, call back just once subscribe :: Applicative t => Observable t a r -> (a -> t r) -> t r -- | Listen all events from action, call back forever watch :: Applicative t => Observable t a r -> (a -> t r) -> t r -- | Infix version of notify (.:~.) :: Observable t a r -> (a -> t r) -> t r -- | Infix version of follow (.:~*) :: Applicative t => Observable t a r -> (a -> t r) -> t r -- | Infix version of subscribe (*:~.) :: Applicative t => Observable t a r -> (a -> t r) -> t r -- | Infix version of watch (*:~*) :: Applicative t => Observable t a r -> (a -> t r) -> t r module Pandora.Paradigm.Controlflow module Pandora.Pattern.Functor.Traversable -- |
-- Let f :: (Applicative t, Applicative g) => t a -> u a -- Let p :: (Pointable t, Pointable g) => t a -> u a ---- --
-- When providing a new instance, you should ensure it satisfies the four laws: -- * Naturality of traversing: g . traverse f ≡ traverse (g . f) -- * Naturality of sequencing: f . sequence = sequence . comap f -- * Preserving point: p (point x) ≡ point x -- * Preserving apply: f (x <*> y) ≡ f x <*> f y --class Covariant t => Traversable t -- | Infix version of traverse (->>) :: (Traversable t, Pointable u, Applicative u) => t a -> (a -> u b) -> (u :.: t) b -- | Prefix version of ->> traverse :: (Traversable t, Pointable u, Applicative u) => (a -> u b) -> t a -> (u :.: t) b -- | The dual of distribute sequence :: (Traversable t, Pointable u, Applicative u) => (t :.: u) a -> (u :.: t) a module Pandora.Pattern.Functor module Pandora.Paradigm.Junction.Transformer newtype T t u a T :: (u :.: t) a -> T t u a [t] :: T t u a -> (u :.: t) a type (:!:) t u = T t u infixr 0 :!: up :: Pointable u => t a -> T t u a newtype Y t u a Y :: (u :.: t u) a -> Y t u a [y] :: Y t u a -> (u :.: t u) a type (:>:) t u = Y t u infixr 0 :>: instance (Pandora.Pattern.Functor.Covariant.Covariant (t u), Pandora.Pattern.Functor.Covariant.Covariant u) => Pandora.Pattern.Functor.Covariant.Covariant (Pandora.Paradigm.Junction.Transformer.Y t u) instance (Pandora.Pattern.Functor.Pointable.Pointable (t u), Pandora.Pattern.Functor.Pointable.Pointable u) => Pandora.Pattern.Functor.Pointable.Pointable (Pandora.Paradigm.Junction.Transformer.Y t u) instance (Pandora.Pattern.Functor.Extractable.Extractable (t u), Pandora.Pattern.Functor.Extractable.Extractable u) => Pandora.Pattern.Functor.Extractable.Extractable (Pandora.Paradigm.Junction.Transformer.Y t u) instance (Pandora.Pattern.Functor.Covariant.Covariant (t u), Pandora.Pattern.Functor.Exclusive.Exclusive u) => Pandora.Pattern.Functor.Exclusive.Exclusive (Pandora.Paradigm.Junction.Transformer.Y t u) instance (Pandora.Pattern.Functor.Covariant.Covariant (t u), Pandora.Pattern.Functor.Alternative.Alternative u) => Pandora.Pattern.Functor.Alternative.Alternative (Pandora.Paradigm.Junction.Transformer.Y t u) instance (Pandora.Pattern.Functor.Applicative.Applicative (t u), Pandora.Pattern.Functor.Applicative.Applicative u) => Pandora.Pattern.Functor.Applicative.Applicative (Pandora.Paradigm.Junction.Transformer.Y t u) instance (Pandora.Pattern.Functor.Traversable.Traversable (t u), Pandora.Pattern.Functor.Traversable.Traversable u) => Pandora.Pattern.Functor.Traversable.Traversable (Pandora.Paradigm.Junction.Transformer.Y t u) instance (Pandora.Pattern.Functor.Distributive.Distributive (t u), Pandora.Pattern.Functor.Distributive.Distributive u) => Pandora.Pattern.Functor.Distributive.Distributive (Pandora.Paradigm.Junction.Transformer.Y t u) instance (forall (u :: * -> *). Pandora.Pattern.Functor.Pointable.Pointable u, Pandora.Pattern.Functor.Liftable.Liftable t) => Pandora.Pattern.Functor.Liftable.Liftable (Pandora.Paradigm.Junction.Transformer.Y t) instance (forall (u :: * -> *). Pandora.Pattern.Functor.Extractable.Extractable u, Pandora.Pattern.Functor.Lowerable.Lowerable t) => Pandora.Pattern.Functor.Lowerable.Lowerable (Pandora.Paradigm.Junction.Transformer.Y t) instance (Pandora.Pattern.Functor.Covariant.Covariant t, Pandora.Pattern.Functor.Covariant.Covariant u) => Pandora.Pattern.Functor.Covariant.Covariant (Pandora.Paradigm.Junction.Transformer.T t u) instance (Pandora.Pattern.Functor.Pointable.Pointable t, Pandora.Pattern.Functor.Pointable.Pointable u) => Pandora.Pattern.Functor.Pointable.Pointable (Pandora.Paradigm.Junction.Transformer.T t u) instance (Pandora.Pattern.Functor.Extractable.Extractable t, Pandora.Pattern.Functor.Extractable.Extractable u) => Pandora.Pattern.Functor.Extractable.Extractable (Pandora.Paradigm.Junction.Transformer.T t u) instance (Pandora.Pattern.Functor.Covariant.Covariant t, Pandora.Pattern.Functor.Exclusive.Exclusive u) => Pandora.Pattern.Functor.Exclusive.Exclusive (Pandora.Paradigm.Junction.Transformer.T t u) instance (Pandora.Pattern.Functor.Covariant.Covariant t, Pandora.Pattern.Functor.Alternative.Alternative u) => Pandora.Pattern.Functor.Alternative.Alternative (Pandora.Paradigm.Junction.Transformer.T t u) instance (Pandora.Pattern.Functor.Applicative.Applicative t, Pandora.Pattern.Functor.Applicative.Applicative u) => Pandora.Pattern.Functor.Applicative.Applicative (Pandora.Paradigm.Junction.Transformer.T t u) instance Pandora.Pattern.Functor.Pointable.Pointable t => Pandora.Pattern.Functor.Liftable.Liftable (Pandora.Paradigm.Junction.Transformer.T t) instance Pandora.Pattern.Functor.Extractable.Extractable t => Pandora.Pattern.Functor.Lowerable.Lowerable (Pandora.Paradigm.Junction.Transformer.T t) instance (Pandora.Pattern.Functor.Traversable.Traversable t, Pandora.Pattern.Functor.Traversable.Traversable u) => Pandora.Pattern.Functor.Traversable.Traversable (Pandora.Paradigm.Junction.Transformer.T t u) instance (Pandora.Pattern.Functor.Distributive.Distributive t, Pandora.Pattern.Functor.Distributive.Distributive u) => Pandora.Pattern.Functor.Distributive.Distributive (Pandora.Paradigm.Junction.Transformer.T t u) module Pandora.Paradigm.Junction.Composition newtype U ct cu t u a U :: (t :.: u) a -> U ct cu t u a [u] :: U ct cu t u a -> (t :.: u) a newtype UU ct cu cv t u v a UU :: (t :.: (u :.: v)) a -> UU ct cu cv t u v a [uu] :: UU ct cu cv t u v a -> (t :.: (u :.: v)) a newtype UUU ct cu cv cw t u v w a UUU :: (t :.: (u :.: (v :.: w))) a -> UUU ct cu cv cw t u v w a [uuu] :: UUU ct cu cv cw t u v w a -> (t :.: (u :.: (v :.: w))) a instance (Pandora.Pattern.Functor.Covariant.Covariant t, Pandora.Pattern.Functor.Covariant.Covariant u, Pandora.Pattern.Functor.Covariant.Covariant v, Pandora.Pattern.Functor.Covariant.Covariant w) => Pandora.Pattern.Functor.Covariant.Covariant (Pandora.Paradigm.Junction.Composition.UUU 'Pandora.Core.Functor.Co 'Pandora.Core.Functor.Co 'Pandora.Core.Functor.Co 'Pandora.Core.Functor.Co t u v w) instance (Pandora.Pattern.Functor.Covariant.Covariant t, Pandora.Pattern.Functor.Covariant.Covariant u, Pandora.Pattern.Functor.Covariant.Covariant v, Pandora.Pattern.Functor.Contravariant.Contravariant w) => Pandora.Pattern.Functor.Contravariant.Contravariant (Pandora.Paradigm.Junction.Composition.UUU 'Pandora.Core.Functor.Co 'Pandora.Core.Functor.Co 'Pandora.Core.Functor.Co 'Pandora.Core.Functor.Contra t u v w) instance (Pandora.Pattern.Functor.Covariant.Covariant t, Pandora.Pattern.Functor.Covariant.Covariant u, Pandora.Pattern.Functor.Contravariant.Contravariant v, Pandora.Pattern.Functor.Covariant.Covariant w) => Pandora.Pattern.Functor.Contravariant.Contravariant (Pandora.Paradigm.Junction.Composition.UUU 'Pandora.Core.Functor.Co 'Pandora.Core.Functor.Co 'Pandora.Core.Functor.Contra 'Pandora.Core.Functor.Co t u v w) instance (Pandora.Pattern.Functor.Covariant.Covariant t, Pandora.Pattern.Functor.Contravariant.Contravariant u, Pandora.Pattern.Functor.Covariant.Covariant v, Pandora.Pattern.Functor.Covariant.Covariant w) => Pandora.Pattern.Functor.Contravariant.Contravariant (Pandora.Paradigm.Junction.Composition.UUU 'Pandora.Core.Functor.Co 'Pandora.Core.Functor.Contra 'Pandora.Core.Functor.Co 'Pandora.Core.Functor.Co t u v w) instance (Pandora.Pattern.Functor.Contravariant.Contravariant t, Pandora.Pattern.Functor.Covariant.Covariant u, Pandora.Pattern.Functor.Covariant.Covariant v, Pandora.Pattern.Functor.Covariant.Covariant w) => Pandora.Pattern.Functor.Contravariant.Contravariant (Pandora.Paradigm.Junction.Composition.UUU 'Pandora.Core.Functor.Contra 'Pandora.Core.Functor.Co 'Pandora.Core.Functor.Co 'Pandora.Core.Functor.Co t u v w) instance (Pandora.Pattern.Functor.Contravariant.Contravariant t, Pandora.Pattern.Functor.Contravariant.Contravariant u, Pandora.Pattern.Functor.Covariant.Covariant v, Pandora.Pattern.Functor.Covariant.Covariant w) => Pandora.Pattern.Functor.Covariant.Covariant (Pandora.Paradigm.Junction.Composition.UUU 'Pandora.Core.Functor.Contra 'Pandora.Core.Functor.Contra 'Pandora.Core.Functor.Co 'Pandora.Core.Functor.Co t u v w) instance (Pandora.Pattern.Functor.Covariant.Covariant t, Pandora.Pattern.Functor.Contravariant.Contravariant u, Pandora.Pattern.Functor.Contravariant.Contravariant v, Pandora.Pattern.Functor.Covariant.Covariant w) => Pandora.Pattern.Functor.Covariant.Covariant (Pandora.Paradigm.Junction.Composition.UUU 'Pandora.Core.Functor.Co 'Pandora.Core.Functor.Contra 'Pandora.Core.Functor.Contra 'Pandora.Core.Functor.Co t u v w) instance (Pandora.Pattern.Functor.Covariant.Covariant t, Pandora.Pattern.Functor.Covariant.Covariant u, Pandora.Pattern.Functor.Contravariant.Contravariant v, Pandora.Pattern.Functor.Contravariant.Contravariant w) => Pandora.Pattern.Functor.Covariant.Covariant (Pandora.Paradigm.Junction.Composition.UUU 'Pandora.Core.Functor.Co 'Pandora.Core.Functor.Co 'Pandora.Core.Functor.Contra 'Pandora.Core.Functor.Contra t u v w) instance (Pandora.Pattern.Functor.Covariant.Covariant t, Pandora.Pattern.Functor.Contravariant.Contravariant u, Pandora.Pattern.Functor.Covariant.Covariant v, Pandora.Pattern.Functor.Contravariant.Contravariant w) => Pandora.Pattern.Functor.Covariant.Covariant (Pandora.Paradigm.Junction.Composition.UUU 'Pandora.Core.Functor.Co 'Pandora.Core.Functor.Contra 'Pandora.Core.Functor.Co 'Pandora.Core.Functor.Contra t u v w) instance (Pandora.Pattern.Functor.Contravariant.Contravariant t, Pandora.Pattern.Functor.Covariant.Covariant u, Pandora.Pattern.Functor.Contravariant.Contravariant v, Pandora.Pattern.Functor.Covariant.Covariant w) => Pandora.Pattern.Functor.Covariant.Covariant (Pandora.Paradigm.Junction.Composition.UUU 'Pandora.Core.Functor.Contra 'Pandora.Core.Functor.Co 'Pandora.Core.Functor.Contra 'Pandora.Core.Functor.Co t u v w) instance (Pandora.Pattern.Functor.Contravariant.Contravariant t, Pandora.Pattern.Functor.Covariant.Covariant u, Pandora.Pattern.Functor.Covariant.Covariant v, Pandora.Pattern.Functor.Contravariant.Contravariant w) => Pandora.Pattern.Functor.Covariant.Covariant (Pandora.Paradigm.Junction.Composition.UUU 'Pandora.Core.Functor.Contra 'Pandora.Core.Functor.Co 'Pandora.Core.Functor.Co 'Pandora.Core.Functor.Contra t u v w) instance (Pandora.Pattern.Functor.Contravariant.Contravariant t, Pandora.Pattern.Functor.Contravariant.Contravariant u, Pandora.Pattern.Functor.Contravariant.Contravariant v, Pandora.Pattern.Functor.Covariant.Covariant w) => Pandora.Pattern.Functor.Contravariant.Contravariant (Pandora.Paradigm.Junction.Composition.UUU 'Pandora.Core.Functor.Contra 'Pandora.Core.Functor.Contra 'Pandora.Core.Functor.Contra 'Pandora.Core.Functor.Co t u v w) instance (Pandora.Pattern.Functor.Covariant.Covariant t, Pandora.Pattern.Functor.Contravariant.Contravariant u, Pandora.Pattern.Functor.Contravariant.Contravariant v, Pandora.Pattern.Functor.Contravariant.Contravariant w) => Pandora.Pattern.Functor.Contravariant.Contravariant (Pandora.Paradigm.Junction.Composition.UUU 'Pandora.Core.Functor.Co 'Pandora.Core.Functor.Contra 'Pandora.Core.Functor.Contra 'Pandora.Core.Functor.Contra t u v w) instance (Pandora.Pattern.Functor.Contravariant.Contravariant t, Pandora.Pattern.Functor.Covariant.Covariant u, Pandora.Pattern.Functor.Contravariant.Contravariant v, Pandora.Pattern.Functor.Contravariant.Contravariant w) => Pandora.Pattern.Functor.Contravariant.Contravariant (Pandora.Paradigm.Junction.Composition.UUU 'Pandora.Core.Functor.Contra 'Pandora.Core.Functor.Co 'Pandora.Core.Functor.Contra 'Pandora.Core.Functor.Contra t u v w) instance (Pandora.Pattern.Functor.Contravariant.Contravariant t, Pandora.Pattern.Functor.Contravariant.Contravariant u, Pandora.Pattern.Functor.Covariant.Covariant v, Pandora.Pattern.Functor.Contravariant.Contravariant w) => Pandora.Pattern.Functor.Contravariant.Contravariant (Pandora.Paradigm.Junction.Composition.UUU 'Pandora.Core.Functor.Contra 'Pandora.Core.Functor.Contra 'Pandora.Core.Functor.Co 'Pandora.Core.Functor.Contra t u v w) instance (Pandora.Pattern.Functor.Contravariant.Contravariant t, Pandora.Pattern.Functor.Contravariant.Contravariant u, Pandora.Pattern.Functor.Contravariant.Contravariant v, Pandora.Pattern.Functor.Contravariant.Contravariant w) => Pandora.Pattern.Functor.Covariant.Covariant (Pandora.Paradigm.Junction.Composition.UUU 'Pandora.Core.Functor.Contra 'Pandora.Core.Functor.Contra 'Pandora.Core.Functor.Contra 'Pandora.Core.Functor.Contra t u v w) instance (Pandora.Pattern.Functor.Pointable.Pointable t, Pandora.Pattern.Functor.Pointable.Pointable u, Pandora.Pattern.Functor.Pointable.Pointable v, Pandora.Pattern.Functor.Pointable.Pointable w) => Pandora.Pattern.Functor.Pointable.Pointable (Pandora.Paradigm.Junction.Composition.UUU 'Pandora.Core.Functor.Co 'Pandora.Core.Functor.Co 'Pandora.Core.Functor.Co 'Pandora.Core.Functor.Co t u v w) instance (Pandora.Pattern.Functor.Extractable.Extractable t, Pandora.Pattern.Functor.Extractable.Extractable u, Pandora.Pattern.Functor.Extractable.Extractable v, Pandora.Pattern.Functor.Extractable.Extractable w) => Pandora.Pattern.Functor.Extractable.Extractable (Pandora.Paradigm.Junction.Composition.UUU 'Pandora.Core.Functor.Co 'Pandora.Core.Functor.Co 'Pandora.Core.Functor.Co 'Pandora.Core.Functor.Co t u v w) instance (Pandora.Pattern.Functor.Exclusive.Exclusive t, Pandora.Pattern.Functor.Covariant.Covariant u, Pandora.Pattern.Functor.Covariant.Covariant v, Pandora.Pattern.Functor.Covariant.Covariant w) => Pandora.Pattern.Functor.Exclusive.Exclusive (Pandora.Paradigm.Junction.Composition.UUU 'Pandora.Core.Functor.Co 'Pandora.Core.Functor.Co 'Pandora.Core.Functor.Co 'Pandora.Core.Functor.Co t u v w) instance (Pandora.Pattern.Functor.Applicative.Applicative t, Pandora.Pattern.Functor.Applicative.Applicative u, Pandora.Pattern.Functor.Applicative.Applicative v, Pandora.Pattern.Functor.Applicative.Applicative w) => Pandora.Pattern.Functor.Applicative.Applicative (Pandora.Paradigm.Junction.Composition.UUU 'Pandora.Core.Functor.Co 'Pandora.Core.Functor.Co 'Pandora.Core.Functor.Co 'Pandora.Core.Functor.Co t u v w) instance (Pandora.Pattern.Functor.Alternative.Alternative t, Pandora.Pattern.Functor.Covariant.Covariant u, Pandora.Pattern.Functor.Covariant.Covariant v, Pandora.Pattern.Functor.Covariant.Covariant w) => Pandora.Pattern.Functor.Alternative.Alternative (Pandora.Paradigm.Junction.Composition.UUU 'Pandora.Core.Functor.Co 'Pandora.Core.Functor.Co 'Pandora.Core.Functor.Co 'Pandora.Core.Functor.Co t u v w) instance (Pandora.Pattern.Functor.Traversable.Traversable t, Pandora.Pattern.Functor.Traversable.Traversable u, Pandora.Pattern.Functor.Traversable.Traversable v, Pandora.Pattern.Functor.Traversable.Traversable w) => Pandora.Pattern.Functor.Traversable.Traversable (Pandora.Paradigm.Junction.Composition.UUU 'Pandora.Core.Functor.Co 'Pandora.Core.Functor.Co 'Pandora.Core.Functor.Co 'Pandora.Core.Functor.Co t u v w) instance (Pandora.Pattern.Functor.Distributive.Distributive t, Pandora.Pattern.Functor.Distributive.Distributive u, Pandora.Pattern.Functor.Distributive.Distributive v, Pandora.Pattern.Functor.Distributive.Distributive w) => Pandora.Pattern.Functor.Distributive.Distributive (Pandora.Paradigm.Junction.Composition.UUU 'Pandora.Core.Functor.Co 'Pandora.Core.Functor.Co 'Pandora.Core.Functor.Co 'Pandora.Core.Functor.Co t u v w) instance (t Pandora.Paradigm.Junction.Composition.:-|: u, v Pandora.Paradigm.Junction.Composition.:-|: w, q Pandora.Paradigm.Junction.Composition.:-|: q, r Pandora.Paradigm.Junction.Composition.:-|: s) => Pandora.Pattern.Functor.Adjoint.Adjoint (Pandora.Paradigm.Junction.Composition.UUU 'Pandora.Core.Functor.Co 'Pandora.Core.Functor.Co 'Pandora.Core.Functor.Co 'Pandora.Core.Functor.Co t v q r) (Pandora.Paradigm.Junction.Composition.UUU 'Pandora.Core.Functor.Co 'Pandora.Core.Functor.Co 'Pandora.Core.Functor.Co 'Pandora.Core.Functor.Co u w q s) instance (Pandora.Pattern.Functor.Covariant.Covariant t, Pandora.Pattern.Functor.Covariant.Covariant u, Pandora.Pattern.Functor.Covariant.Covariant v) => Pandora.Pattern.Functor.Covariant.Covariant (Pandora.Paradigm.Junction.Composition.UU 'Pandora.Core.Functor.Co 'Pandora.Core.Functor.Co 'Pandora.Core.Functor.Co t u v) instance (Pandora.Pattern.Functor.Covariant.Covariant t, Pandora.Pattern.Functor.Covariant.Covariant u, Pandora.Pattern.Functor.Contravariant.Contravariant v) => Pandora.Pattern.Functor.Contravariant.Contravariant (Pandora.Paradigm.Junction.Composition.UU 'Pandora.Core.Functor.Co 'Pandora.Core.Functor.Co 'Pandora.Core.Functor.Contra t u v) instance (Pandora.Pattern.Functor.Covariant.Covariant t, Pandora.Pattern.Functor.Contravariant.Contravariant u, Pandora.Pattern.Functor.Covariant.Covariant v) => Pandora.Pattern.Functor.Contravariant.Contravariant (Pandora.Paradigm.Junction.Composition.UU 'Pandora.Core.Functor.Co 'Pandora.Core.Functor.Contra 'Pandora.Core.Functor.Co t u v) instance (Pandora.Pattern.Functor.Contravariant.Contravariant t, Pandora.Pattern.Functor.Covariant.Covariant u, Pandora.Pattern.Functor.Covariant.Covariant v) => Pandora.Pattern.Functor.Contravariant.Contravariant (Pandora.Paradigm.Junction.Composition.UU 'Pandora.Core.Functor.Contra 'Pandora.Core.Functor.Co 'Pandora.Core.Functor.Co t u v) instance (Pandora.Pattern.Functor.Contravariant.Contravariant t, Pandora.Pattern.Functor.Contravariant.Contravariant u, Pandora.Pattern.Functor.Covariant.Covariant v) => Pandora.Pattern.Functor.Covariant.Covariant (Pandora.Paradigm.Junction.Composition.UU 'Pandora.Core.Functor.Contra 'Pandora.Core.Functor.Contra 'Pandora.Core.Functor.Co t u v) instance (Pandora.Pattern.Functor.Covariant.Covariant t, Pandora.Pattern.Functor.Contravariant.Contravariant u, Pandora.Pattern.Functor.Contravariant.Contravariant v) => Pandora.Pattern.Functor.Covariant.Covariant (Pandora.Paradigm.Junction.Composition.UU 'Pandora.Core.Functor.Co 'Pandora.Core.Functor.Contra 'Pandora.Core.Functor.Contra t u v) instance (Pandora.Pattern.Functor.Contravariant.Contravariant t, Pandora.Pattern.Functor.Covariant.Covariant u, Pandora.Pattern.Functor.Contravariant.Contravariant v) => Pandora.Pattern.Functor.Covariant.Covariant (Pandora.Paradigm.Junction.Composition.UU 'Pandora.Core.Functor.Contra 'Pandora.Core.Functor.Co 'Pandora.Core.Functor.Contra t u v) instance (Pandora.Pattern.Functor.Contravariant.Contravariant t, Pandora.Pattern.Functor.Contravariant.Contravariant u, Pandora.Pattern.Functor.Contravariant.Contravariant v) => Pandora.Pattern.Functor.Contravariant.Contravariant (Pandora.Paradigm.Junction.Composition.UU 'Pandora.Core.Functor.Contra 'Pandora.Core.Functor.Contra 'Pandora.Core.Functor.Contra t u v) instance (Pandora.Pattern.Functor.Pointable.Pointable t, Pandora.Pattern.Functor.Pointable.Pointable u, Pandora.Pattern.Functor.Pointable.Pointable v) => Pandora.Pattern.Functor.Pointable.Pointable (Pandora.Paradigm.Junction.Composition.UU 'Pandora.Core.Functor.Co 'Pandora.Core.Functor.Co 'Pandora.Core.Functor.Co t u v) instance (Pandora.Pattern.Functor.Extractable.Extractable t, Pandora.Pattern.Functor.Extractable.Extractable u, Pandora.Pattern.Functor.Extractable.Extractable v) => Pandora.Pattern.Functor.Extractable.Extractable (Pandora.Paradigm.Junction.Composition.UU 'Pandora.Core.Functor.Co 'Pandora.Core.Functor.Co 'Pandora.Core.Functor.Co t u v) instance (Pandora.Pattern.Functor.Exclusive.Exclusive t, Pandora.Pattern.Functor.Covariant.Covariant u, Pandora.Pattern.Functor.Covariant.Covariant v) => Pandora.Pattern.Functor.Exclusive.Exclusive (Pandora.Paradigm.Junction.Composition.UU 'Pandora.Core.Functor.Co 'Pandora.Core.Functor.Co 'Pandora.Core.Functor.Co t u v) instance (Pandora.Pattern.Functor.Applicative.Applicative t, Pandora.Pattern.Functor.Applicative.Applicative u, Pandora.Pattern.Functor.Applicative.Applicative v) => Pandora.Pattern.Functor.Applicative.Applicative (Pandora.Paradigm.Junction.Composition.UU 'Pandora.Core.Functor.Co 'Pandora.Core.Functor.Co 'Pandora.Core.Functor.Co t u v) instance (Pandora.Pattern.Functor.Alternative.Alternative t, Pandora.Pattern.Functor.Covariant.Covariant u, Pandora.Pattern.Functor.Covariant.Covariant v) => Pandora.Pattern.Functor.Alternative.Alternative (Pandora.Paradigm.Junction.Composition.UU 'Pandora.Core.Functor.Co 'Pandora.Core.Functor.Co 'Pandora.Core.Functor.Co t u v) instance (Pandora.Pattern.Functor.Traversable.Traversable t, Pandora.Pattern.Functor.Traversable.Traversable u, Pandora.Pattern.Functor.Traversable.Traversable v) => Pandora.Pattern.Functor.Traversable.Traversable (Pandora.Paradigm.Junction.Composition.UU 'Pandora.Core.Functor.Co 'Pandora.Core.Functor.Co 'Pandora.Core.Functor.Co t u v) instance (Pandora.Pattern.Functor.Distributive.Distributive t, Pandora.Pattern.Functor.Distributive.Distributive u, Pandora.Pattern.Functor.Distributive.Distributive v) => Pandora.Pattern.Functor.Distributive.Distributive (Pandora.Paradigm.Junction.Composition.UU 'Pandora.Core.Functor.Co 'Pandora.Core.Functor.Co 'Pandora.Core.Functor.Co t u v) instance (t Pandora.Paradigm.Junction.Composition.:-|: w, v Pandora.Paradigm.Junction.Composition.:-|: x, u Pandora.Paradigm.Junction.Composition.:-|: y) => Pandora.Pattern.Functor.Adjoint.Adjoint (Pandora.Paradigm.Junction.Composition.UU 'Pandora.Core.Functor.Co 'Pandora.Core.Functor.Co 'Pandora.Core.Functor.Co t v u) (Pandora.Paradigm.Junction.Composition.UU 'Pandora.Core.Functor.Co 'Pandora.Core.Functor.Co 'Pandora.Core.Functor.Co w x y) instance (Pandora.Pattern.Functor.Covariant.Covariant t, Pandora.Pattern.Functor.Covariant.Covariant u) => Pandora.Pattern.Functor.Covariant.Covariant (Pandora.Paradigm.Junction.Composition.U 'Pandora.Core.Functor.Co 'Pandora.Core.Functor.Co t u) instance (Pandora.Pattern.Functor.Covariant.Covariant t, Pandora.Pattern.Functor.Contravariant.Contravariant u) => Pandora.Pattern.Functor.Contravariant.Contravariant (Pandora.Paradigm.Junction.Composition.U 'Pandora.Core.Functor.Co 'Pandora.Core.Functor.Contra t u) instance (Pandora.Pattern.Functor.Contravariant.Contravariant t, Pandora.Pattern.Functor.Covariant.Covariant u) => Pandora.Pattern.Functor.Contravariant.Contravariant (Pandora.Paradigm.Junction.Composition.U 'Pandora.Core.Functor.Contra 'Pandora.Core.Functor.Co t u) instance (Pandora.Pattern.Functor.Contravariant.Contravariant t, Pandora.Pattern.Functor.Contravariant.Contravariant u) => Pandora.Pattern.Functor.Covariant.Covariant (Pandora.Paradigm.Junction.Composition.U 'Pandora.Core.Functor.Contra 'Pandora.Core.Functor.Contra t u) instance (Pandora.Pattern.Functor.Pointable.Pointable t, Pandora.Pattern.Functor.Pointable.Pointable u) => Pandora.Pattern.Functor.Pointable.Pointable (Pandora.Paradigm.Junction.Composition.U 'Pandora.Core.Functor.Co 'Pandora.Core.Functor.Co t u) instance (Pandora.Pattern.Functor.Extractable.Extractable t, Pandora.Pattern.Functor.Extractable.Extractable u) => Pandora.Pattern.Functor.Extractable.Extractable (Pandora.Paradigm.Junction.Composition.U 'Pandora.Core.Functor.Co 'Pandora.Core.Functor.Co t u) instance (Pandora.Pattern.Functor.Exclusive.Exclusive t, Pandora.Pattern.Functor.Covariant.Covariant u) => Pandora.Pattern.Functor.Exclusive.Exclusive (Pandora.Paradigm.Junction.Composition.U 'Pandora.Core.Functor.Co 'Pandora.Core.Functor.Co t u) instance (Pandora.Pattern.Functor.Applicative.Applicative t, Pandora.Pattern.Functor.Applicative.Applicative u) => Pandora.Pattern.Functor.Applicative.Applicative (Pandora.Paradigm.Junction.Composition.U 'Pandora.Core.Functor.Co 'Pandora.Core.Functor.Co t u) instance (Pandora.Pattern.Functor.Alternative.Alternative t, Pandora.Pattern.Functor.Covariant.Covariant u) => Pandora.Pattern.Functor.Alternative.Alternative (Pandora.Paradigm.Junction.Composition.U 'Pandora.Core.Functor.Co 'Pandora.Core.Functor.Co t u) instance (Pandora.Pattern.Functor.Traversable.Traversable t, Pandora.Pattern.Functor.Traversable.Traversable u) => Pandora.Pattern.Functor.Traversable.Traversable (Pandora.Paradigm.Junction.Composition.U 'Pandora.Core.Functor.Co 'Pandora.Core.Functor.Co t u) instance (Pandora.Pattern.Functor.Distributive.Distributive t, Pandora.Pattern.Functor.Distributive.Distributive u) => Pandora.Pattern.Functor.Distributive.Distributive (Pandora.Paradigm.Junction.Composition.U 'Pandora.Core.Functor.Co 'Pandora.Core.Functor.Co t u) instance (t Pandora.Paradigm.Junction.Composition.:-|: u, v Pandora.Paradigm.Junction.Composition.:-|: w) => Pandora.Pattern.Functor.Adjoint.Adjoint (Pandora.Paradigm.Junction.Composition.U 'Pandora.Core.Functor.Co 'Pandora.Core.Functor.Co t v) (Pandora.Paradigm.Junction.Composition.U 'Pandora.Core.Functor.Co 'Pandora.Core.Functor.Co u w) module Pandora.Paradigm.Junction module Pandora.Paradigm.Basis.Wye data Wye a End :: Wye a Left :: a -> Wye a Right :: a -> Wye a Both :: a -> a -> Wye a wye :: r -> (a -> r) -> (a -> r) -> (a -> a -> r) -> Wye a -> r instance Pandora.Pattern.Functor.Covariant.Covariant Pandora.Paradigm.Basis.Wye.Wye instance Pandora.Pattern.Functor.Traversable.Traversable Pandora.Paradigm.Basis.Wye.Wye module Pandora.Paradigm.Basis.Jack data Jack t a It :: a -> Jack t a Other :: t a -> Jack t a jack :: (a -> r) -> (t a -> r) -> Jack t a -> r instance Pandora.Pattern.Functor.Covariant.Covariant t => Pandora.Pattern.Functor.Covariant.Covariant (Pandora.Paradigm.Basis.Jack.Jack t) instance Pandora.Pattern.Functor.Covariant.Covariant t => Pandora.Pattern.Functor.Pointable.Pointable (Pandora.Paradigm.Basis.Jack.Jack t) instance Pandora.Pattern.Functor.Alternative.Alternative t => Pandora.Pattern.Functor.Alternative.Alternative (Pandora.Paradigm.Basis.Jack.Jack t) instance Pandora.Pattern.Functor.Exclusive.Exclusive t => Pandora.Pattern.Functor.Exclusive.Exclusive (Pandora.Paradigm.Basis.Jack.Jack t) instance Pandora.Pattern.Functor.Applicative.Applicative t => Pandora.Pattern.Functor.Applicative.Applicative (Pandora.Paradigm.Basis.Jack.Jack t) instance Pandora.Pattern.Functor.Traversable.Traversable t => Pandora.Pattern.Functor.Traversable.Traversable (Pandora.Paradigm.Basis.Jack.Jack t) instance Pandora.Pattern.Functor.Distributive.Distributive t => Pandora.Pattern.Functor.Distributive.Distributive (Pandora.Paradigm.Basis.Jack.Jack t) instance Pandora.Pattern.Functor.Liftable.Liftable Pandora.Paradigm.Basis.Jack.Jack module Pandora.Paradigm.Basis.Free data Free t a Pure :: a -> Free t a Impure :: (t :.: Free t) a -> Free t a instance Pandora.Pattern.Functor.Covariant.Covariant t => Pandora.Pattern.Functor.Covariant.Covariant (Pandora.Paradigm.Basis.Free.Free t) instance Pandora.Pattern.Functor.Covariant.Covariant t => Pandora.Pattern.Functor.Pointable.Pointable (Pandora.Paradigm.Basis.Free.Free t) instance Pandora.Pattern.Functor.Alternative.Alternative t => Pandora.Pattern.Functor.Alternative.Alternative (Pandora.Paradigm.Basis.Free.Free t) instance Pandora.Pattern.Functor.Exclusive.Exclusive t => Pandora.Pattern.Functor.Exclusive.Exclusive (Pandora.Paradigm.Basis.Free.Free t) instance Pandora.Pattern.Functor.Covariant.Covariant t => Pandora.Pattern.Functor.Applicative.Applicative (Pandora.Paradigm.Basis.Free.Free t) instance Pandora.Pattern.Functor.Covariant.Covariant t => Pandora.Pattern.Functor.Bindable.Bindable (Pandora.Paradigm.Basis.Free.Free t) instance Pandora.Pattern.Functor.Traversable.Traversable t => Pandora.Pattern.Functor.Traversable.Traversable (Pandora.Paradigm.Basis.Free.Free t) module Pandora.Paradigm.Basis.Edges data Edges a Empty :: Edges a Connect :: a -> Edges a Overlay :: a -> Edges a edges :: r -> (a -> r) -> (a -> r) -> Edges a -> r instance Pandora.Pattern.Functor.Covariant.Covariant Pandora.Paradigm.Basis.Edges.Edges instance Pandora.Pattern.Functor.Traversable.Traversable Pandora.Paradigm.Basis.Edges.Edges module Pandora.Paradigm.Basis.Constant newtype Constant a b Constant :: a -> Constant a b instance Pandora.Pattern.Functor.Covariant.Covariant (Pandora.Paradigm.Basis.Constant.Constant a) instance Pandora.Pattern.Functor.Contravariant.Contravariant (Pandora.Paradigm.Basis.Constant.Constant a) instance Pandora.Pattern.Functor.Invariant.Invariant (Pandora.Paradigm.Basis.Constant.Constant a) instance Pandora.Pattern.Functor.Traversable.Traversable (Pandora.Paradigm.Basis.Constant.Constant a) module Pandora.Paradigm.Basis.Cofree data Cofree t a (:<) :: a -> (t :.: Cofree t) a -> Cofree t a unwrap :: Cofree t a -> (t :.: Cofree t) a coiterate :: Covariant t => (a -> t a) -> a -> Cofree t a section :: Comonad t => t ~> Cofree t instance Pandora.Pattern.Functor.Covariant.Covariant t => Pandora.Pattern.Functor.Covariant.Covariant (Pandora.Paradigm.Basis.Cofree.Cofree t) instance Pandora.Pattern.Functor.Exclusive.Exclusive t => Pandora.Pattern.Functor.Pointable.Pointable (Pandora.Paradigm.Basis.Cofree.Cofree t) instance Pandora.Pattern.Functor.Covariant.Covariant t => Pandora.Pattern.Functor.Extractable.Extractable (Pandora.Paradigm.Basis.Cofree.Cofree t) instance Pandora.Pattern.Functor.Applicative.Applicative t => Pandora.Pattern.Functor.Applicative.Applicative (Pandora.Paradigm.Basis.Cofree.Cofree t) instance Pandora.Pattern.Functor.Traversable.Traversable t => Pandora.Pattern.Functor.Traversable.Traversable (Pandora.Paradigm.Basis.Cofree.Cofree t) instance Pandora.Pattern.Functor.Alternative.Alternative t => Pandora.Pattern.Functor.Bindable.Bindable (Pandora.Paradigm.Basis.Cofree.Cofree t) instance Pandora.Pattern.Functor.Covariant.Covariant t => Pandora.Pattern.Functor.Extendable.Extendable (Pandora.Paradigm.Basis.Cofree.Cofree t) instance (Pandora.Pattern.Functor.Exclusive.Exclusive t, Pandora.Pattern.Functor.Alternative.Alternative t) => Pandora.Pattern.Functor.Monad.Monad (Pandora.Paradigm.Basis.Cofree.Cofree t) instance Pandora.Pattern.Functor.Covariant.Covariant t => Pandora.Pattern.Functor.Comonad.Comonad (Pandora.Paradigm.Basis.Cofree.Cofree t) module Pandora.Pattern.Object.Semigroup -- |
-- When providing a new instance, you should ensure it satisfies the one law: -- * Associativity: x <> (y <> z) ≡ (x <> y) <> z --class Semigroup a -- | Infix version of append (<>) :: Semigroup a => a -> a -> a module Pandora.Pattern.Object.Ringoid -- |
-- When providing a new instance, you should ensure it satisfies the two laws: -- * Left distributivity: x <> (y >< z) ≡ x <> y >< x <> z -- * Right distributivity: (y >< z) <> x ≡ y <> x >< z <> x --class Semigroup a => Ringoid a (><) :: Ringoid a => a -> a -> a module Pandora.Pattern.Object.Monoid -- |
-- When providing a new instance, you should ensure it satisfies the two laws: -- * Right absorption: unit <> x ≡ x -- * Left absorption: x <> unit ≡ x --class Semigroup a => Monoid a unit :: Monoid a => a module Pandora.Pattern.Object.Group -- |
-- When providing a new instance, you should ensure it satisfies the two laws: -- * Right absorption: x <> inverse x ≡ unit -- * Left absorption: inverse x <> x ≡ unit --class Monoid a => Group a inverse :: Group a => a -> a module Pandora.Pattern.Object.Semilattice -- |
-- When providing a new instance, you should ensure it satisfies the three laws: -- * Associativity: x /\ (y /\ z) ≡ (x /\ y) /\ z -- * Commutativity: x /\ y ≡ y /\ x -- * Idempotency: x /\ x ≡ x --class Infimum a (/\) :: Infimum a => a -> a -> a -- |
-- When providing a new instance, you should ensure it satisfies the three laws: -- * Associativity: x \/ (y \/ z) ≡ (x \/ y) \/ z -- * Commutativity: x \/ y ≡ y \/ x -- * Idempotency: x \/ x ≡ x --class Supremum a (\/) :: Supremum a => a -> a -> a type family Semilattice constraint module Pandora.Pattern.Object.Lattice -- |
-- When providing a new instance, you should ensure it satisfies the one law: -- * Absorption: a \/ (a /\ b) ≡ a /\ (a \/ b) ≡ a --class (Infimum a, Supremum a) => Lattice a module Pandora.Pattern.Object.Setoid data Boolean True :: Boolean False :: Boolean (&&) :: Boolean -> Boolean -> Boolean infixr 3 && (||) :: Boolean -> Boolean -> Boolean infixr 9 || not :: Boolean -> Boolean bool :: a -> a -> Boolean -> a -- |
-- When providing a new instance, you should ensure it satisfies the four laws: -- * Reflexivity: x == x ≡ True -- * Symmetry: x == y ≡ y == x -- * Transitivity: x == y && y == z ≡ True ===> x == z ≡ True -- * Negation: x /= y ≡ not (x == y) --class Setoid a (==) :: Setoid a => a -> a -> Boolean (/=) :: Setoid a => a -> a -> Boolean infix 4 == infix 4 /= module Pandora.Pattern.Object.Chain data Ordering Less :: Ordering Equal :: Ordering Greater :: Ordering order :: a -> a -> a -> Ordering -> a -- |
-- When providing a new instance, you should ensure it satisfies the three laws: -- * Reflexivity: x <= x ≡ True -- * Transitivity: x <= y && y <= z ≡ True ===> x <= z ≡ True -- * Antisymmetry: x <= y && y <= x ≡ True ===> x == y ≡ True --class Setoid a => Chain a (<=>) :: Chain a => a -> a -> Ordering (<) :: Chain a => a -> a -> Boolean (<=) :: Chain a => a -> a -> Boolean (>) :: Chain a => a -> a -> Boolean (>=) :: Chain a => a -> a -> Boolean module Pandora.Pattern.Object module Pandora.Paradigm.Basis.Predicate newtype Predicate a Predicate :: (a -> Boolean) -> Predicate a [predicate] :: Predicate a -> a -> Boolean instance Pandora.Pattern.Functor.Contravariant.Contravariant Pandora.Paradigm.Basis.Predicate.Predicate module Pandora.Paradigm.Basis.Identity newtype Identity a Identity :: a -> Identity a instance Pandora.Pattern.Functor.Covariant.Covariant Pandora.Paradigm.Basis.Identity.Identity instance Pandora.Pattern.Functor.Pointable.Pointable Pandora.Paradigm.Basis.Identity.Identity instance Pandora.Pattern.Functor.Extractable.Extractable Pandora.Paradigm.Basis.Identity.Identity instance Pandora.Pattern.Functor.Applicative.Applicative Pandora.Paradigm.Basis.Identity.Identity instance Pandora.Pattern.Functor.Traversable.Traversable Pandora.Paradigm.Basis.Identity.Identity instance Pandora.Pattern.Functor.Distributive.Distributive Pandora.Paradigm.Basis.Identity.Identity instance Pandora.Pattern.Functor.Bindable.Bindable Pandora.Paradigm.Basis.Identity.Identity instance Pandora.Pattern.Functor.Monad.Monad Pandora.Paradigm.Basis.Identity.Identity instance Pandora.Pattern.Functor.Extendable.Extendable Pandora.Paradigm.Basis.Identity.Identity instance Pandora.Pattern.Functor.Comonad.Comonad Pandora.Paradigm.Basis.Identity.Identity instance Pandora.Pattern.Functor.Adjoint.Adjoint Pandora.Paradigm.Basis.Identity.Identity Pandora.Paradigm.Basis.Identity.Identity instance Pandora.Pattern.Object.Setoid.Setoid a => Pandora.Pattern.Object.Setoid.Setoid (Pandora.Paradigm.Basis.Identity.Identity a) instance Pandora.Pattern.Object.Chain.Chain a => Pandora.Pattern.Object.Chain.Chain (Pandora.Paradigm.Basis.Identity.Identity a) instance Pandora.Pattern.Object.Semigroup.Semigroup a => Pandora.Pattern.Object.Semigroup.Semigroup (Pandora.Paradigm.Basis.Identity.Identity a) instance Pandora.Pattern.Object.Monoid.Monoid a => Pandora.Pattern.Object.Monoid.Monoid (Pandora.Paradigm.Basis.Identity.Identity a) instance Pandora.Pattern.Object.Ringoid.Ringoid a => Pandora.Pattern.Object.Ringoid.Ringoid (Pandora.Paradigm.Basis.Identity.Identity a) instance Pandora.Pattern.Object.Semilattice.Infimum a => Pandora.Pattern.Object.Semilattice.Infimum (Pandora.Paradigm.Basis.Identity.Identity a) instance Pandora.Pattern.Object.Semilattice.Supremum a => Pandora.Pattern.Object.Semilattice.Supremum (Pandora.Paradigm.Basis.Identity.Identity a) instance Pandora.Pattern.Object.Lattice.Lattice a => Pandora.Pattern.Object.Lattice.Lattice (Pandora.Paradigm.Basis.Identity.Identity a) instance Pandora.Pattern.Object.Group.Group a => Pandora.Pattern.Object.Group.Group (Pandora.Paradigm.Basis.Identity.Identity a) module Pandora.Paradigm.Inventory.Storage newtype Storage p t a Storage :: ((:*) p :.: (t :.: (->) p)) a -> Storage p t a [stored] :: Storage p t a -> ((:*) p :.: (t :.: (->) p)) a type Store p = Storage p Identity position :: Storage p t a -> p access :: Extractable t => p -> Storage p t a -> a retrofit :: Extractable t => (p -> p) -> Storage p t a -> Storage p t a instance Pandora.Pattern.Functor.Covariant.Covariant t => Pandora.Pattern.Functor.Covariant.Covariant (Pandora.Paradigm.Inventory.Storage.Storage p t) instance Pandora.Pattern.Functor.Extractable.Extractable t => Pandora.Pattern.Functor.Extractable.Extractable (Pandora.Paradigm.Inventory.Storage.Storage p t) instance Pandora.Pattern.Functor.Extendable.Extendable t => Pandora.Pattern.Functor.Extendable.Extendable (Pandora.Paradigm.Inventory.Storage.Storage p t) instance Pandora.Pattern.Functor.Applicative.Applicative t => Pandora.Pattern.Functor.Applicative.Applicative (Pandora.Paradigm.Inventory.Storage.Storage p t) instance Pandora.Pattern.Functor.Comonad.Comonad g => Pandora.Pattern.Functor.Comonad.Comonad (Pandora.Paradigm.Inventory.Storage.Storage p g) module Pandora.Paradigm.Inventory.Stateful newtype Stateful s t a Stateful :: ((->) s :.: (t :.: (:*) s)) a -> Stateful s t a [statefully] :: Stateful s t a -> ((->) s :.: (t :.: (:*) s)) a type State s = Stateful s Identity get :: Pointable t => Stateful s t s modify :: Pointable t => (s -> s) -> Stateful s t () put :: Pointable t => s -> Stateful s t () instance Pandora.Pattern.Functor.Covariant.Covariant t => Pandora.Pattern.Functor.Covariant.Covariant (Pandora.Paradigm.Inventory.Stateful.Stateful s t) instance Pandora.Pattern.Functor.Bindable.Bindable t => Pandora.Pattern.Functor.Applicative.Applicative (Pandora.Paradigm.Inventory.Stateful.Stateful s t) instance Pandora.Pattern.Functor.Pointable.Pointable t => Pandora.Pattern.Functor.Pointable.Pointable (Pandora.Paradigm.Inventory.Stateful.Stateful s t) instance Pandora.Pattern.Functor.Bindable.Bindable t => Pandora.Pattern.Functor.Bindable.Bindable (Pandora.Paradigm.Inventory.Stateful.Stateful s t) instance Pandora.Pattern.Functor.Monad.Monad t => Pandora.Pattern.Functor.Monad.Monad (Pandora.Paradigm.Inventory.Stateful.Stateful s t) instance Pandora.Pattern.Functor.Liftable.Liftable (Pandora.Paradigm.Inventory.Stateful.Stateful s) module Pandora.Paradigm.Inventory.Optics type Lens src tgt = src -> Storage tgt Identity src -- | Lens composition infix operator (|>) :: Lens src btw -> Lens btw tgt -> Lens src tgt -- | Get the target of a lens view :: Lens src tgt -> src -> tgt -- | Replace the target of a lens set :: Lens src tgt -> tgt -> src -> src -- | Modify the target of a lens over :: Lens src tgt -> (tgt -> tgt) -> src -> src -- | Infix version of view (^.) :: Lens src tgt -> src -> tgt -- | Infix version of set (.~) :: Lens src tgt -> tgt -> src -> src -- | Infix version of over (%~) :: Lens src tgt -> (tgt -> tgt) -> src -> src module Pandora.Paradigm.Inventory.Environmental newtype Environmental e t a Environmental :: ((->) e :.: t) a -> Environmental e t a [environmentally] :: Environmental e t a -> ((->) e :.: t) a type Environ e = Environmental e Identity ask :: Pointable t => Environmental e t e local :: (e -> e) -> Environmental e t a -> Environmental e t a instance Pandora.Pattern.Functor.Covariant.Covariant t => Pandora.Pattern.Functor.Covariant.Covariant (Pandora.Paradigm.Inventory.Environmental.Environmental e t) instance Pandora.Pattern.Functor.Pointable.Pointable t => Pandora.Pattern.Functor.Pointable.Pointable (Pandora.Paradigm.Inventory.Environmental.Environmental e t) instance Pandora.Pattern.Functor.Applicative.Applicative t => Pandora.Pattern.Functor.Applicative.Applicative (Pandora.Paradigm.Inventory.Environmental.Environmental e t) instance Pandora.Pattern.Functor.Alternative.Alternative t => Pandora.Pattern.Functor.Alternative.Alternative (Pandora.Paradigm.Inventory.Environmental.Environmental e t) instance Pandora.Pattern.Functor.Bindable.Bindable t => Pandora.Pattern.Functor.Bindable.Bindable (Pandora.Paradigm.Inventory.Environmental.Environmental e t) instance Pandora.Pattern.Functor.Monad.Monad t => Pandora.Pattern.Functor.Monad.Monad (Pandora.Paradigm.Inventory.Environmental.Environmental e t) instance Pandora.Pattern.Functor.Liftable.Liftable (Pandora.Paradigm.Inventory.Environmental.Environmental e) module Pandora.Paradigm.Inventory module Pandora.Paradigm.Basis.Maybe data Maybe a Nothing :: Maybe a Just :: a -> Maybe a maybe :: b -> (a -> b) -> Maybe a -> b instance Pandora.Pattern.Functor.Covariant.Covariant Pandora.Paradigm.Basis.Maybe.Maybe instance Pandora.Pattern.Functor.Pointable.Pointable Pandora.Paradigm.Basis.Maybe.Maybe instance Pandora.Pattern.Functor.Exclusive.Exclusive Pandora.Paradigm.Basis.Maybe.Maybe instance Pandora.Pattern.Functor.Applicative.Applicative Pandora.Paradigm.Basis.Maybe.Maybe instance Pandora.Pattern.Functor.Alternative.Alternative Pandora.Paradigm.Basis.Maybe.Maybe instance Pandora.Pattern.Functor.Traversable.Traversable Pandora.Paradigm.Basis.Maybe.Maybe instance Pandora.Pattern.Functor.Bindable.Bindable Pandora.Paradigm.Basis.Maybe.Maybe instance Pandora.Pattern.Functor.Monad.Monad Pandora.Paradigm.Basis.Maybe.Maybe instance (Pandora.Pattern.Functor.Pointable.Pointable t, Pandora.Pattern.Functor.Bindable.Bindable t) => Pandora.Pattern.Functor.Bindable.Bindable (Pandora.Paradigm.Basis.Maybe.Maybe Pandora.Paradigm.Junction.Transformer.:!: t) instance Pandora.Pattern.Functor.Monad.Monad t => Pandora.Pattern.Functor.Monad.Monad (Pandora.Paradigm.Basis.Maybe.Maybe Pandora.Paradigm.Junction.Transformer.:!: t) instance Pandora.Pattern.Object.Setoid.Setoid a => Pandora.Pattern.Object.Setoid.Setoid (Pandora.Paradigm.Basis.Maybe.Maybe a) instance Pandora.Pattern.Object.Chain.Chain a => Pandora.Pattern.Object.Chain.Chain (Pandora.Paradigm.Basis.Maybe.Maybe a) instance Pandora.Pattern.Object.Semigroup.Semigroup a => Pandora.Pattern.Object.Semigroup.Semigroup (Pandora.Paradigm.Basis.Maybe.Maybe a) instance Pandora.Pattern.Object.Semigroup.Semigroup a => Pandora.Pattern.Object.Monoid.Monoid (Pandora.Paradigm.Basis.Maybe.Maybe a) instance Pandora.Pattern.Object.Semilattice.Infimum a => Pandora.Pattern.Object.Semilattice.Infimum (Pandora.Paradigm.Basis.Maybe.Maybe a) instance Pandora.Pattern.Object.Semilattice.Supremum a => Pandora.Pattern.Object.Semilattice.Supremum (Pandora.Paradigm.Basis.Maybe.Maybe a) instance Pandora.Pattern.Object.Lattice.Lattice a => Pandora.Pattern.Object.Lattice.Lattice (Pandora.Paradigm.Basis.Maybe.Maybe a) module Pandora.Paradigm.Structure.Stack type Stack = (Cofree :>: Maybe) push :: a -> Stack a -> Stack a top :: Stack a -> Maybe a pop :: Stack a -> Stack a empty :: r -> (Cofree Maybe a -> r) -> Stack a -> r module Pandora.Paradigm.Structure type family Nonempty structure a :: * module Pandora.Paradigm.Basis.Conclusion data Conclusion e a Failure :: e -> Conclusion e a Success :: a -> Conclusion e a conclusion :: (e -> r) -> (a -> r) -> Conclusion e a -> r instance Pandora.Pattern.Functor.Covariant.Covariant (Pandora.Paradigm.Basis.Conclusion.Conclusion e) instance Pandora.Pattern.Functor.Pointable.Pointable (Pandora.Paradigm.Basis.Conclusion.Conclusion e) instance Pandora.Pattern.Functor.Applicative.Applicative (Pandora.Paradigm.Basis.Conclusion.Conclusion e) instance Pandora.Pattern.Functor.Alternative.Alternative (Pandora.Paradigm.Basis.Conclusion.Conclusion e) instance Pandora.Pattern.Functor.Traversable.Traversable (Pandora.Paradigm.Basis.Conclusion.Conclusion e) instance Pandora.Pattern.Functor.Bindable.Bindable (Pandora.Paradigm.Basis.Conclusion.Conclusion e) instance Pandora.Pattern.Functor.Monad.Monad (Pandora.Paradigm.Basis.Conclusion.Conclusion e) instance (Pandora.Pattern.Functor.Pointable.Pointable t, Pandora.Pattern.Functor.Bindable.Bindable t) => Pandora.Pattern.Functor.Bindable.Bindable (Pandora.Paradigm.Basis.Conclusion.Conclusion e Pandora.Paradigm.Junction.Transformer.:!: t) instance Pandora.Pattern.Functor.Monad.Monad t => Pandora.Pattern.Functor.Monad.Monad (Pandora.Paradigm.Basis.Conclusion.Conclusion e Pandora.Paradigm.Junction.Transformer.:!: t) instance (Pandora.Pattern.Object.Setoid.Setoid e, Pandora.Pattern.Object.Setoid.Setoid a) => Pandora.Pattern.Object.Setoid.Setoid (Pandora.Paradigm.Basis.Conclusion.Conclusion e a) instance (Pandora.Pattern.Object.Chain.Chain e, Pandora.Pattern.Object.Chain.Chain a) => Pandora.Pattern.Object.Chain.Chain (Pandora.Paradigm.Basis.Conclusion.Conclusion e a) instance (Pandora.Pattern.Object.Semigroup.Semigroup e, Pandora.Pattern.Object.Semigroup.Semigroup a) => Pandora.Pattern.Object.Semigroup.Semigroup (Pandora.Paradigm.Basis.Conclusion.Conclusion e a) module Pandora.Paradigm.Basis note :: e -> Maybe ~> Conclusion e hush :: Conclusion e ~> Maybe