{-# LANGUAGE RankNTypes #-} {-# LANGUAGE StandaloneDeriving #-} {-# LANGUAGE GADTs #-} {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE DeriveAnyClass #-} {-# LANGUAGE EmptyCase #-} {-# LANGUAGE LambdaCase #-} {-# LANGUAGE AllowAmbiguousTypes #-} {-# LANGUAGE TypeApplications #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE ConstraintKinds #-} {-# LANGUAGE EmptyDataDeriving #-} {-# LANGUAGE DeriveTraversable #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE TypeSynonymInstances #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE PolyKinds #-} {-# LANGUAGE TypeOperators #-} module Algebra.Types where import Data.Kind import Data.Constraint (Dict(..)) import Data.Functor.Rep import Data.Distributive import GHC.Generics hiding (Rep) import Test.QuickCheck hiding (tabulate,collect) class SumKind k where data (a::k) ⊕ (b::k) :: k data Zero :: k class ProdKind k where data (a::k) ⊗ (b::k) :: k data One :: k class DualKind k where data Dual (a::k) :: k data Repr x i t o :: k -> Type where RPlus :: Repr x i t o a -> Repr x i t o b -> Repr x i t o (a `t` b) RTimes :: Repr x i t o a -> Repr x i t o b -> Repr x i t o (a `x` b) ROne :: Repr x i t o i RZero :: Repr x i t o o instance Show (Repr x i t o a) where showsPrec :: Int -> Repr x i t o a -> ShowS showsPrec Int d = \case Repr x i t o a RZero -> String -> ShowS showString String "0" Repr x i t o a ROne -> String -> ShowS showString String "1" RPlus Repr x i t o a x Repr x i t o b y -> Bool -> ShowS -> ShowS showParen (Int dInt -> Int -> Bool forall a. Ord a => a -> a -> Bool >=Int 2) (Int -> Repr x i t o a -> ShowS forall a. Show a => Int -> a -> ShowS showsPrec Int 2 Repr x i t o a x ShowS -> ShowS -> ShowS forall b c a. (b -> c) -> (a -> b) -> a -> c . String -> ShowS showString String " + " ShowS -> ShowS -> ShowS forall b c a. (b -> c) -> (a -> b) -> a -> c . Int -> Repr x i t o b -> ShowS forall a. Show a => Int -> a -> ShowS showsPrec Int 2 Repr x i t o b y) RTimes Repr x i t o a x Repr x i t o b y -> Bool -> ShowS -> ShowS showParen (Int dInt -> Int -> Bool forall a. Ord a => a -> a -> Bool >=Int 3) (Int -> Repr x i t o a -> ShowS forall a. Show a => Int -> a -> ShowS showsPrec Int 3 Repr x i t o a x ShowS -> ShowS -> ShowS forall b c a. (b -> c) -> (a -> b) -> a -> c . String -> ShowS showString String " × " ShowS -> ShowS -> ShowS forall b c a. (b -> c) -> (a -> b) -> a -> c . Int -> Repr x i t o b -> ShowS forall a. Show a => Int -> a -> ShowS showsPrec Int 3 Repr x i t o b y) type CRepr = Repr (∘) Id (⊗) One type MRepr = Repr (⊗) One (⊕) Zero instance SumKind Type where data x ⊕ y = Inj1 x | Inj2 y deriving ((x ⊕ y) -> (x ⊕ y) -> Bool ((x ⊕ y) -> (x ⊕ y) -> Bool) -> ((x ⊕ y) -> (x ⊕ y) -> Bool) -> Eq (x ⊕ y) forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a forall x y. (Eq x, Eq y) => (x ⊕ y) -> (x ⊕ y) -> Bool $c== :: forall x y. (Eq x, Eq y) => (x ⊕ y) -> (x ⊕ y) -> Bool == :: (x ⊕ y) -> (x ⊕ y) -> Bool $c/= :: forall x y. (Eq x, Eq y) => (x ⊕ y) -> (x ⊕ y) -> Bool /= :: (x ⊕ y) -> (x ⊕ y) -> Bool Eq,Eq (x ⊕ y) Eq (x ⊕ y) => ((x ⊕ y) -> (x ⊕ y) -> Ordering) -> ((x ⊕ y) -> (x ⊕ y) -> Bool) -> ((x ⊕ y) -> (x ⊕ y) -> Bool) -> ((x ⊕ y) -> (x ⊕ y) -> Bool) -> ((x ⊕ y) -> (x ⊕ y) -> Bool) -> ((x ⊕ y) -> (x ⊕ y) -> x ⊕ y) -> ((x ⊕ y) -> (x ⊕ y) -> x ⊕ y) -> Ord (x ⊕ y) (x ⊕ y) -> (x ⊕ y) -> Bool (x ⊕ y) -> (x ⊕ y) -> Ordering (x ⊕ y) -> (x ⊕ y) -> x ⊕ y forall a. Eq a => (a -> a -> Ordering) -> (a -> a -> Bool) -> (a -> a -> Bool) -> (a -> a -> Bool) -> (a -> a -> Bool) -> (a -> a -> a) -> (a -> a -> a) -> Ord a forall x y. (Ord x, Ord y) => Eq (x ⊕ y) forall x y. (Ord x, Ord y) => (x ⊕ y) -> (x ⊕ y) -> Bool forall x y. (Ord x, Ord y) => (x ⊕ y) -> (x ⊕ y) -> Ordering forall x y. (Ord x, Ord y) => (x ⊕ y) -> (x ⊕ y) -> x ⊕ y $ccompare :: forall x y. (Ord x, Ord y) => (x ⊕ y) -> (x ⊕ y) -> Ordering compare :: (x ⊕ y) -> (x ⊕ y) -> Ordering $c< :: forall x y. (Ord x, Ord y) => (x ⊕ y) -> (x ⊕ y) -> Bool < :: (x ⊕ y) -> (x ⊕ y) -> Bool $c<= :: forall x y. (Ord x, Ord y) => (x ⊕ y) -> (x ⊕ y) -> Bool <= :: (x ⊕ y) -> (x ⊕ y) -> Bool $c> :: forall x y. (Ord x, Ord y) => (x ⊕ y) -> (x ⊕ y) -> Bool > :: (x ⊕ y) -> (x ⊕ y) -> Bool $c>= :: forall x y. (Ord x, Ord y) => (x ⊕ y) -> (x ⊕ y) -> Bool >= :: (x ⊕ y) -> (x ⊕ y) -> Bool $cmax :: forall x y. (Ord x, Ord y) => (x ⊕ y) -> (x ⊕ y) -> x ⊕ y max :: (x ⊕ y) -> (x ⊕ y) -> x ⊕ y $cmin :: forall x y. (Ord x, Ord y) => (x ⊕ y) -> (x ⊕ y) -> x ⊕ y min :: (x ⊕ y) -> (x ⊕ y) -> x ⊕ y Ord,Int -> (x ⊕ y) -> ShowS [x ⊕ y] -> ShowS (x ⊕ y) -> String (Int -> (x ⊕ y) -> ShowS) -> ((x ⊕ y) -> String) -> ([x ⊕ y] -> ShowS) -> Show (x ⊕ y) forall a. (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a forall x y. (Show x, Show y) => Int -> (x ⊕ y) -> ShowS forall x y. (Show x, Show y) => [x ⊕ y] -> ShowS forall x y. (Show x, Show y) => (x ⊕ y) -> String $cshowsPrec :: forall x y. (Show x, Show y) => Int -> (x ⊕ y) -> ShowS showsPrec :: Int -> (x ⊕ y) -> ShowS $cshow :: forall x y. (Show x, Show y) => (x ⊕ y) -> String show :: (x ⊕ y) -> String $cshowList :: forall x y. (Show x, Show y) => [x ⊕ y] -> ShowS showList :: [x ⊕ y] -> ShowS Show,(forall x. (x ⊕ y) -> Rep (x ⊕ y) x) -> (forall x. Rep (x ⊕ y) x -> x ⊕ y) -> Generic (x ⊕ y) forall x. Rep (x ⊕ y) x -> x ⊕ y forall x. (x ⊕ y) -> Rep (x ⊕ y) x forall a. (forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a forall x y x. Rep (x ⊕ y) x -> x ⊕ y forall x y x. (x ⊕ y) -> Rep (x ⊕ y) x $cfrom :: forall x y x. (x ⊕ y) -> Rep (x ⊕ y) x from :: forall x. (x ⊕ y) -> Rep (x ⊕ y) x $cto :: forall x y x. Rep (x ⊕ y) x -> x ⊕ y to :: forall x. Rep (x ⊕ y) x -> x ⊕ y Generic) data Zero deriving (Zero -> Zero -> Bool (Zero -> Zero -> Bool) -> (Zero -> Zero -> Bool) -> Eq Zero forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a $c== :: Zero -> Zero -> Bool == :: Zero -> Zero -> Bool $c/= :: Zero -> Zero -> Bool /= :: Zero -> Zero -> Bool Eq,Eq Zero Eq Zero => (Zero -> Zero -> Ordering) -> (Zero -> Zero -> Bool) -> (Zero -> Zero -> Bool) -> (Zero -> Zero -> Bool) -> (Zero -> Zero -> Bool) -> (Zero -> Zero -> Zero) -> (Zero -> Zero -> Zero) -> Ord Zero Zero -> Zero -> Bool Zero -> Zero -> Ordering Zero -> Zero -> Zero forall a. Eq a => (a -> a -> Ordering) -> (a -> a -> Bool) -> (a -> a -> Bool) -> (a -> a -> Bool) -> (a -> a -> Bool) -> (a -> a -> a) -> (a -> a -> a) -> Ord a $ccompare :: Zero -> Zero -> Ordering compare :: Zero -> Zero -> Ordering $c< :: Zero -> Zero -> Bool < :: Zero -> Zero -> Bool $c<= :: Zero -> Zero -> Bool <= :: Zero -> Zero -> Bool $c> :: Zero -> Zero -> Bool > :: Zero -> Zero -> Bool $c>= :: Zero -> Zero -> Bool >= :: Zero -> Zero -> Bool $cmax :: Zero -> Zero -> Zero max :: Zero -> Zero -> Zero $cmin :: Zero -> Zero -> Zero min :: Zero -> Zero -> Zero Ord,Int -> Zero -> ShowS [Zero] -> ShowS Zero -> String (Int -> Zero -> ShowS) -> (Zero -> String) -> ([Zero] -> ShowS) -> Show Zero forall a. (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a $cshowsPrec :: Int -> Zero -> ShowS showsPrec :: Int -> Zero -> ShowS $cshow :: Zero -> String show :: Zero -> String $cshowList :: [Zero] -> ShowS showList :: [Zero] -> ShowS Show) instance ProdKind Type where data x ⊗ y = Pair {forall x y. (x ⊗ y) -> x π1 :: x, forall x y. (x ⊗ y) -> y π2 :: y} deriving ((x ⊗ y) -> (x ⊗ y) -> Bool ((x ⊗ y) -> (x ⊗ y) -> Bool) -> ((x ⊗ y) -> (x ⊗ y) -> Bool) -> Eq (x ⊗ y) forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a forall x y. (Eq x, Eq y) => (x ⊗ y) -> (x ⊗ y) -> Bool $c== :: forall x y. (Eq x, Eq y) => (x ⊗ y) -> (x ⊗ y) -> Bool == :: (x ⊗ y) -> (x ⊗ y) -> Bool $c/= :: forall x y. (Eq x, Eq y) => (x ⊗ y) -> (x ⊗ y) -> Bool /= :: (x ⊗ y) -> (x ⊗ y) -> Bool Eq,Eq (x ⊗ y) Eq (x ⊗ y) => ((x ⊗ y) -> (x ⊗ y) -> Ordering) -> ((x ⊗ y) -> (x ⊗ y) -> Bool) -> ((x ⊗ y) -> (x ⊗ y) -> Bool) -> ((x ⊗ y) -> (x ⊗ y) -> Bool) -> ((x ⊗ y) -> (x ⊗ y) -> Bool) -> ((x ⊗ y) -> (x ⊗ y) -> x ⊗ y) -> ((x ⊗ y) -> (x ⊗ y) -> x ⊗ y) -> Ord (x ⊗ y) (x ⊗ y) -> (x ⊗ y) -> Bool (x ⊗ y) -> (x ⊗ y) -> Ordering (x ⊗ y) -> (x ⊗ y) -> x ⊗ y forall a. Eq a => (a -> a -> Ordering) -> (a -> a -> Bool) -> (a -> a -> Bool) -> (a -> a -> Bool) -> (a -> a -> Bool) -> (a -> a -> a) -> (a -> a -> a) -> Ord a forall x y. (Ord x, Ord y) => Eq (x ⊗ y) forall x y. (Ord x, Ord y) => (x ⊗ y) -> (x ⊗ y) -> Bool forall x y. (Ord x, Ord y) => (x ⊗ y) -> (x ⊗ y) -> Ordering forall x y. (Ord x, Ord y) => (x ⊗ y) -> (x ⊗ y) -> x ⊗ y $ccompare :: forall x y. (Ord x, Ord y) => (x ⊗ y) -> (x ⊗ y) -> Ordering compare :: (x ⊗ y) -> (x ⊗ y) -> Ordering $c< :: forall x y. (Ord x, Ord y) => (x ⊗ y) -> (x ⊗ y) -> Bool < :: (x ⊗ y) -> (x ⊗ y) -> Bool $c<= :: forall x y. (Ord x, Ord y) => (x ⊗ y) -> (x ⊗ y) -> Bool <= :: (x ⊗ y) -> (x ⊗ y) -> Bool $c> :: forall x y. (Ord x, Ord y) => (x ⊗ y) -> (x ⊗ y) -> Bool > :: (x ⊗ y) -> (x ⊗ y) -> Bool $c>= :: forall x y. (Ord x, Ord y) => (x ⊗ y) -> (x ⊗ y) -> Bool >= :: (x ⊗ y) -> (x ⊗ y) -> Bool $cmax :: forall x y. (Ord x, Ord y) => (x ⊗ y) -> (x ⊗ y) -> x ⊗ y max :: (x ⊗ y) -> (x ⊗ y) -> x ⊗ y $cmin :: forall x y. (Ord x, Ord y) => (x ⊗ y) -> (x ⊗ y) -> x ⊗ y min :: (x ⊗ y) -> (x ⊗ y) -> x ⊗ y Ord,Int -> (x ⊗ y) -> ShowS [x ⊗ y] -> ShowS (x ⊗ y) -> String (Int -> (x ⊗ y) -> ShowS) -> ((x ⊗ y) -> String) -> ([x ⊗ y] -> ShowS) -> Show (x ⊗ y) forall a. (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a forall x y. (Show x, Show y) => Int -> (x ⊗ y) -> ShowS forall x y. (Show x, Show y) => [x ⊗ y] -> ShowS forall x y. (Show x, Show y) => (x ⊗ y) -> String $cshowsPrec :: forall x y. (Show x, Show y) => Int -> (x ⊗ y) -> ShowS showsPrec :: Int -> (x ⊗ y) -> ShowS $cshow :: forall x y. (Show x, Show y) => (x ⊗ y) -> String show :: (x ⊗ y) -> String $cshowList :: forall x y. (Show x, Show y) => [x ⊗ y] -> ShowS showList :: [x ⊗ y] -> ShowS Show,(forall x. (x ⊗ y) -> Rep (x ⊗ y) x) -> (forall x. Rep (x ⊗ y) x -> x ⊗ y) -> Generic (x ⊗ y) forall x. Rep (x ⊗ y) x -> x ⊗ y forall x. (x ⊗ y) -> Rep (x ⊗ y) x forall a. (forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a forall x y x. Rep (x ⊗ y) x -> x ⊗ y forall x y x. (x ⊗ y) -> Rep (x ⊗ y) x $cfrom :: forall x y x. (x ⊗ y) -> Rep (x ⊗ y) x from :: forall x. (x ⊗ y) -> Rep (x ⊗ y) x $cto :: forall x y x. Rep (x ⊗ y) x -> x ⊗ y to :: forall x. Rep (x ⊗ y) x -> x ⊗ y Generic) data One = Unit deriving (One -> One -> Bool (One -> One -> Bool) -> (One -> One -> Bool) -> Eq One forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a $c== :: One -> One -> Bool == :: One -> One -> Bool $c/= :: One -> One -> Bool /= :: One -> One -> Bool Eq,Eq One Eq One => (One -> One -> Ordering) -> (One -> One -> Bool) -> (One -> One -> Bool) -> (One -> One -> Bool) -> (One -> One -> Bool) -> (One -> One -> One) -> (One -> One -> One) -> Ord One One -> One -> Bool One -> One -> Ordering One -> One -> One forall a. Eq a => (a -> a -> Ordering) -> (a -> a -> Bool) -> (a -> a -> Bool) -> (a -> a -> Bool) -> (a -> a -> Bool) -> (a -> a -> a) -> (a -> a -> a) -> Ord a $ccompare :: One -> One -> Ordering compare :: One -> One -> Ordering $c< :: One -> One -> Bool < :: One -> One -> Bool $c<= :: One -> One -> Bool <= :: One -> One -> Bool $c> :: One -> One -> Bool > :: One -> One -> Bool $c>= :: One -> One -> Bool >= :: One -> One -> Bool $cmax :: One -> One -> One max :: One -> One -> One $cmin :: One -> One -> One min :: One -> One -> One Ord,Int -> One One -> Int One -> [One] One -> One One -> One -> [One] One -> One -> One -> [One] (One -> One) -> (One -> One) -> (Int -> One) -> (One -> Int) -> (One -> [One]) -> (One -> One -> [One]) -> (One -> One -> [One]) -> (One -> One -> One -> [One]) -> Enum One forall a. (a -> a) -> (a -> a) -> (Int -> a) -> (a -> Int) -> (a -> [a]) -> (a -> a -> [a]) -> (a -> a -> [a]) -> (a -> a -> a -> [a]) -> Enum a $csucc :: One -> One succ :: One -> One $cpred :: One -> One pred :: One -> One $ctoEnum :: Int -> One toEnum :: Int -> One $cfromEnum :: One -> Int fromEnum :: One -> Int $cenumFrom :: One -> [One] enumFrom :: One -> [One] $cenumFromThen :: One -> One -> [One] enumFromThen :: One -> One -> [One] $cenumFromTo :: One -> One -> [One] enumFromTo :: One -> One -> [One] $cenumFromThenTo :: One -> One -> One -> [One] enumFromThenTo :: One -> One -> One -> [One] Enum,One One -> One -> Bounded One forall a. a -> a -> Bounded a $cminBound :: One minBound :: One $cmaxBound :: One maxBound :: One Bounded,Int -> One -> ShowS [One] -> ShowS One -> String (Int -> One -> ShowS) -> (One -> String) -> ([One] -> ShowS) -> Show One forall a. (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a $cshowsPrec :: Int -> One -> ShowS showsPrec :: Int -> One -> ShowS $cshow :: One -> String show :: One -> String $cshowList :: [One] -> ShowS showList :: [One] -> ShowS Show) instance DualKind Type where data Dual x = DualType {forall x. Dual x -> x fromDualType :: x} deriving (Dual x -> Dual x -> Bool (Dual x -> Dual x -> Bool) -> (Dual x -> Dual x -> Bool) -> Eq (Dual x) forall x. Eq x => Dual x -> Dual x -> Bool forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a $c== :: forall x. Eq x => Dual x -> Dual x -> Bool == :: Dual x -> Dual x -> Bool $c/= :: forall x. Eq x => Dual x -> Dual x -> Bool /= :: Dual x -> Dual x -> Bool Eq,Eq (Dual x) Eq (Dual x) => (Dual x -> Dual x -> Ordering) -> (Dual x -> Dual x -> Bool) -> (Dual x -> Dual x -> Bool) -> (Dual x -> Dual x -> Bool) -> (Dual x -> Dual x -> Bool) -> (Dual x -> Dual x -> Dual x) -> (Dual x -> Dual x -> Dual x) -> Ord (Dual x) Dual x -> Dual x -> Bool Dual x -> Dual x -> Ordering Dual x -> Dual x -> Dual x forall a. Eq a => (a -> a -> Ordering) -> (a -> a -> Bool) -> (a -> a -> Bool) -> (a -> a -> Bool) -> (a -> a -> Bool) -> (a -> a -> a) -> (a -> a -> a) -> Ord a forall x. Ord x => Eq (Dual x) forall x. Ord x => Dual x -> Dual x -> Bool forall x. Ord x => Dual x -> Dual x -> Ordering forall x. Ord x => Dual x -> Dual x -> Dual x $ccompare :: forall x. Ord x => Dual x -> Dual x -> Ordering compare :: Dual x -> Dual x -> Ordering $c< :: forall x. Ord x => Dual x -> Dual x -> Bool < :: Dual x -> Dual x -> Bool $c<= :: forall x. Ord x => Dual x -> Dual x -> Bool <= :: Dual x -> Dual x -> Bool $c> :: forall x. Ord x => Dual x -> Dual x -> Bool > :: Dual x -> Dual x -> Bool $c>= :: forall x. Ord x => Dual x -> Dual x -> Bool >= :: Dual x -> Dual x -> Bool $cmax :: forall x. Ord x => Dual x -> Dual x -> Dual x max :: Dual x -> Dual x -> Dual x $cmin :: forall x. Ord x => Dual x -> Dual x -> Dual x min :: Dual x -> Dual x -> Dual x Ord,Int -> Dual x -> ShowS [Dual x] -> ShowS Dual x -> String (Int -> Dual x -> ShowS) -> (Dual x -> String) -> ([Dual x] -> ShowS) -> Show (Dual x) forall x. Show x => Int -> Dual x -> ShowS forall x. Show x => [Dual x] -> ShowS forall x. Show x => Dual x -> String forall a. (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a $cshowsPrec :: forall x. Show x => Int -> Dual x -> ShowS showsPrec :: Int -> Dual x -> ShowS $cshow :: forall x. Show x => Dual x -> String show :: Dual x -> String $cshowList :: forall x. Show x => [Dual x] -> ShowS showList :: [Dual x] -> ShowS Show,(forall x. Dual x -> Rep (Dual x) x) -> (forall x. Rep (Dual x) x -> Dual x) -> Generic (Dual x) forall x. Rep (Dual x) x -> Dual x forall x. Dual x -> Rep (Dual x) x forall a. (forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a forall x x. Rep (Dual x) x -> Dual x forall x x. Dual x -> Rep (Dual x) x $cfrom :: forall x x. Dual x -> Rep (Dual x) x from :: forall x. Dual x -> Rep (Dual x) x $cto :: forall x x. Rep (Dual x) x -> Dual x to :: forall x. Rep (Dual x) x -> Dual x Generic) instance Finite a => Finite (Dual a) where instance Finite a => Bounded (Dual a) where minBound :: Dual a minBound = a -> Dual a forall x. x -> Dual x DualType a forall a. Bounded a => a minBound maxBound :: Dual a maxBound = a -> Dual a forall x. x -> Dual x DualType a forall a. Bounded a => a maxBound instance Finite a => Enum (Dual a) where toEnum :: Int -> Dual a toEnum = a -> Dual a forall x. x -> Dual x DualType (a -> Dual a) -> (Int -> a) -> Int -> Dual a forall b c a. (b -> c) -> (a -> b) -> a -> c . Int -> a forall a. Enum a => Int -> a toEnum fromEnum :: Dual a -> Int fromEnum = a -> Int forall a. Enum a => a -> Int fromEnum (a -> Int) -> (Dual a -> a) -> Dual a -> Int forall b c a. (b -> c) -> (a -> b) -> a -> c . Dual a -> a forall x. Dual x -> x fromDualType inhabitants :: Finite a => [a] inhabitants :: forall a. Finite a => [a] inhabitants = [a forall a. Bounded a => a minBound..a forall a. Bounded a => a maxBound] class (Enum a, Bounded a, Eq a, Ord a) => Finite a where typeSize :: Int typeSize = a -> Int forall a. Enum a => a -> Int fromEnum (forall a. Bounded a => a maxBound @a) Int -> Int -> Int forall a. Num a => a -> a -> a - a -> Int forall a. Enum a => a -> Int fromEnum (forall a. Bounded a => a minBound @a) Int -> Int -> Int forall a. Num a => a -> a -> a + Int 1 finiteFstsnd :: forall α β. (a ~ (α⊗β)) => Dict (Finite α, Finite β) finiteFstsnd = String -> Dict (Finite α, Finite β) forall a. HasCallStack => String -> a error String "finiteFstsnd: not a product type" finiteLeftRight :: forall α β. (a ~ (α⊕β)) => Dict (Finite α, Finite β) finiteLeftRight = String -> Dict (Finite α, Finite β) forall a. HasCallStack => String -> a error String "finiteFstsnd: not a sum type" fromZero :: forall a. Finite a => Int -> a fromZero :: forall a. Finite a => Int -> a fromZero Int i = Int -> a forall a. Enum a => Int -> a toEnum (Int i Int -> Int -> Int forall a. Num a => a -> a -> a + a -> Int forall a. Enum a => a -> Int fromEnum (forall a. Bounded a => a minBound @a)) instance (Bounded x, Bounded y) => Bounded (x⊕y) where minBound :: x ⊕ y minBound = x -> x ⊕ y forall x y. x -> x ⊕ y Inj1 x forall a. Bounded a => a minBound maxBound :: x ⊕ y maxBound = y -> x ⊕ y forall x y. y -> x ⊕ y Inj2 y forall a. Bounded a => a maxBound instance (Finite x, Finite y) => Enum (x⊕y) where toEnum :: Int -> x ⊕ y toEnum Int i = if Int i Int -> Int -> Bool forall a. Ord a => a -> a -> Bool < forall a. Finite a => Int typeSize @x then x -> x ⊕ y forall x y. x -> x ⊕ y Inj1 (Int -> x forall a. Enum a => Int -> a toEnum Int i) else y -> x ⊕ y forall x y. y -> x ⊕ y Inj2 (Int -> y forall a. Enum a => Int -> a toEnum (Int iInt -> Int -> Int forall a. Num a => a -> a -> a -forall a. Finite a => Int typeSize @x)) fromEnum :: (x ⊕ y) -> Int fromEnum = \case Inj1 x x -> x -> Int forall a. Enum a => a -> Int fromEnum x x Inj2 y x -> y -> Int forall a. Enum a => a -> Int fromEnum y x Int -> Int -> Int forall a. Num a => a -> a -> a + forall a. Finite a => Int typeSize @x instance (Finite x, Finite y) => Finite (x⊕y) where finiteLeftRight :: forall α β. ((x ⊕ y) ~ (α ⊕ β)) => Dict (Finite α, Finite β) finiteLeftRight = Dict (Finite α, Finite β) forall (a :: Constraint). a => Dict a Dict instance (Finite x, Finite y) => Enum (x⊗y) where toEnum :: Int -> x ⊗ y toEnum Int k = x -> y -> x ⊗ y forall x y. x -> y -> x ⊗ y Pair (Int -> x forall a. Enum a => Int -> a toEnum Int i) (Int -> y forall a. Enum a => Int -> a toEnum Int j) where (Int j,Int i) = Int k Int -> Int -> (Int, Int) forall a. Integral a => a -> a -> (a, a) `divMod` forall a. Finite a => Int typeSize @x fromEnum :: (x ⊗ y) -> Int fromEnum (Pair x x y y) = x -> Int forall a. Enum a => a -> Int fromEnum x x Int -> Int -> Int forall a. Num a => a -> a -> a + y -> Int forall a. Enum a => a -> Int fromEnum y y Int -> Int -> Int forall a. Num a => a -> a -> a * (forall a. Finite a => Int typeSize @x) instance (Finite x, Finite y) => Finite (x⊗y) where finiteFstsnd :: forall α β. ((x ⊗ y) ~ (α ⊗ β)) => Dict (Finite α, Finite β) finiteFstsnd = Dict (Finite α, Finite β) forall (a :: Constraint). a => Dict a Dict instance Finite Bool instance Finite One instance (Bounded x, Bounded y) => Bounded (x⊗y) where minBound :: x ⊗ y minBound = x forall a. Bounded a => a minBound x -> y -> x ⊗ y forall x y. x -> y -> x ⊗ y `Pair` y forall a. Bounded a => a minBound maxBound :: x ⊗ y maxBound = x forall a. Bounded a => a maxBound x -> y -> x ⊗ y forall x y. x -> y -> x ⊗ y `Pair` y forall a. Bounded a => a maxBound instance Enum Zero where toEnum :: Int -> Zero toEnum = String -> Int -> Zero forall a. HasCallStack => String -> a error String "toEnum: Zero" fromEnum :: Zero -> Int fromEnum = Zero -> Int \case instance Bounded Zero where minBound :: Zero minBound = String -> Zero forall a. HasCallStack => String -> a error String "minBound: Zero" maxBound :: Zero maxBound = String -> Zero forall a. HasCallStack => String -> a error String "maxBound: Zero" instance Finite Zero where typeSize :: Int typeSize = Int 0 instance CoArbitrary One where coarbitrary :: forall b. One -> Gen b -> Gen b coarbitrary One _ = Gen b -> Gen b forall a. a -> a id instance CoArbitrary Zero where coarbitrary :: forall b. Zero -> Gen b -> Gen b coarbitrary Zero _ = Gen b -> Gen b forall a. a -> a id instance (CoArbitrary f, CoArbitrary g) => CoArbitrary (f ⊕ g) where instance (CoArbitrary f, CoArbitrary g) => CoArbitrary (f ⊗ g) where newtype (f ∘ g) x = Comp {forall {k} {k} (f :: k -> *) (g :: k -> k) (x :: k). (∘) f g x -> f (g x) fromComp :: (f (g x))} deriving ((forall m. Monoid m => (∘) f g m -> m) -> (forall m a. Monoid m => (a -> m) -> (∘) f g a -> m) -> (forall m a. Monoid m => (a -> m) -> (∘) f g a -> m) -> (forall a b. (a -> b -> b) -> b -> (∘) f g a -> b) -> (forall a b. (a -> b -> b) -> b -> (∘) f g a -> b) -> (forall b a. (b -> a -> b) -> b -> (∘) f g a -> b) -> (forall b a. (b -> a -> b) -> b -> (∘) f g a -> b) -> (forall a. (a -> a -> a) -> (∘) f g a -> a) -> (forall a. (a -> a -> a) -> (∘) f g a -> a) -> (forall a. (∘) f g a -> [a]) -> (forall a. (∘) f g a -> Bool) -> (forall a. (∘) f g a -> Int) -> (forall a. Eq a => a -> (∘) f g a -> Bool) -> (forall a. Ord a => (∘) f g a -> a) -> (forall a. Ord a => (∘) f g a -> a) -> (forall a. Num a => (∘) f g a -> a) -> (forall a. Num a => (∘) f g a -> a) -> Foldable (f ∘ g) forall a. Eq a => a -> (∘) f g a -> Bool forall a. Num a => (∘) f g a -> a forall a. Ord a => (∘) f g a -> a forall m. Monoid m => (∘) f g m -> m forall a. (∘) f g a -> Bool forall a. (∘) f g a -> Int forall a. (∘) f g a -> [a] forall a. (a -> a -> a) -> (∘) f g a -> a forall m a. Monoid m => (a -> m) -> (∘) f g a -> m forall b a. (b -> a -> b) -> b -> (∘) f g a -> b forall a b. (a -> b -> b) -> b -> (∘) f g a -> b forall (t :: * -> *). (forall m. Monoid m => t m -> m) -> (forall m a. Monoid m => (a -> m) -> t a -> m) -> (forall m a. Monoid m => (a -> m) -> t a -> m) -> (forall a b. (a -> b -> b) -> b -> t a -> b) -> (forall a b. (a -> b -> b) -> b -> t a -> b) -> (forall b a. (b -> a -> b) -> b -> t a -> b) -> (forall b a. (b -> a -> b) -> b -> t a -> b) -> (forall a. (a -> a -> a) -> t a -> a) -> (forall a. (a -> a -> a) -> t a -> a) -> (forall a. t a -> [a]) -> (forall a. t a -> Bool) -> (forall a. t a -> Int) -> (forall a. Eq a => a -> t a -> Bool) -> (forall a. Ord a => t a -> a) -> (forall a. Ord a => t a -> a) -> (forall a. Num a => t a -> a) -> (forall a. Num a => t a -> a) -> Foldable t forall (f :: * -> *) (g :: * -> *) a. (Foldable f, Foldable g, Eq a) => a -> (∘) f g a -> Bool forall (f :: * -> *) (g :: * -> *) a. (Foldable f, Foldable g, Num a) => (∘) f g a -> a forall (f :: * -> *) (g :: * -> *) a. (Foldable f, Foldable g, Ord a) => (∘) f g a -> a forall (f :: * -> *) (g :: * -> *) m. (Foldable f, Foldable g, Monoid m) => (∘) f g m -> m forall (f :: * -> *) (g :: * -> *) a. (Foldable f, Foldable g) => (∘) f g a -> Bool forall (f :: * -> *) (g :: * -> *) a. (Foldable f, Foldable g) => (∘) f g a -> Int forall (f :: * -> *) (g :: * -> *) a. (Foldable f, Foldable g) => (∘) f g a -> [a] forall (f :: * -> *) (g :: * -> *) a. (Foldable f, Foldable g) => (a -> a -> a) -> (∘) f g a -> a forall (f :: * -> *) (g :: * -> *) m a. (Foldable f, Foldable g, Monoid m) => (a -> m) -> (∘) f g a -> m forall (f :: * -> *) (g :: * -> *) b a. (Foldable f, Foldable g) => (b -> a -> b) -> b -> (∘) f g a -> b forall (f :: * -> *) (g :: * -> *) a b. (Foldable f, Foldable g) => (a -> b -> b) -> b -> (∘) f g a -> b $cfold :: forall (f :: * -> *) (g :: * -> *) m. (Foldable f, Foldable g, Monoid m) => (∘) f g m -> m fold :: forall m. Monoid m => (∘) f g m -> m $cfoldMap :: forall (f :: * -> *) (g :: * -> *) m a. (Foldable f, Foldable g, Monoid m) => (a -> m) -> (∘) f g a -> m foldMap :: forall m a. Monoid m => (a -> m) -> (∘) f g a -> m $cfoldMap' :: forall (f :: * -> *) (g :: * -> *) m a. (Foldable f, Foldable g, Monoid m) => (a -> m) -> (∘) f g a -> m foldMap' :: forall m a. Monoid m => (a -> m) -> (∘) f g a -> m $cfoldr :: forall (f :: * -> *) (g :: * -> *) a b. (Foldable f, Foldable g) => (a -> b -> b) -> b -> (∘) f g a -> b foldr :: forall a b. (a -> b -> b) -> b -> (∘) f g a -> b $cfoldr' :: forall (f :: * -> *) (g :: * -> *) a b. (Foldable f, Foldable g) => (a -> b -> b) -> b -> (∘) f g a -> b foldr' :: forall a b. (a -> b -> b) -> b -> (∘) f g a -> b $cfoldl :: forall (f :: * -> *) (g :: * -> *) b a. (Foldable f, Foldable g) => (b -> a -> b) -> b -> (∘) f g a -> b foldl :: forall b a. (b -> a -> b) -> b -> (∘) f g a -> b $cfoldl' :: forall (f :: * -> *) (g :: * -> *) b a. (Foldable f, Foldable g) => (b -> a -> b) -> b -> (∘) f g a -> b foldl' :: forall b a. (b -> a -> b) -> b -> (∘) f g a -> b $cfoldr1 :: forall (f :: * -> *) (g :: * -> *) a. (Foldable f, Foldable g) => (a -> a -> a) -> (∘) f g a -> a foldr1 :: forall a. (a -> a -> a) -> (∘) f g a -> a $cfoldl1 :: forall (f :: * -> *) (g :: * -> *) a. (Foldable f, Foldable g) => (a -> a -> a) -> (∘) f g a -> a foldl1 :: forall a. (a -> a -> a) -> (∘) f g a -> a $ctoList :: forall (f :: * -> *) (g :: * -> *) a. (Foldable f, Foldable g) => (∘) f g a -> [a] toList :: forall a. (∘) f g a -> [a] $cnull :: forall (f :: * -> *) (g :: * -> *) a. (Foldable f, Foldable g) => (∘) f g a -> Bool null :: forall a. (∘) f g a -> Bool $clength :: forall (f :: * -> *) (g :: * -> *) a. (Foldable f, Foldable g) => (∘) f g a -> Int length :: forall a. (∘) f g a -> Int $celem :: forall (f :: * -> *) (g :: * -> *) a. (Foldable f, Foldable g, Eq a) => a -> (∘) f g a -> Bool elem :: forall a. Eq a => a -> (∘) f g a -> Bool $cmaximum :: forall (f :: * -> *) (g :: * -> *) a. (Foldable f, Foldable g, Ord a) => (∘) f g a -> a maximum :: forall a. Ord a => (∘) f g a -> a $cminimum :: forall (f :: * -> *) (g :: * -> *) a. (Foldable f, Foldable g, Ord a) => (∘) f g a -> a minimum :: forall a. Ord a => (∘) f g a -> a $csum :: forall (f :: * -> *) (g :: * -> *) a. (Foldable f, Foldable g, Num a) => (∘) f g a -> a sum :: forall a. Num a => (∘) f g a -> a $cproduct :: forall (f :: * -> *) (g :: * -> *) a. (Foldable f, Foldable g, Num a) => (∘) f g a -> a product :: forall a. Num a => (∘) f g a -> a Foldable, (forall (a :: k). (∘) f g a -> Rep1 (f ∘ g) a) -> (forall (a :: k). Rep1 (f ∘ g) a -> (∘) f g a) -> Generic1 (f ∘ g) forall (a :: k). Rep1 (f ∘ g) a -> (∘) f g a forall (a :: k). (∘) f g a -> Rep1 (f ∘ g) a forall k (f :: k -> *). (forall (a :: k). f a -> Rep1 f a) -> (forall (a :: k). Rep1 f a -> f a) -> Generic1 f forall (f :: * -> *) k (g :: k -> *) (a :: k). Functor f => Rep1 (f ∘ g) a -> (∘) f g a forall (f :: * -> *) k (g :: k -> *) (a :: k). Functor f => (∘) f g a -> Rep1 (f ∘ g) a $cfrom1 :: forall (f :: * -> *) k (g :: k -> *) (a :: k). Functor f => (∘) f g a -> Rep1 (f ∘ g) a from1 :: forall (a :: k). (∘) f g a -> Rep1 (f ∘ g) a $cto1 :: forall (f :: * -> *) k (g :: k -> *) (a :: k). Functor f => Rep1 (f ∘ g) a -> (∘) f g a to1 :: forall (a :: k). Rep1 (f ∘ g) a -> (∘) f g a Generic1, (∘) f g x -> (∘) f g x -> Bool ((∘) f g x -> (∘) f g x -> Bool) -> ((∘) f g x -> (∘) f g x -> Bool) -> Eq ((∘) f g x) forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a forall k (f :: k -> *) k (g :: k -> k) (x :: k). Eq (f (g x)) => (∘) f g x -> (∘) f g x -> Bool $c== :: forall k (f :: k -> *) k (g :: k -> k) (x :: k). Eq (f (g x)) => (∘) f g x -> (∘) f g x -> Bool == :: (∘) f g x -> (∘) f g x -> Bool $c/= :: forall k (f :: k -> *) k (g :: k -> k) (x :: k). Eq (f (g x)) => (∘) f g x -> (∘) f g x -> Bool /= :: (∘) f g x -> (∘) f g x -> Bool Eq) deriving instance (Functor f, Functor g) => Functor (f ∘ g) deriving instance (Traversable f, Traversable g) => Traversable (f ∘ g) newtype Id x = Id {forall x. Id x -> x fromId :: x} deriving ((forall m. Monoid m => Id m -> m) -> (forall m a. Monoid m => (a -> m) -> Id a -> m) -> (forall m a. Monoid m => (a -> m) -> Id a -> m) -> (forall a b. (a -> b -> b) -> b -> Id a -> b) -> (forall a b. (a -> b -> b) -> b -> Id a -> b) -> (forall b a. (b -> a -> b) -> b -> Id a -> b) -> (forall b a. (b -> a -> b) -> b -> Id a -> b) -> (forall a. (a -> a -> a) -> Id a -> a) -> (forall a. (a -> a -> a) -> Id a -> a) -> (forall a. Id a -> [a]) -> (forall a. Id a -> Bool) -> (forall a. Id a -> Int) -> (forall a. Eq a => a -> Id a -> Bool) -> (forall a. Ord a => Id a -> a) -> (forall a. Ord a => Id a -> a) -> (forall a. Num a => Id a -> a) -> (forall a. Num a => Id a -> a) -> Foldable Id forall a. Eq a => a -> Id a -> Bool forall a. Num a => Id a -> a forall a. Ord a => Id a -> a forall m. Monoid m => Id m -> m forall a. Id a -> Bool forall a. Id a -> Int forall a. Id a -> [a] forall a. (a -> a -> a) -> Id a -> a forall m a. Monoid m => (a -> m) -> Id a -> m forall b a. (b -> a -> b) -> b -> Id a -> b forall a b. (a -> b -> b) -> b -> Id a -> b forall (t :: * -> *). (forall m. Monoid m => t m -> m) -> (forall m a. Monoid m => (a -> m) -> t a -> m) -> (forall m a. Monoid m => (a -> m) -> t a -> m) -> (forall a b. (a -> b -> b) -> b -> t a -> b) -> (forall a b. (a -> b -> b) -> b -> t a -> b) -> (forall b a. (b -> a -> b) -> b -> t a -> b) -> (forall b a. (b -> a -> b) -> b -> t a -> b) -> (forall a. (a -> a -> a) -> t a -> a) -> (forall a. (a -> a -> a) -> t a -> a) -> (forall a. t a -> [a]) -> (forall a. t a -> Bool) -> (forall a. t a -> Int) -> (forall a. Eq a => a -> t a -> Bool) -> (forall a. Ord a => t a -> a) -> (forall a. Ord a => t a -> a) -> (forall a. Num a => t a -> a) -> (forall a. Num a => t a -> a) -> Foldable t $cfold :: forall m. Monoid m => Id m -> m fold :: forall m. Monoid m => Id m -> m $cfoldMap :: forall m a. Monoid m => (a -> m) -> Id a -> m foldMap :: forall m a. Monoid m => (a -> m) -> Id a -> m $cfoldMap' :: forall m a. Monoid m => (a -> m) -> Id a -> m foldMap' :: forall m a. Monoid m => (a -> m) -> Id a -> m $cfoldr :: forall a b. (a -> b -> b) -> b -> Id a -> b foldr :: forall a b. (a -> b -> b) -> b -> Id a -> b $cfoldr' :: forall a b. (a -> b -> b) -> b -> Id a -> b foldr' :: forall a b. (a -> b -> b) -> b -> Id a -> b $cfoldl :: forall b a. (b -> a -> b) -> b -> Id a -> b foldl :: forall b a. (b -> a -> b) -> b -> Id a -> b $cfoldl' :: forall b a. (b -> a -> b) -> b -> Id a -> b foldl' :: forall b a. (b -> a -> b) -> b -> Id a -> b $cfoldr1 :: forall a. (a -> a -> a) -> Id a -> a foldr1 :: forall a. (a -> a -> a) -> Id a -> a $cfoldl1 :: forall a. (a -> a -> a) -> Id a -> a foldl1 :: forall a. (a -> a -> a) -> Id a -> a $ctoList :: forall a. Id a -> [a] toList :: forall a. Id a -> [a] $cnull :: forall a. Id a -> Bool null :: forall a. Id a -> Bool $clength :: forall a. Id a -> Int length :: forall a. Id a -> Int $celem :: forall a. Eq a => a -> Id a -> Bool elem :: forall a. Eq a => a -> Id a -> Bool $cmaximum :: forall a. Ord a => Id a -> a maximum :: forall a. Ord a => Id a -> a $cminimum :: forall a. Ord a => Id a -> a minimum :: forall a. Ord a => Id a -> a $csum :: forall a. Num a => Id a -> a sum :: forall a. Num a => Id a -> a $cproduct :: forall a. Num a => Id a -> a product :: forall a. Num a => Id a -> a Foldable, Functor Id Foldable Id (Functor Id, Foldable Id) => (forall (f :: * -> *) a b. Applicative f => (a -> f b) -> Id a -> f (Id b)) -> (forall (f :: * -> *) a. Applicative f => Id (f a) -> f (Id a)) -> (forall (m :: * -> *) a b. Monad m => (a -> m b) -> Id a -> m (Id b)) -> (forall (m :: * -> *) a. Monad m => Id (m a) -> m (Id a)) -> Traversable Id forall (t :: * -> *). (Functor t, Foldable t) => (forall (f :: * -> *) a b. Applicative f => (a -> f b) -> t a -> f (t b)) -> (forall (f :: * -> *) a. Applicative f => t (f a) -> f (t a)) -> (forall (m :: * -> *) a b. Monad m => (a -> m b) -> t a -> m (t b)) -> (forall (m :: * -> *) a. Monad m => t (m a) -> m (t a)) -> Traversable t forall (m :: * -> *) a. Monad m => Id (m a) -> m (Id a) forall (f :: * -> *) a. Applicative f => Id (f a) -> f (Id a) forall (m :: * -> *) a b. Monad m => (a -> m b) -> Id a -> m (Id b) forall (f :: * -> *) a b. Applicative f => (a -> f b) -> Id a -> f (Id b) $ctraverse :: forall (f :: * -> *) a b. Applicative f => (a -> f b) -> Id a -> f (Id b) traverse :: forall (f :: * -> *) a b. Applicative f => (a -> f b) -> Id a -> f (Id b) $csequenceA :: forall (f :: * -> *) a. Applicative f => Id (f a) -> f (Id a) sequenceA :: forall (f :: * -> *) a. Applicative f => Id (f a) -> f (Id a) $cmapM :: forall (m :: * -> *) a b. Monad m => (a -> m b) -> Id a -> m (Id b) mapM :: forall (m :: * -> *) a b. Monad m => (a -> m b) -> Id a -> m (Id b) $csequence :: forall (m :: * -> *) a. Monad m => Id (m a) -> m (Id a) sequence :: forall (m :: * -> *) a. Monad m => Id (m a) -> m (Id a) Traversable, (forall a b. (a -> b) -> Id a -> Id b) -> (forall a b. a -> Id b -> Id a) -> Functor Id forall a b. a -> Id b -> Id a forall a b. (a -> b) -> Id a -> Id b forall (f :: * -> *). (forall a b. (a -> b) -> f a -> f b) -> (forall a b. a -> f b -> f a) -> Functor f $cfmap :: forall a b. (a -> b) -> Id a -> Id b fmap :: forall a b. (a -> b) -> Id a -> Id b $c<$ :: forall a b. a -> Id b -> Id a <$ :: forall a b. a -> Id b -> Id a Functor, (forall a. Id a -> Rep1 Id a) -> (forall a. Rep1 Id a -> Id a) -> Generic1 Id forall a. Rep1 Id a -> Id a forall a. Id a -> Rep1 Id a forall k (f :: k -> *). (forall (a :: k). f a -> Rep1 f a) -> (forall (a :: k). Rep1 f a -> f a) -> Generic1 f $cfrom1 :: forall a. Id a -> Rep1 Id a from1 :: forall a. Id a -> Rep1 Id a $cto1 :: forall a. Rep1 Id a -> Id a to1 :: forall a. Rep1 Id a -> Id a Generic1, Id x -> Id x -> Bool (Id x -> Id x -> Bool) -> (Id x -> Id x -> Bool) -> Eq (Id x) forall x. Eq x => Id x -> Id x -> Bool forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a $c== :: forall x. Eq x => Id x -> Id x -> Bool == :: Id x -> Id x -> Bool $c/= :: forall x. Eq x => Id x -> Id x -> Bool /= :: Id x -> Id x -> Bool Eq) instance SumKind (Type -> Type) where data (f ⊕ g) x = FunctorInj1 (f x) | FunctorInj2 (g x) deriving ((forall m. Monoid m => (⊕) f g m -> m) -> (forall m a. Monoid m => (a -> m) -> (⊕) f g a -> m) -> (forall m a. Monoid m => (a -> m) -> (⊕) f g a -> m) -> (forall a b. (a -> b -> b) -> b -> (⊕) f g a -> b) -> (forall a b. (a -> b -> b) -> b -> (⊕) f g a -> b) -> (forall b a. (b -> a -> b) -> b -> (⊕) f g a -> b) -> (forall b a. (b -> a -> b) -> b -> (⊕) f g a -> b) -> (forall a. (a -> a -> a) -> (⊕) f g a -> a) -> (forall a. (a -> a -> a) -> (⊕) f g a -> a) -> (forall a. (⊕) f g a -> [a]) -> (forall a. (⊕) f g a -> Bool) -> (forall a. (⊕) f g a -> Int) -> (forall a. Eq a => a -> (⊕) f g a -> Bool) -> (forall a. Ord a => (⊕) f g a -> a) -> (forall a. Ord a => (⊕) f g a -> a) -> (forall a. Num a => (⊕) f g a -> a) -> (forall a. Num a => (⊕) f g a -> a) -> Foldable (f ⊕ g) forall a. Eq a => a -> (⊕) f g a -> Bool forall a. Num a => (⊕) f g a -> a forall a. Ord a => (⊕) f g a -> a forall m. Monoid m => (⊕) f g m -> m forall a. (⊕) f g a -> Bool forall a. (⊕) f g a -> Int forall a. (⊕) f g a -> [a] forall a. (a -> a -> a) -> (⊕) f g a -> a forall m a. Monoid m => (a -> m) -> (⊕) f g a -> m forall b a. (b -> a -> b) -> b -> (⊕) f g a -> b forall a b. (a -> b -> b) -> b -> (⊕) f g a -> b forall (t :: * -> *). (forall m. Monoid m => t m -> m) -> (forall m a. Monoid m => (a -> m) -> t a -> m) -> (forall m a. Monoid m => (a -> m) -> t a -> m) -> (forall a b. (a -> b -> b) -> b -> t a -> b) -> (forall a b. (a -> b -> b) -> b -> t a -> b) -> (forall b a. (b -> a -> b) -> b -> t a -> b) -> (forall b a. (b -> a -> b) -> b -> t a -> b) -> (forall a. (a -> a -> a) -> t a -> a) -> (forall a. (a -> a -> a) -> t a -> a) -> (forall a. t a -> [a]) -> (forall a. t a -> Bool) -> (forall a. t a -> Int) -> (forall a. Eq a => a -> t a -> Bool) -> (forall a. Ord a => t a -> a) -> (forall a. Ord a => t a -> a) -> (forall a. Num a => t a -> a) -> (forall a. Num a => t a -> a) -> Foldable t forall (f :: * -> *) (g :: * -> *) a. (Foldable f, Foldable g, Eq a) => a -> (⊕) f g a -> Bool forall (f :: * -> *) (g :: * -> *) a. (Foldable f, Foldable g, Num a) => (⊕) f g a -> a forall (f :: * -> *) (g :: * -> *) a. (Foldable f, Foldable g, Ord a) => (⊕) f g a -> a forall (f :: * -> *) (g :: * -> *) m. (Foldable f, Foldable g, Monoid m) => (⊕) f g m -> m forall (f :: * -> *) (g :: * -> *) a. (Foldable f, Foldable g) => (⊕) f g a -> Bool forall (f :: * -> *) (g :: * -> *) a. (Foldable f, Foldable g) => (⊕) f g a -> Int forall (f :: * -> *) (g :: * -> *) a. (Foldable f, Foldable g) => (⊕) f g a -> [a] forall (f :: * -> *) (g :: * -> *) a. (Foldable f, Foldable g) => (a -> a -> a) -> (⊕) f g a -> a forall (f :: * -> *) (g :: * -> *) m a. (Foldable f, Foldable g, Monoid m) => (a -> m) -> (⊕) f g a -> m forall (f :: * -> *) (g :: * -> *) b a. (Foldable f, Foldable g) => (b -> a -> b) -> b -> (⊕) f g a -> b forall (f :: * -> *) (g :: * -> *) a b. (Foldable f, Foldable g) => (a -> b -> b) -> b -> (⊕) f g a -> b $cfold :: forall (f :: * -> *) (g :: * -> *) m. (Foldable f, Foldable g, Monoid m) => (⊕) f g m -> m fold :: forall m. Monoid m => (⊕) f g m -> m $cfoldMap :: forall (f :: * -> *) (g :: * -> *) m a. (Foldable f, Foldable g, Monoid m) => (a -> m) -> (⊕) f g a -> m foldMap :: forall m a. Monoid m => (a -> m) -> (⊕) f g a -> m $cfoldMap' :: forall (f :: * -> *) (g :: * -> *) m a. (Foldable f, Foldable g, Monoid m) => (a -> m) -> (⊕) f g a -> m foldMap' :: forall m a. Monoid m => (a -> m) -> (⊕) f g a -> m $cfoldr :: forall (f :: * -> *) (g :: * -> *) a b. (Foldable f, Foldable g) => (a -> b -> b) -> b -> (⊕) f g a -> b foldr :: forall a b. (a -> b -> b) -> b -> (⊕) f g a -> b $cfoldr' :: forall (f :: * -> *) (g :: * -> *) a b. (Foldable f, Foldable g) => (a -> b -> b) -> b -> (⊕) f g a -> b foldr' :: forall a b. (a -> b -> b) -> b -> (⊕) f g a -> b $cfoldl :: forall (f :: * -> *) (g :: * -> *) b a. (Foldable f, Foldable g) => (b -> a -> b) -> b -> (⊕) f g a -> b foldl :: forall b a. (b -> a -> b) -> b -> (⊕) f g a -> b $cfoldl' :: forall (f :: * -> *) (g :: * -> *) b a. (Foldable f, Foldable g) => (b -> a -> b) -> b -> (⊕) f g a -> b foldl' :: forall b a. (b -> a -> b) -> b -> (⊕) f g a -> b $cfoldr1 :: forall (f :: * -> *) (g :: * -> *) a. (Foldable f, Foldable g) => (a -> a -> a) -> (⊕) f g a -> a foldr1 :: forall a. (a -> a -> a) -> (⊕) f g a -> a $cfoldl1 :: forall (f :: * -> *) (g :: * -> *) a. (Foldable f, Foldable g) => (a -> a -> a) -> (⊕) f g a -> a foldl1 :: forall a. (a -> a -> a) -> (⊕) f g a -> a $ctoList :: forall (f :: * -> *) (g :: * -> *) a. (Foldable f, Foldable g) => (⊕) f g a -> [a] toList :: forall a. (⊕) f g a -> [a] $cnull :: forall (f :: * -> *) (g :: * -> *) a. (Foldable f, Foldable g) => (⊕) f g a -> Bool null :: forall a. (⊕) f g a -> Bool $clength :: forall (f :: * -> *) (g :: * -> *) a. (Foldable f, Foldable g) => (⊕) f g a -> Int length :: forall a. (⊕) f g a -> Int $celem :: forall (f :: * -> *) (g :: * -> *) a. (Foldable f, Foldable g, Eq a) => a -> (⊕) f g a -> Bool elem :: forall a. Eq a => a -> (⊕) f g a -> Bool $cmaximum :: forall (f :: * -> *) (g :: * -> *) a. (Foldable f, Foldable g, Ord a) => (⊕) f g a -> a maximum :: forall a. Ord a => (⊕) f g a -> a $cminimum :: forall (f :: * -> *) (g :: * -> *) a. (Foldable f, Foldable g, Ord a) => (⊕) f g a -> a minimum :: forall a. Ord a => (⊕) f g a -> a $csum :: forall (f :: * -> *) (g :: * -> *) a. (Foldable f, Foldable g, Num a) => (⊕) f g a -> a sum :: forall a. Num a => (⊕) f g a -> a $cproduct :: forall (f :: * -> *) (g :: * -> *) a. (Foldable f, Foldable g, Num a) => (⊕) f g a -> a product :: forall a. Num a => (⊕) f g a -> a Foldable, Functor (f ⊕ g) Foldable (f ⊕ g) (Functor (f ⊕ g), Foldable (f ⊕ g)) => (forall (f :: * -> *) a b. Applicative f => (a -> f b) -> (⊕) f g a -> f ((⊕) f g b)) -> (forall (f :: * -> *) a. Applicative f => (⊕) f g (f a) -> f ((⊕) f g a)) -> (forall (m :: * -> *) a b. Monad m => (a -> m b) -> (⊕) f g a -> m ((⊕) f g b)) -> (forall (m :: * -> *) a. Monad m => (⊕) f g (m a) -> m ((⊕) f g a)) -> Traversable (f ⊕ g) forall (t :: * -> *). (Functor t, Foldable t) => (forall (f :: * -> *) a b. Applicative f => (a -> f b) -> t a -> f (t b)) -> (forall (f :: * -> *) a. Applicative f => t (f a) -> f (t a)) -> (forall (m :: * -> *) a b. Monad m => (a -> m b) -> t a -> m (t b)) -> (forall (m :: * -> *) a. Monad m => t (m a) -> m (t a)) -> Traversable t forall (m :: * -> *) a. Monad m => (⊕) f g (m a) -> m ((⊕) f g a) forall (f :: * -> *) a. Applicative f => (⊕) f g (f a) -> f ((⊕) f g a) forall (m :: * -> *) a b. Monad m => (a -> m b) -> (⊕) f g a -> m ((⊕) f g b) forall (f :: * -> *) a b. Applicative f => (a -> f b) -> (⊕) f g a -> f ((⊕) f g b) forall (f :: * -> *) (g :: * -> *). (Traversable f, Traversable g) => Functor (f ⊕ g) forall (f :: * -> *) (g :: * -> *). (Traversable f, Traversable g) => Foldable (f ⊕ g) forall (f :: * -> *) (g :: * -> *) (m :: * -> *) a. (Traversable f, Traversable g, Monad m) => (⊕) f g (m a) -> m ((⊕) f g a) forall (f :: * -> *) (g :: * -> *) (f :: * -> *) a. (Traversable f, Traversable g, Applicative f) => (⊕) f g (f a) -> f ((⊕) f g a) forall (f :: * -> *) (g :: * -> *) (m :: * -> *) a b. (Traversable f, Traversable g, Monad m) => (a -> m b) -> (⊕) f g a -> m ((⊕) f g b) forall (f :: * -> *) (g :: * -> *) (f :: * -> *) a b. (Traversable f, Traversable g, Applicative f) => (a -> f b) -> (⊕) f g a -> f ((⊕) f g b) $ctraverse :: forall (f :: * -> *) (g :: * -> *) (f :: * -> *) a b. (Traversable f, Traversable g, Applicative f) => (a -> f b) -> (⊕) f g a -> f ((⊕) f g b) traverse :: forall (f :: * -> *) a b. Applicative f => (a -> f b) -> (⊕) f g a -> f ((⊕) f g b) $csequenceA :: forall (f :: * -> *) (g :: * -> *) (f :: * -> *) a. (Traversable f, Traversable g, Applicative f) => (⊕) f g (f a) -> f ((⊕) f g a) sequenceA :: forall (f :: * -> *) a. Applicative f => (⊕) f g (f a) -> f ((⊕) f g a) $cmapM :: forall (f :: * -> *) (g :: * -> *) (m :: * -> *) a b. (Traversable f, Traversable g, Monad m) => (a -> m b) -> (⊕) f g a -> m ((⊕) f g b) mapM :: forall (m :: * -> *) a b. Monad m => (a -> m b) -> (⊕) f g a -> m ((⊕) f g b) $csequence :: forall (f :: * -> *) (g :: * -> *) (m :: * -> *) a. (Traversable f, Traversable g, Monad m) => (⊕) f g (m a) -> m ((⊕) f g a) sequence :: forall (m :: * -> *) a. Monad m => (⊕) f g (m a) -> m ((⊕) f g a) Traversable, (forall a b. (a -> b) -> (⊕) f g a -> (⊕) f g b) -> (forall a b. a -> (⊕) f g b -> (⊕) f g a) -> Functor (f ⊕ g) forall a b. a -> (⊕) f g b -> (⊕) f g a forall a b. (a -> b) -> (⊕) f g a -> (⊕) f g b forall (f :: * -> *). (forall a b. (a -> b) -> f a -> f b) -> (forall a b. a -> f b -> f a) -> Functor f forall (f :: * -> *) (g :: * -> *) a b. (Functor f, Functor g) => a -> (⊕) f g b -> (⊕) f g a forall (f :: * -> *) (g :: * -> *) a b. (Functor f, Functor g) => (a -> b) -> (⊕) f g a -> (⊕) f g b $cfmap :: forall (f :: * -> *) (g :: * -> *) a b. (Functor f, Functor g) => (a -> b) -> (⊕) f g a -> (⊕) f g b fmap :: forall a b. (a -> b) -> (⊕) f g a -> (⊕) f g b $c<$ :: forall (f :: * -> *) (g :: * -> *) a b. (Functor f, Functor g) => a -> (⊕) f g b -> (⊕) f g a <$ :: forall a b. a -> (⊕) f g b -> (⊕) f g a Functor,(forall a. (⊕) f g a -> Rep1 (f ⊕ g) a) -> (forall a. Rep1 (f ⊕ g) a -> (⊕) f g a) -> Generic1 (f ⊕ g) forall a. Rep1 (f ⊕ g) a -> (⊕) f g a forall a. (⊕) f g a -> Rep1 (f ⊕ g) a forall k (f :: k -> *). (forall (a :: k). f a -> Rep1 f a) -> (forall (a :: k). Rep1 f a -> f a) -> Generic1 f forall (f :: * -> *) (g :: * -> *) a. Rep1 (f ⊕ g) a -> (⊕) f g a forall (f :: * -> *) (g :: * -> *) a. (⊕) f g a -> Rep1 (f ⊕ g) a $cfrom1 :: forall (f :: * -> *) (g :: * -> *) a. (⊕) f g a -> Rep1 (f ⊕ g) a from1 :: forall a. (⊕) f g a -> Rep1 (f ⊕ g) a $cto1 :: forall (f :: * -> *) (g :: * -> *) a. Rep1 (f ⊕ g) a -> (⊕) f g a to1 :: forall a. Rep1 (f ⊕ g) a -> (⊕) f g a Generic1,(⊕) f g x -> (⊕) f g x -> Bool ((⊕) f g x -> (⊕) f g x -> Bool) -> ((⊕) f g x -> (⊕) f g x -> Bool) -> Eq ((⊕) f g x) forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a forall (f :: * -> *) (g :: * -> *) x. (Eq (f x), Eq (g x)) => (⊕) f g x -> (⊕) f g x -> Bool $c== :: forall (f :: * -> *) (g :: * -> *) x. (Eq (f x), Eq (g x)) => (⊕) f g x -> (⊕) f g x -> Bool == :: (⊕) f g x -> (⊕) f g x -> Bool $c/= :: forall (f :: * -> *) (g :: * -> *) x. (Eq (f x), Eq (g x)) => (⊕) f g x -> (⊕) f g x -> Bool /= :: (⊕) f g x -> (⊕) f g x -> Bool Eq) data Zero x deriving ((forall m. Monoid m => Zero m -> m) -> (forall m a. Monoid m => (a -> m) -> Zero a -> m) -> (forall m a. Monoid m => (a -> m) -> Zero a -> m) -> (forall a b. (a -> b -> b) -> b -> Zero a -> b) -> (forall a b. (a -> b -> b) -> b -> Zero a -> b) -> (forall b a. (b -> a -> b) -> b -> Zero a -> b) -> (forall b a. (b -> a -> b) -> b -> Zero a -> b) -> (forall a. (a -> a -> a) -> Zero a -> a) -> (forall a. (a -> a -> a) -> Zero a -> a) -> (forall a. Zero a -> [a]) -> (forall a. Zero a -> Bool) -> (forall a. Zero a -> Int) -> (forall a. Eq a => a -> Zero a -> Bool) -> (forall a. Ord a => Zero a -> a) -> (forall a. Ord a => Zero a -> a) -> (forall a. Num a => Zero a -> a) -> (forall a. Num a => Zero a -> a) -> Foldable Zero forall a. Eq a => a -> Zero a -> Bool forall a. Num a => Zero a -> a forall a. Ord a => Zero a -> a forall m. Monoid m => Zero m -> m forall a. Zero a -> Bool forall a. Zero a -> Int forall a. Zero a -> [a] forall a. (a -> a -> a) -> Zero a -> a forall m a. Monoid m => (a -> m) -> Zero a -> m forall b a. (b -> a -> b) -> b -> Zero a -> b forall a b. (a -> b -> b) -> b -> Zero a -> b forall (t :: * -> *). (forall m. Monoid m => t m -> m) -> (forall m a. Monoid m => (a -> m) -> t a -> m) -> (forall m a. Monoid m => (a -> m) -> t a -> m) -> (forall a b. (a -> b -> b) -> b -> t a -> b) -> (forall a b. (a -> b -> b) -> b -> t a -> b) -> (forall b a. (b -> a -> b) -> b -> t a -> b) -> (forall b a. (b -> a -> b) -> b -> t a -> b) -> (forall a. (a -> a -> a) -> t a -> a) -> (forall a. (a -> a -> a) -> t a -> a) -> (forall a. t a -> [a]) -> (forall a. t a -> Bool) -> (forall a. t a -> Int) -> (forall a. Eq a => a -> t a -> Bool) -> (forall a. Ord a => t a -> a) -> (forall a. Ord a => t a -> a) -> (forall a. Num a => t a -> a) -> (forall a. Num a => t a -> a) -> Foldable t $cfold :: forall m. Monoid m => Zero m -> m fold :: forall m. Monoid m => Zero m -> m $cfoldMap :: forall m a. Monoid m => (a -> m) -> Zero a -> m foldMap :: forall m a. Monoid m => (a -> m) -> Zero a -> m $cfoldMap' :: forall m a. Monoid m => (a -> m) -> Zero a -> m foldMap' :: forall m a. Monoid m => (a -> m) -> Zero a -> m $cfoldr :: forall a b. (a -> b -> b) -> b -> Zero a -> b foldr :: forall a b. (a -> b -> b) -> b -> Zero a -> b $cfoldr' :: forall a b. (a -> b -> b) -> b -> Zero a -> b foldr' :: forall a b. (a -> b -> b) -> b -> Zero a -> b $cfoldl :: forall b a. (b -> a -> b) -> b -> Zero a -> b foldl :: forall b a. (b -> a -> b) -> b -> Zero a -> b $cfoldl' :: forall b a. (b -> a -> b) -> b -> Zero a -> b foldl' :: forall b a. (b -> a -> b) -> b -> Zero a -> b $cfoldr1 :: forall a. (a -> a -> a) -> Zero a -> a foldr1 :: forall a. (a -> a -> a) -> Zero a -> a $cfoldl1 :: forall a. (a -> a -> a) -> Zero a -> a foldl1 :: forall a. (a -> a -> a) -> Zero a -> a $ctoList :: forall a. Zero a -> [a] toList :: forall a. Zero a -> [a] $cnull :: forall a. Zero a -> Bool null :: forall a. Zero a -> Bool $clength :: forall a. Zero a -> Int length :: forall a. Zero a -> Int $celem :: forall a. Eq a => a -> Zero a -> Bool elem :: forall a. Eq a => a -> Zero a -> Bool $cmaximum :: forall a. Ord a => Zero a -> a maximum :: forall a. Ord a => Zero a -> a $cminimum :: forall a. Ord a => Zero a -> a minimum :: forall a. Ord a => Zero a -> a $csum :: forall a. Num a => Zero a -> a sum :: forall a. Num a => Zero a -> a $cproduct :: forall a. Num a => Zero a -> a product :: forall a. Num a => Zero a -> a Foldable, Functor Zero Foldable Zero (Functor Zero, Foldable Zero) => (forall (f :: * -> *) a b. Applicative f => (a -> f b) -> Zero a -> f (Zero b)) -> (forall (f :: * -> *) a. Applicative f => Zero (f a) -> f (Zero a)) -> (forall (m :: * -> *) a b. Monad m => (a -> m b) -> Zero a -> m (Zero b)) -> (forall (m :: * -> *) a. Monad m => Zero (m a) -> m (Zero a)) -> Traversable Zero forall (t :: * -> *). (Functor t, Foldable t) => (forall (f :: * -> *) a b. Applicative f => (a -> f b) -> t a -> f (t b)) -> (forall (f :: * -> *) a. Applicative f => t (f a) -> f (t a)) -> (forall (m :: * -> *) a b. Monad m => (a -> m b) -> t a -> m (t b)) -> (forall (m :: * -> *) a. Monad m => t (m a) -> m (t a)) -> Traversable t forall (m :: * -> *) a. Monad m => Zero (m a) -> m (Zero a) forall (f :: * -> *) a. Applicative f => Zero (f a) -> f (Zero a) forall (m :: * -> *) a b. Monad m => (a -> m b) -> Zero a -> m (Zero b) forall (f :: * -> *) a b. Applicative f => (a -> f b) -> Zero a -> f (Zero b) $ctraverse :: forall (f :: * -> *) a b. Applicative f => (a -> f b) -> Zero a -> f (Zero b) traverse :: forall (f :: * -> *) a b. Applicative f => (a -> f b) -> Zero a -> f (Zero b) $csequenceA :: forall (f :: * -> *) a. Applicative f => Zero (f a) -> f (Zero a) sequenceA :: forall (f :: * -> *) a. Applicative f => Zero (f a) -> f (Zero a) $cmapM :: forall (m :: * -> *) a b. Monad m => (a -> m b) -> Zero a -> m (Zero b) mapM :: forall (m :: * -> *) a b. Monad m => (a -> m b) -> Zero a -> m (Zero b) $csequence :: forall (m :: * -> *) a. Monad m => Zero (m a) -> m (Zero a) sequence :: forall (m :: * -> *) a. Monad m => Zero (m a) -> m (Zero a) Traversable, (forall a b. (a -> b) -> Zero a -> Zero b) -> (forall a b. a -> Zero b -> Zero a) -> Functor Zero forall a b. a -> Zero b -> Zero a forall a b. (a -> b) -> Zero a -> Zero b forall (f :: * -> *). (forall a b. (a -> b) -> f a -> f b) -> (forall a b. a -> f b -> f a) -> Functor f $cfmap :: forall a b. (a -> b) -> Zero a -> Zero b fmap :: forall a b. (a -> b) -> Zero a -> Zero b $c<$ :: forall a b. a -> Zero b -> Zero a <$ :: forall a b. a -> Zero b -> Zero a Functor,(forall a. Zero a -> Rep1 Zero a) -> (forall a. Rep1 Zero a -> Zero a) -> Generic1 Zero forall a. Rep1 Zero a -> Zero a forall a. Zero a -> Rep1 Zero a forall k (f :: k -> *). (forall (a :: k). f a -> Rep1 f a) -> (forall (a :: k). Rep1 f a -> f a) -> Generic1 f $cfrom1 :: forall a. Zero a -> Rep1 Zero a from1 :: forall a. Zero a -> Rep1 Zero a $cto1 :: forall a. Rep1 Zero a -> Zero a to1 :: forall a. Rep1 Zero a -> Zero a Generic1,Zero x -> Zero x -> Bool (Zero x -> Zero x -> Bool) -> (Zero x -> Zero x -> Bool) -> Eq (Zero x) forall x. Zero x -> Zero x -> Bool forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a $c== :: forall x. Zero x -> Zero x -> Bool == :: Zero x -> Zero x -> Bool $c/= :: forall x. Zero x -> Zero x -> Bool /= :: Zero x -> Zero x -> Bool Eq) instance ProdKind (Type -> Type) where data (f ⊗ g) x = FunctorProd {forall (f :: * -> *) (g :: * -> *) x. (⊗) f g x -> f x prodFst :: f x, forall (f :: * -> *) (g :: * -> *) x. (⊗) f g x -> g x prodSnd :: g x} deriving ((forall m. Monoid m => (⊗) f g m -> m) -> (forall m a. Monoid m => (a -> m) -> (⊗) f g a -> m) -> (forall m a. Monoid m => (a -> m) -> (⊗) f g a -> m) -> (forall a b. (a -> b -> b) -> b -> (⊗) f g a -> b) -> (forall a b. (a -> b -> b) -> b -> (⊗) f g a -> b) -> (forall b a. (b -> a -> b) -> b -> (⊗) f g a -> b) -> (forall b a. (b -> a -> b) -> b -> (⊗) f g a -> b) -> (forall a. (a -> a -> a) -> (⊗) f g a -> a) -> (forall a. (a -> a -> a) -> (⊗) f g a -> a) -> (forall a. (⊗) f g a -> [a]) -> (forall a. (⊗) f g a -> Bool) -> (forall a. (⊗) f g a -> Int) -> (forall a. Eq a => a -> (⊗) f g a -> Bool) -> (forall a. Ord a => (⊗) f g a -> a) -> (forall a. Ord a => (⊗) f g a -> a) -> (forall a. Num a => (⊗) f g a -> a) -> (forall a. Num a => (⊗) f g a -> a) -> Foldable (f ⊗ g) forall a. Eq a => a -> (⊗) f g a -> Bool forall a. Num a => (⊗) f g a -> a forall a. Ord a => (⊗) f g a -> a forall m. Monoid m => (⊗) f g m -> m forall a. (⊗) f g a -> Bool forall a. (⊗) f g a -> Int forall a. (⊗) f g a -> [a] forall a. (a -> a -> a) -> (⊗) f g a -> a forall m a. Monoid m => (a -> m) -> (⊗) f g a -> m forall b a. (b -> a -> b) -> b -> (⊗) f g a -> b forall a b. (a -> b -> b) -> b -> (⊗) f g a -> b forall (t :: * -> *). (forall m. Monoid m => t m -> m) -> (forall m a. Monoid m => (a -> m) -> t a -> m) -> (forall m a. Monoid m => (a -> m) -> t a -> m) -> (forall a b. (a -> b -> b) -> b -> t a -> b) -> (forall a b. (a -> b -> b) -> b -> t a -> b) -> (forall b a. (b -> a -> b) -> b -> t a -> b) -> (forall b a. (b -> a -> b) -> b -> t a -> b) -> (forall a. (a -> a -> a) -> t a -> a) -> (forall a. (a -> a -> a) -> t a -> a) -> (forall a. t a -> [a]) -> (forall a. t a -> Bool) -> (forall a. t a -> Int) -> (forall a. Eq a => a -> t a -> Bool) -> (forall a. Ord a => t a -> a) -> (forall a. Ord a => t a -> a) -> (forall a. Num a => t a -> a) -> (forall a. Num a => t a -> a) -> Foldable t forall (f :: * -> *) (g :: * -> *) a. (Foldable f, Foldable g, Eq a) => a -> (⊗) f g a -> Bool forall (f :: * -> *) (g :: * -> *) a. (Foldable f, Foldable g, Num a) => (⊗) f g a -> a forall (f :: * -> *) (g :: * -> *) a. (Foldable f, Foldable g, Ord a) => (⊗) f g a -> a forall (f :: * -> *) (g :: * -> *) m. (Foldable f, Foldable g, Monoid m) => (⊗) f g m -> m forall (f :: * -> *) (g :: * -> *) a. (Foldable f, Foldable g) => (⊗) f g a -> Bool forall (f :: * -> *) (g :: * -> *) a. (Foldable f, Foldable g) => (⊗) f g a -> Int forall (f :: * -> *) (g :: * -> *) a. (Foldable f, Foldable g) => (⊗) f g a -> [a] forall (f :: * -> *) (g :: * -> *) a. (Foldable f, Foldable g) => (a -> a -> a) -> (⊗) f g a -> a forall (f :: * -> *) (g :: * -> *) m a. (Foldable f, Foldable g, Monoid m) => (a -> m) -> (⊗) f g a -> m forall (f :: * -> *) (g :: * -> *) b a. (Foldable f, Foldable g) => (b -> a -> b) -> b -> (⊗) f g a -> b forall (f :: * -> *) (g :: * -> *) a b. (Foldable f, Foldable g) => (a -> b -> b) -> b -> (⊗) f g a -> b $cfold :: forall (f :: * -> *) (g :: * -> *) m. (Foldable f, Foldable g, Monoid m) => (⊗) f g m -> m fold :: forall m. Monoid m => (⊗) f g m -> m $cfoldMap :: forall (f :: * -> *) (g :: * -> *) m a. (Foldable f, Foldable g, Monoid m) => (a -> m) -> (⊗) f g a -> m foldMap :: forall m a. Monoid m => (a -> m) -> (⊗) f g a -> m $cfoldMap' :: forall (f :: * -> *) (g :: * -> *) m a. (Foldable f, Foldable g, Monoid m) => (a -> m) -> (⊗) f g a -> m foldMap' :: forall m a. Monoid m => (a -> m) -> (⊗) f g a -> m $cfoldr :: forall (f :: * -> *) (g :: * -> *) a b. (Foldable f, Foldable g) => (a -> b -> b) -> b -> (⊗) f g a -> b foldr :: forall a b. (a -> b -> b) -> b -> (⊗) f g a -> b $cfoldr' :: forall (f :: * -> *) (g :: * -> *) a b. (Foldable f, Foldable g) => (a -> b -> b) -> b -> (⊗) f g a -> b foldr' :: forall a b. (a -> b -> b) -> b -> (⊗) f g a -> b $cfoldl :: forall (f :: * -> *) (g :: * -> *) b a. (Foldable f, Foldable g) => (b -> a -> b) -> b -> (⊗) f g a -> b foldl :: forall b a. (b -> a -> b) -> b -> (⊗) f g a -> b $cfoldl' :: forall (f :: * -> *) (g :: * -> *) b a. (Foldable f, Foldable g) => (b -> a -> b) -> b -> (⊗) f g a -> b foldl' :: forall b a. (b -> a -> b) -> b -> (⊗) f g a -> b $cfoldr1 :: forall (f :: * -> *) (g :: * -> *) a. (Foldable f, Foldable g) => (a -> a -> a) -> (⊗) f g a -> a foldr1 :: forall a. (a -> a -> a) -> (⊗) f g a -> a $cfoldl1 :: forall (f :: * -> *) (g :: * -> *) a. (Foldable f, Foldable g) => (a -> a -> a) -> (⊗) f g a -> a foldl1 :: forall a. (a -> a -> a) -> (⊗) f g a -> a $ctoList :: forall (f :: * -> *) (g :: * -> *) a. (Foldable f, Foldable g) => (⊗) f g a -> [a] toList :: forall a. (⊗) f g a -> [a] $cnull :: forall (f :: * -> *) (g :: * -> *) a. (Foldable f, Foldable g) => (⊗) f g a -> Bool null :: forall a. (⊗) f g a -> Bool $clength :: forall (f :: * -> *) (g :: * -> *) a. (Foldable f, Foldable g) => (⊗) f g a -> Int length :: forall a. (⊗) f g a -> Int $celem :: forall (f :: * -> *) (g :: * -> *) a. (Foldable f, Foldable g, Eq a) => a -> (⊗) f g a -> Bool elem :: forall a. Eq a => a -> (⊗) f g a -> Bool $cmaximum :: forall (f :: * -> *) (g :: * -> *) a. (Foldable f, Foldable g, Ord a) => (⊗) f g a -> a maximum :: forall a. Ord a => (⊗) f g a -> a $cminimum :: forall (f :: * -> *) (g :: * -> *) a. (Foldable f, Foldable g, Ord a) => (⊗) f g a -> a minimum :: forall a. Ord a => (⊗) f g a -> a $csum :: forall (f :: * -> *) (g :: * -> *) a. (Foldable f, Foldable g, Num a) => (⊗) f g a -> a sum :: forall a. Num a => (⊗) f g a -> a $cproduct :: forall (f :: * -> *) (g :: * -> *) a. (Foldable f, Foldable g, Num a) => (⊗) f g a -> a product :: forall a. Num a => (⊗) f g a -> a Foldable, Functor (f ⊗ g) Foldable (f ⊗ g) (Functor (f ⊗ g), Foldable (f ⊗ g)) => (forall (f :: * -> *) a b. Applicative f => (a -> f b) -> (⊗) f g a -> f ((⊗) f g b)) -> (forall (f :: * -> *) a. Applicative f => (⊗) f g (f a) -> f ((⊗) f g a)) -> (forall (m :: * -> *) a b. Monad m => (a -> m b) -> (⊗) f g a -> m ((⊗) f g b)) -> (forall (m :: * -> *) a. Monad m => (⊗) f g (m a) -> m ((⊗) f g a)) -> Traversable (f ⊗ g) forall (t :: * -> *). (Functor t, Foldable t) => (forall (f :: * -> *) a b. Applicative f => (a -> f b) -> t a -> f (t b)) -> (forall (f :: * -> *) a. Applicative f => t (f a) -> f (t a)) -> (forall (m :: * -> *) a b. Monad m => (a -> m b) -> t a -> m (t b)) -> (forall (m :: * -> *) a. Monad m => t (m a) -> m (t a)) -> Traversable t forall (m :: * -> *) a. Monad m => (⊗) f g (m a) -> m ((⊗) f g a) forall (f :: * -> *) a. Applicative f => (⊗) f g (f a) -> f ((⊗) f g a) forall (m :: * -> *) a b. Monad m => (a -> m b) -> (⊗) f g a -> m ((⊗) f g b) forall (f :: * -> *) a b. Applicative f => (a -> f b) -> (⊗) f g a -> f ((⊗) f g b) forall (f :: * -> *) (g :: * -> *). (Traversable f, Traversable g) => Functor (f ⊗ g) forall (f :: * -> *) (g :: * -> *). (Traversable f, Traversable g) => Foldable (f ⊗ g) forall (f :: * -> *) (g :: * -> *) (m :: * -> *) a. (Traversable f, Traversable g, Monad m) => (⊗) f g (m a) -> m ((⊗) f g a) forall (f :: * -> *) (g :: * -> *) (f :: * -> *) a. (Traversable f, Traversable g, Applicative f) => (⊗) f g (f a) -> f ((⊗) f g a) forall (f :: * -> *) (g :: * -> *) (m :: * -> *) a b. (Traversable f, Traversable g, Monad m) => (a -> m b) -> (⊗) f g a -> m ((⊗) f g b) forall (f :: * -> *) (g :: * -> *) (f :: * -> *) a b. (Traversable f, Traversable g, Applicative f) => (a -> f b) -> (⊗) f g a -> f ((⊗) f g b) $ctraverse :: forall (f :: * -> *) (g :: * -> *) (f :: * -> *) a b. (Traversable f, Traversable g, Applicative f) => (a -> f b) -> (⊗) f g a -> f ((⊗) f g b) traverse :: forall (f :: * -> *) a b. Applicative f => (a -> f b) -> (⊗) f g a -> f ((⊗) f g b) $csequenceA :: forall (f :: * -> *) (g :: * -> *) (f :: * -> *) a. (Traversable f, Traversable g, Applicative f) => (⊗) f g (f a) -> f ((⊗) f g a) sequenceA :: forall (f :: * -> *) a. Applicative f => (⊗) f g (f a) -> f ((⊗) f g a) $cmapM :: forall (f :: * -> *) (g :: * -> *) (m :: * -> *) a b. (Traversable f, Traversable g, Monad m) => (a -> m b) -> (⊗) f g a -> m ((⊗) f g b) mapM :: forall (m :: * -> *) a b. Monad m => (a -> m b) -> (⊗) f g a -> m ((⊗) f g b) $csequence :: forall (f :: * -> *) (g :: * -> *) (m :: * -> *) a. (Traversable f, Traversable g, Monad m) => (⊗) f g (m a) -> m ((⊗) f g a) sequence :: forall (m :: * -> *) a. Monad m => (⊗) f g (m a) -> m ((⊗) f g a) Traversable, (forall a b. (a -> b) -> (⊗) f g a -> (⊗) f g b) -> (forall a b. a -> (⊗) f g b -> (⊗) f g a) -> Functor (f ⊗ g) forall a b. a -> (⊗) f g b -> (⊗) f g a forall a b. (a -> b) -> (⊗) f g a -> (⊗) f g b forall (f :: * -> *). (forall a b. (a -> b) -> f a -> f b) -> (forall a b. a -> f b -> f a) -> Functor f forall (f :: * -> *) (g :: * -> *) a b. (Functor f, Functor g) => a -> (⊗) f g b -> (⊗) f g a forall (f :: * -> *) (g :: * -> *) a b. (Functor f, Functor g) => (a -> b) -> (⊗) f g a -> (⊗) f g b $cfmap :: forall (f :: * -> *) (g :: * -> *) a b. (Functor f, Functor g) => (a -> b) -> (⊗) f g a -> (⊗) f g b fmap :: forall a b. (a -> b) -> (⊗) f g a -> (⊗) f g b $c<$ :: forall (f :: * -> *) (g :: * -> *) a b. (Functor f, Functor g) => a -> (⊗) f g b -> (⊗) f g a <$ :: forall a b. a -> (⊗) f g b -> (⊗) f g a Functor,(forall a. (⊗) f g a -> Rep1 (f ⊗ g) a) -> (forall a. Rep1 (f ⊗ g) a -> (⊗) f g a) -> Generic1 (f ⊗ g) forall a. Rep1 (f ⊗ g) a -> (⊗) f g a forall a. (⊗) f g a -> Rep1 (f ⊗ g) a forall k (f :: k -> *). (forall (a :: k). f a -> Rep1 f a) -> (forall (a :: k). Rep1 f a -> f a) -> Generic1 f forall (f :: * -> *) (g :: * -> *) a. Rep1 (f ⊗ g) a -> (⊗) f g a forall (f :: * -> *) (g :: * -> *) a. (⊗) f g a -> Rep1 (f ⊗ g) a $cfrom1 :: forall (f :: * -> *) (g :: * -> *) a. (⊗) f g a -> Rep1 (f ⊗ g) a from1 :: forall a. (⊗) f g a -> Rep1 (f ⊗ g) a $cto1 :: forall (f :: * -> *) (g :: * -> *) a. Rep1 (f ⊗ g) a -> (⊗) f g a to1 :: forall a. Rep1 (f ⊗ g) a -> (⊗) f g a Generic1,(⊗) f g x -> (⊗) f g x -> Bool ((⊗) f g x -> (⊗) f g x -> Bool) -> ((⊗) f g x -> (⊗) f g x -> Bool) -> Eq ((⊗) f g x) forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a forall (f :: * -> *) (g :: * -> *) x. (Eq (f x), Eq (g x)) => (⊗) f g x -> (⊗) f g x -> Bool $c== :: forall (f :: * -> *) (g :: * -> *) x. (Eq (f x), Eq (g x)) => (⊗) f g x -> (⊗) f g x -> Bool == :: (⊗) f g x -> (⊗) f g x -> Bool $c/= :: forall (f :: * -> *) (g :: * -> *) x. (Eq (f x), Eq (g x)) => (⊗) f g x -> (⊗) f g x -> Bool /= :: (⊗) f g x -> (⊗) f g x -> Bool Eq) data One x = FunctorOne deriving ((forall m. Monoid m => One m -> m) -> (forall m a. Monoid m => (a -> m) -> One a -> m) -> (forall m a. Monoid m => (a -> m) -> One a -> m) -> (forall a b. (a -> b -> b) -> b -> One a -> b) -> (forall a b. (a -> b -> b) -> b -> One a -> b) -> (forall b a. (b -> a -> b) -> b -> One a -> b) -> (forall b a. (b -> a -> b) -> b -> One a -> b) -> (forall a. (a -> a -> a) -> One a -> a) -> (forall a. (a -> a -> a) -> One a -> a) -> (forall a. One a -> [a]) -> (forall a. One a -> Bool) -> (forall a. One a -> Int) -> (forall a. Eq a => a -> One a -> Bool) -> (forall a. Ord a => One a -> a) -> (forall a. Ord a => One a -> a) -> (forall a. Num a => One a -> a) -> (forall a. Num a => One a -> a) -> Foldable One forall a. Eq a => a -> One a -> Bool forall a. Num a => One a -> a forall a. Ord a => One a -> a forall m. Monoid m => One m -> m forall a. One a -> Bool forall a. One a -> Int forall a. One a -> [a] forall a. (a -> a -> a) -> One a -> a forall m a. Monoid m => (a -> m) -> One a -> m forall b a. (b -> a -> b) -> b -> One a -> b forall a b. (a -> b -> b) -> b -> One a -> b forall (t :: * -> *). (forall m. Monoid m => t m -> m) -> (forall m a. Monoid m => (a -> m) -> t a -> m) -> (forall m a. Monoid m => (a -> m) -> t a -> m) -> (forall a b. (a -> b -> b) -> b -> t a -> b) -> (forall a b. (a -> b -> b) -> b -> t a -> b) -> (forall b a. (b -> a -> b) -> b -> t a -> b) -> (forall b a. (b -> a -> b) -> b -> t a -> b) -> (forall a. (a -> a -> a) -> t a -> a) -> (forall a. (a -> a -> a) -> t a -> a) -> (forall a. t a -> [a]) -> (forall a. t a -> Bool) -> (forall a. t a -> Int) -> (forall a. Eq a => a -> t a -> Bool) -> (forall a. Ord a => t a -> a) -> (forall a. Ord a => t a -> a) -> (forall a. Num a => t a -> a) -> (forall a. Num a => t a -> a) -> Foldable t $cfold :: forall m. Monoid m => One m -> m fold :: forall m. Monoid m => One m -> m $cfoldMap :: forall m a. Monoid m => (a -> m) -> One a -> m foldMap :: forall m a. Monoid m => (a -> m) -> One a -> m $cfoldMap' :: forall m a. Monoid m => (a -> m) -> One a -> m foldMap' :: forall m a. Monoid m => (a -> m) -> One a -> m $cfoldr :: forall a b. (a -> b -> b) -> b -> One a -> b foldr :: forall a b. (a -> b -> b) -> b -> One a -> b $cfoldr' :: forall a b. (a -> b -> b) -> b -> One a -> b foldr' :: forall a b. (a -> b -> b) -> b -> One a -> b $cfoldl :: forall b a. (b -> a -> b) -> b -> One a -> b foldl :: forall b a. (b -> a -> b) -> b -> One a -> b $cfoldl' :: forall b a. (b -> a -> b) -> b -> One a -> b foldl' :: forall b a. (b -> a -> b) -> b -> One a -> b $cfoldr1 :: forall a. (a -> a -> a) -> One a -> a foldr1 :: forall a. (a -> a -> a) -> One a -> a $cfoldl1 :: forall a. (a -> a -> a) -> One a -> a foldl1 :: forall a. (a -> a -> a) -> One a -> a $ctoList :: forall a. One a -> [a] toList :: forall a. One a -> [a] $cnull :: forall a. One a -> Bool null :: forall a. One a -> Bool $clength :: forall a. One a -> Int length :: forall a. One a -> Int $celem :: forall a. Eq a => a -> One a -> Bool elem :: forall a. Eq a => a -> One a -> Bool $cmaximum :: forall a. Ord a => One a -> a maximum :: forall a. Ord a => One a -> a $cminimum :: forall a. Ord a => One a -> a minimum :: forall a. Ord a => One a -> a $csum :: forall a. Num a => One a -> a sum :: forall a. Num a => One a -> a $cproduct :: forall a. Num a => One a -> a product :: forall a. Num a => One a -> a Foldable, Functor One Foldable One (Functor One, Foldable One) => (forall (f :: * -> *) a b. Applicative f => (a -> f b) -> One a -> f (One b)) -> (forall (f :: * -> *) a. Applicative f => One (f a) -> f (One a)) -> (forall (m :: * -> *) a b. Monad m => (a -> m b) -> One a -> m (One b)) -> (forall (m :: * -> *) a. Monad m => One (m a) -> m (One a)) -> Traversable One forall (t :: * -> *). (Functor t, Foldable t) => (forall (f :: * -> *) a b. Applicative f => (a -> f b) -> t a -> f (t b)) -> (forall (f :: * -> *) a. Applicative f => t (f a) -> f (t a)) -> (forall (m :: * -> *) a b. Monad m => (a -> m b) -> t a -> m (t b)) -> (forall (m :: * -> *) a. Monad m => t (m a) -> m (t a)) -> Traversable t forall (m :: * -> *) a. Monad m => One (m a) -> m (One a) forall (f :: * -> *) a. Applicative f => One (f a) -> f (One a) forall (m :: * -> *) a b. Monad m => (a -> m b) -> One a -> m (One b) forall (f :: * -> *) a b. Applicative f => (a -> f b) -> One a -> f (One b) $ctraverse :: forall (f :: * -> *) a b. Applicative f => (a -> f b) -> One a -> f (One b) traverse :: forall (f :: * -> *) a b. Applicative f => (a -> f b) -> One a -> f (One b) $csequenceA :: forall (f :: * -> *) a. Applicative f => One (f a) -> f (One a) sequenceA :: forall (f :: * -> *) a. Applicative f => One (f a) -> f (One a) $cmapM :: forall (m :: * -> *) a b. Monad m => (a -> m b) -> One a -> m (One b) mapM :: forall (m :: * -> *) a b. Monad m => (a -> m b) -> One a -> m (One b) $csequence :: forall (m :: * -> *) a. Monad m => One (m a) -> m (One a) sequence :: forall (m :: * -> *) a. Monad m => One (m a) -> m (One a) Traversable, (forall a b. (a -> b) -> One a -> One b) -> (forall a b. a -> One b -> One a) -> Functor One forall a b. a -> One b -> One a forall a b. (a -> b) -> One a -> One b forall (f :: * -> *). (forall a b. (a -> b) -> f a -> f b) -> (forall a b. a -> f b -> f a) -> Functor f $cfmap :: forall a b. (a -> b) -> One a -> One b fmap :: forall a b. (a -> b) -> One a -> One b $c<$ :: forall a b. a -> One b -> One a <$ :: forall a b. a -> One b -> One a Functor, (forall a. One a -> Rep1 One a) -> (forall a. Rep1 One a -> One a) -> Generic1 One forall a. Rep1 One a -> One a forall a. One a -> Rep1 One a forall k (f :: k -> *). (forall (a :: k). f a -> Rep1 f a) -> (forall (a :: k). Rep1 f a -> f a) -> Generic1 f $cfrom1 :: forall a. One a -> Rep1 One a from1 :: forall a. One a -> Rep1 One a $cto1 :: forall a. Rep1 One a -> One a to1 :: forall a. Rep1 One a -> One a Generic1, One x -> One x -> Bool (One x -> One x -> Bool) -> (One x -> One x -> Bool) -> Eq (One x) forall x. One x -> One x -> Bool forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a $c== :: forall x. One x -> One x -> Bool == :: One x -> One x -> Bool $c/= :: forall x. One x -> One x -> Bool /= :: One x -> One x -> Bool Eq) instance DualKind (Type -> Type) where data Dual f x = FunctorDual {forall (f :: * -> *) x. Dual f x -> f x fromFunctorDual :: f x} deriving ((forall m. Monoid m => Dual f m -> m) -> (forall m a. Monoid m => (a -> m) -> Dual f a -> m) -> (forall m a. Monoid m => (a -> m) -> Dual f a -> m) -> (forall a b. (a -> b -> b) -> b -> Dual f a -> b) -> (forall a b. (a -> b -> b) -> b -> Dual f a -> b) -> (forall b a. (b -> a -> b) -> b -> Dual f a -> b) -> (forall b a. (b -> a -> b) -> b -> Dual f a -> b) -> (forall a. (a -> a -> a) -> Dual f a -> a) -> (forall a. (a -> a -> a) -> Dual f a -> a) -> (forall a. Dual f a -> [a]) -> (forall a. Dual f a -> Bool) -> (forall a. Dual f a -> Int) -> (forall a. Eq a => a -> Dual f a -> Bool) -> (forall a. Ord a => Dual f a -> a) -> (forall a. Ord a => Dual f a -> a) -> (forall a. Num a => Dual f a -> a) -> (forall a. Num a => Dual f a -> a) -> Foldable (Dual f) forall a. Eq a => a -> Dual f a -> Bool forall a. Num a => Dual f a -> a forall a. Ord a => Dual f a -> a forall m. Monoid m => Dual f m -> m forall a. Dual f a -> Bool forall a. Dual f a -> Int forall a. Dual f a -> [a] forall a. (a -> a -> a) -> Dual f a -> a forall m a. Monoid m => (a -> m) -> Dual f a -> m forall b a. (b -> a -> b) -> b -> Dual f a -> b forall a b. (a -> b -> b) -> b -> Dual f a -> b forall (f :: * -> *) a. (Foldable f, Eq a) => a -> Dual f a -> Bool forall (f :: * -> *) a. (Foldable f, Num a) => Dual f a -> a forall (f :: * -> *) a. (Foldable f, Ord a) => Dual f a -> a forall (f :: * -> *) m. (Foldable f, Monoid m) => Dual f m -> m forall (f :: * -> *) a. Foldable f => Dual f a -> Bool forall (f :: * -> *) a. Foldable f => Dual f a -> Int forall (f :: * -> *) a. Foldable f => Dual f a -> [a] forall (f :: * -> *) a. Foldable f => (a -> a -> a) -> Dual f a -> a forall (f :: * -> *) m a. (Foldable f, Monoid m) => (a -> m) -> Dual f a -> m forall (f :: * -> *) b a. Foldable f => (b -> a -> b) -> b -> Dual f a -> b forall (f :: * -> *) a b. Foldable f => (a -> b -> b) -> b -> Dual f a -> b forall (t :: * -> *). (forall m. Monoid m => t m -> m) -> (forall m a. Monoid m => (a -> m) -> t a -> m) -> (forall m a. Monoid m => (a -> m) -> t a -> m) -> (forall a b. (a -> b -> b) -> b -> t a -> b) -> (forall a b. (a -> b -> b) -> b -> t a -> b) -> (forall b a. (b -> a -> b) -> b -> t a -> b) -> (forall b a. (b -> a -> b) -> b -> t a -> b) -> (forall a. (a -> a -> a) -> t a -> a) -> (forall a. (a -> a -> a) -> t a -> a) -> (forall a. t a -> [a]) -> (forall a. t a -> Bool) -> (forall a. t a -> Int) -> (forall a. Eq a => a -> t a -> Bool) -> (forall a. Ord a => t a -> a) -> (forall a. Ord a => t a -> a) -> (forall a. Num a => t a -> a) -> (forall a. Num a => t a -> a) -> Foldable t $cfold :: forall (f :: * -> *) m. (Foldable f, Monoid m) => Dual f m -> m fold :: forall m. Monoid m => Dual f m -> m $cfoldMap :: forall (f :: * -> *) m a. (Foldable f, Monoid m) => (a -> m) -> Dual f a -> m foldMap :: forall m a. Monoid m => (a -> m) -> Dual f a -> m $cfoldMap' :: forall (f :: * -> *) m a. (Foldable f, Monoid m) => (a -> m) -> Dual f a -> m foldMap' :: forall m a. Monoid m => (a -> m) -> Dual f a -> m $cfoldr :: forall (f :: * -> *) a b. Foldable f => (a -> b -> b) -> b -> Dual f a -> b foldr :: forall a b. (a -> b -> b) -> b -> Dual f a -> b $cfoldr' :: forall (f :: * -> *) a b. Foldable f => (a -> b -> b) -> b -> Dual f a -> b foldr' :: forall a b. (a -> b -> b) -> b -> Dual f a -> b $cfoldl :: forall (f :: * -> *) b a. Foldable f => (b -> a -> b) -> b -> Dual f a -> b foldl :: forall b a. (b -> a -> b) -> b -> Dual f a -> b $cfoldl' :: forall (f :: * -> *) b a. Foldable f => (b -> a -> b) -> b -> Dual f a -> b foldl' :: forall b a. (b -> a -> b) -> b -> Dual f a -> b $cfoldr1 :: forall (f :: * -> *) a. Foldable f => (a -> a -> a) -> Dual f a -> a foldr1 :: forall a. (a -> a -> a) -> Dual f a -> a $cfoldl1 :: forall (f :: * -> *) a. Foldable f => (a -> a -> a) -> Dual f a -> a foldl1 :: forall a. (a -> a -> a) -> Dual f a -> a $ctoList :: forall (f :: * -> *) a. Foldable f => Dual f a -> [a] toList :: forall a. Dual f a -> [a] $cnull :: forall (f :: * -> *) a. Foldable f => Dual f a -> Bool null :: forall a. Dual f a -> Bool $clength :: forall (f :: * -> *) a. Foldable f => Dual f a -> Int length :: forall a. Dual f a -> Int $celem :: forall (f :: * -> *) a. (Foldable f, Eq a) => a -> Dual f a -> Bool elem :: forall a. Eq a => a -> Dual f a -> Bool $cmaximum :: forall (f :: * -> *) a. (Foldable f, Ord a) => Dual f a -> a maximum :: forall a. Ord a => Dual f a -> a $cminimum :: forall (f :: * -> *) a. (Foldable f, Ord a) => Dual f a -> a minimum :: forall a. Ord a => Dual f a -> a $csum :: forall (f :: * -> *) a. (Foldable f, Num a) => Dual f a -> a sum :: forall a. Num a => Dual f a -> a $cproduct :: forall (f :: * -> *) a. (Foldable f, Num a) => Dual f a -> a product :: forall a. Num a => Dual f a -> a Foldable, Functor (Dual f) Foldable (Dual f) (Functor (Dual f), Foldable (Dual f)) => (forall (f :: * -> *) a b. Applicative f => (a -> f b) -> Dual f a -> f (Dual f b)) -> (forall (f :: * -> *) a. Applicative f => Dual f (f a) -> f (Dual f a)) -> (forall (m :: * -> *) a b. Monad m => (a -> m b) -> Dual f a -> m (Dual f b)) -> (forall (m :: * -> *) a. Monad m => Dual f (m a) -> m (Dual f a)) -> Traversable (Dual f) forall (t :: * -> *). (Functor t, Foldable t) => (forall (f :: * -> *) a b. Applicative f => (a -> f b) -> t a -> f (t b)) -> (forall (f :: * -> *) a. Applicative f => t (f a) -> f (t a)) -> (forall (m :: * -> *) a b. Monad m => (a -> m b) -> t a -> m (t b)) -> (forall (m :: * -> *) a. Monad m => t (m a) -> m (t a)) -> Traversable t forall (f :: * -> *). Traversable f => Functor (Dual f) forall (f :: * -> *). Traversable f => Foldable (Dual f) forall (f :: * -> *) (m :: * -> *) a. (Traversable f, Monad m) => Dual f (m a) -> m (Dual f a) forall (f :: * -> *) (f :: * -> *) a. (Traversable f, Applicative f) => Dual f (f a) -> f (Dual f a) forall (f :: * -> *) (m :: * -> *) a b. (Traversable f, Monad m) => (a -> m b) -> Dual f a -> m (Dual f b) forall (f :: * -> *) (f :: * -> *) a b. (Traversable f, Applicative f) => (a -> f b) -> Dual f a -> f (Dual f b) forall (m :: * -> *) a. Monad m => Dual f (m a) -> m (Dual f a) forall (f :: * -> *) a. Applicative f => Dual f (f a) -> f (Dual f a) forall (m :: * -> *) a b. Monad m => (a -> m b) -> Dual f a -> m (Dual f b) forall (f :: * -> *) a b. Applicative f => (a -> f b) -> Dual f a -> f (Dual f b) $ctraverse :: forall (f :: * -> *) (f :: * -> *) a b. (Traversable f, Applicative f) => (a -> f b) -> Dual f a -> f (Dual f b) traverse :: forall (f :: * -> *) a b. Applicative f => (a -> f b) -> Dual f a -> f (Dual f b) $csequenceA :: forall (f :: * -> *) (f :: * -> *) a. (Traversable f, Applicative f) => Dual f (f a) -> f (Dual f a) sequenceA :: forall (f :: * -> *) a. Applicative f => Dual f (f a) -> f (Dual f a) $cmapM :: forall (f :: * -> *) (m :: * -> *) a b. (Traversable f, Monad m) => (a -> m b) -> Dual f a -> m (Dual f b) mapM :: forall (m :: * -> *) a b. Monad m => (a -> m b) -> Dual f a -> m (Dual f b) $csequence :: forall (f :: * -> *) (m :: * -> *) a. (Traversable f, Monad m) => Dual f (m a) -> m (Dual f a) sequence :: forall (m :: * -> *) a. Monad m => Dual f (m a) -> m (Dual f a) Traversable, (forall a b. (a -> b) -> Dual f a -> Dual f b) -> (forall a b. a -> Dual f b -> Dual f a) -> Functor (Dual f) forall a b. a -> Dual f b -> Dual f a forall a b. (a -> b) -> Dual f a -> Dual f b forall (f :: * -> *) a b. Functor f => a -> Dual f b -> Dual f a forall (f :: * -> *) a b. Functor f => (a -> b) -> Dual f a -> Dual f b forall (f :: * -> *). (forall a b. (a -> b) -> f a -> f b) -> (forall a b. a -> f b -> f a) -> Functor f $cfmap :: forall (f :: * -> *) a b. Functor f => (a -> b) -> Dual f a -> Dual f b fmap :: forall a b. (a -> b) -> Dual f a -> Dual f b $c<$ :: forall (f :: * -> *) a b. Functor f => a -> Dual f b -> Dual f a <$ :: forall a b. a -> Dual f b -> Dual f a Functor, (forall a. Dual f a -> Rep1 (Dual f) a) -> (forall a. Rep1 (Dual f) a -> Dual f a) -> Generic1 (Dual f) forall a. Rep1 (Dual f) a -> Dual f a forall a. Dual f a -> Rep1 (Dual f) a forall k (f :: k -> *). (forall (a :: k). f a -> Rep1 f a) -> (forall (a :: k). Rep1 f a -> f a) -> Generic1 f forall (f :: * -> *) a. Rep1 (Dual f) a -> Dual f a forall (f :: * -> *) a. Dual f a -> Rep1 (Dual f) a $cfrom1 :: forall (f :: * -> *) a. Dual f a -> Rep1 (Dual f) a from1 :: forall a. Dual f a -> Rep1 (Dual f) a $cto1 :: forall (f :: * -> *) a. Rep1 (Dual f) a -> Dual f a to1 :: forall a. Rep1 (Dual f) a -> Dual f a Generic1, Int -> Dual f x -> ShowS [Dual f x] -> ShowS Dual f x -> String (Int -> Dual f x -> ShowS) -> (Dual f x -> String) -> ([Dual f x] -> ShowS) -> Show (Dual f x) forall a. (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a forall (f :: * -> *) x. Show (f x) => Int -> Dual f x -> ShowS forall (f :: * -> *) x. Show (f x) => [Dual f x] -> ShowS forall (f :: * -> *) x. Show (f x) => Dual f x -> String $cshowsPrec :: forall (f :: * -> *) x. Show (f x) => Int -> Dual f x -> ShowS showsPrec :: Int -> Dual f x -> ShowS $cshow :: forall (f :: * -> *) x. Show (f x) => Dual f x -> String show :: Dual f x -> String $cshowList :: forall (f :: * -> *) x. Show (f x) => [Dual f x] -> ShowS showList :: [Dual f x] -> ShowS Show, Dual f x -> Dual f x -> Bool (Dual f x -> Dual f x -> Bool) -> (Dual f x -> Dual f x -> Bool) -> Eq (Dual f x) forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a forall (f :: * -> *) x. Eq (f x) => Dual f x -> Dual f x -> Bool $c== :: forall (f :: * -> *) x. Eq (f x) => Dual f x -> Dual f x -> Bool == :: Dual f x -> Dual f x -> Bool $c/= :: forall (f :: * -> *) x. Eq (f x) => Dual f x -> Dual f x -> Bool /= :: Dual f x -> Dual f x -> Bool Eq) deriving instance Show (One (x :: Type)) deriving instance Show x => Show (Id (x :: Type)) deriving instance (Show (a x), Show (b x)) => Show ((a⊗b) (x :: Type)) deriving instance (Show (a (b x))) => Show ((a∘b) (x :: Type)) data CompClosed (con :: Type -> Constraint) = CompClosed { forall (con :: * -> Constraint). CompClosed con -> forall x. Dict (con (One x)) zero1Closed :: forall (x :: Type). Dict (con (One x)), forall (con :: * -> Constraint). CompClosed con -> forall (a :: * -> *) (b :: * -> *) x. (con (a x), con (b x)) => Dict (con ((⊗) a b x)) plus1Closed :: forall a b (x :: Type). (con (a x), con (b x)) => Dict (con ((a⊗b) x)), forall (con :: * -> Constraint). CompClosed con -> forall x. con x => Dict (con (Id x)) one1Closed :: forall (x :: Type). con x => Dict (con (Id x)), forall (con :: * -> Constraint). CompClosed con -> forall (a :: * -> *) (b :: * -> *) x. con (a (b x)) => Dict (con ((∘) a b x)) times1Closed :: forall (a :: Type -> Type) b (x :: Type). (con (a (b x))) => Dict (con ((a∘b) x)) } showCompClosed :: CompClosed Show showCompClosed :: CompClosed Show showCompClosed = (forall x. Dict (Show (One x))) -> (forall (a :: * -> *) (b :: * -> *) x. (Show (a x), Show (b x)) => Dict (Show ((⊗) a b x))) -> (forall x. Show x => Dict (Show (Id x))) -> (forall (a :: * -> *) (b :: * -> *) x. Show (a (b x)) => Dict (Show ((∘) a b x))) -> CompClosed Show forall (con :: * -> Constraint). (forall x. Dict (con (One x))) -> (forall (a :: * -> *) (b :: * -> *) x. (con (a x), con (b x)) => Dict (con ((⊗) a b x))) -> (forall x. con x => Dict (con (Id x))) -> (forall (a :: * -> *) (b :: * -> *) x. con (a (b x)) => Dict (con ((∘) a b x))) -> CompClosed con CompClosed Dict (Show (One x)) forall x. Dict (Show (One x)) forall (a :: Constraint). a => Dict a Dict Dict (Show ((⊗) a b x)) forall (a :: Constraint). a => Dict a forall (a :: * -> *) (b :: * -> *) x. (Show (a x), Show (b x)) => Dict (Show ((⊗) a b x)) Dict Dict (Show (Id x)) forall x. Show x => Dict (Show (Id x)) forall (a :: Constraint). a => Dict a Dict Dict (Show ((∘) a b x)) forall (a :: Constraint). a => Dict a forall (a :: * -> *) (b :: * -> *) x. Show (a (b x)) => Dict (Show ((∘) a b x)) Dict instance Distributive One where distribute :: forall (f :: * -> *) a. Functor f => f (One a) -> One (f a) distribute f (One a) _ = One (f a) forall x. One x FunctorOne instance Distributive Id where distribute :: forall (f :: * -> *) a. Functor f => f (Id a) -> Id (f a) distribute = f a -> Id (f a) forall x. x -> Id x Id (f a -> Id (f a)) -> (f (Id a) -> f a) -> f (Id a) -> Id (f a) forall b c a. (b -> c) -> (a -> b) -> a -> c . (Id a -> a) -> f (Id a) -> f a forall a b. (a -> b) -> f a -> f b forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b fmap Id a -> a forall x. Id x -> x fromId instance Representable One where type Rep One = Zero index :: forall a. One a -> Rep One -> a index One a R:OneFUNx a FunctorOne = Rep One -> a \case tabulate :: forall a. (Rep One -> a) -> One a tabulate Rep One -> a _ = One a forall x. One x FunctorOne instance Representable Id where type Rep Id = One index :: forall a. Id a -> Rep Id -> a index (Id a x) Rep Id _ = a x tabulate :: forall a. (Rep Id -> a) -> Id a tabulate Rep Id -> a f = a -> Id a forall x. x -> Id x Id (Rep Id -> a f Rep Id One Unit) instance (Distributive v, Distributive w) => Distributive (v ∘ w) where distribute :: forall (f :: * -> *) a. Functor f => f ((∘) v w a) -> (∘) v w (f a) distribute = v (w (f a)) -> (∘) v w (f a) forall {k} {k} (f :: k -> *) (g :: k -> k) (x :: k). f (g x) -> (∘) f g x Comp (v (w (f a)) -> (∘) v w (f a)) -> (f ((∘) v w a) -> v (w (f a))) -> f ((∘) v w a) -> (∘) v w (f a) forall b c a. (b -> c) -> (a -> b) -> a -> c . (f (w a) -> w (f a)) -> v (f (w a)) -> v (w (f a)) forall a b. (a -> b) -> v a -> v b forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b fmap f (w a) -> w (f a) forall (g :: * -> *) (f :: * -> *) a. (Distributive g, Functor f) => f (g a) -> g (f a) forall (f :: * -> *) a. Functor f => f (w a) -> w (f a) distribute (v (f (w a)) -> v (w (f a))) -> (f ((∘) v w a) -> v (f (w a))) -> f ((∘) v w a) -> v (w (f a)) forall b c a. (b -> c) -> (a -> b) -> a -> c . f (v (w a)) -> v (f (w a)) forall (g :: * -> *) (f :: * -> *) a. (Distributive g, Functor f) => f (g a) -> g (f a) forall (f :: * -> *) a. Functor f => f (v a) -> v (f a) distribute (f (v (w a)) -> v (f (w a))) -> (f ((∘) v w a) -> f (v (w a))) -> f ((∘) v w a) -> v (f (w a)) forall b c a. (b -> c) -> (a -> b) -> a -> c . ((∘) v w a -> v (w a)) -> f ((∘) v w a) -> f (v (w a)) forall a b. (a -> b) -> f a -> f b forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b fmap (∘) v w a -> v (w a) forall {k} {k} (f :: k -> *) (g :: k -> k) (x :: k). (∘) f g x -> f (g x) fromComp instance (Representable v, Representable w) => Representable (v ∘ w) where type Rep (v ∘ w) = Rep v ⊗ Rep w index :: forall a. (∘) v w a -> Rep (v ∘ w) -> a index (Comp v (w a) f) (Rep v i `Pair` Rep w j) = (v (w a) f v (w a) -> Rep v -> w a forall a. v a -> Rep v -> a forall (f :: * -> *) a. Representable f => f a -> Rep f -> a `index` Rep v i) w a -> Rep w -> a forall a. w a -> Rep w -> a forall (f :: * -> *) a. Representable f => f a -> Rep f -> a `index` Rep w j tabulate :: forall a. (Rep (v ∘ w) -> a) -> (∘) v w a tabulate Rep (v ∘ w) -> a f = v (w a) -> (∘) v w a forall {k} {k} (f :: k -> *) (g :: k -> k) (x :: k). f (g x) -> (∘) f g x Comp ((Rep v -> w a) -> v (w a) forall a. (Rep v -> a) -> v a forall (f :: * -> *) a. Representable f => (Rep f -> a) -> f a tabulate (\Rep v i -> (Rep w -> a) -> w a forall a. (Rep w -> a) -> w a forall (f :: * -> *) a. Representable f => (Rep f -> a) -> f a tabulate (\Rep w j -> Rep (v ∘ w) -> a f (Rep v i Rep v -> Rep w -> Rep v ⊗ Rep w forall x y. x -> y -> x ⊗ y `Pair` Rep w j)))) instance (Distributive v, Distributive w) => Distributive (v ⊗ w) where collect :: forall (f :: * -> *) a b. Functor f => (a -> (⊗) v w b) -> f a -> (⊗) v w (f b) collect a -> (⊗) v w b f f a x = v (f b) -> w (f b) -> (⊗) v w (f b) forall (f :: * -> *) (g :: * -> *) x. f x -> g x -> (⊗) f g x FunctorProd ((a -> v b) -> f a -> v (f b) forall (g :: * -> *) (f :: * -> *) a b. (Distributive g, Functor f) => (a -> g b) -> f a -> g (f b) forall (f :: * -> *) a b. Functor f => (a -> v b) -> f a -> v (f b) collect ((⊗) v w b -> v b forall (f :: * -> *) (g :: * -> *) x. (⊗) f g x -> f x prodFst ((⊗) v w b -> v b) -> (a -> (⊗) v w b) -> a -> v b forall b c a. (b -> c) -> (a -> b) -> a -> c . a -> (⊗) v w b f) f a x) ((a -> w b) -> f a -> w (f b) forall (g :: * -> *) (f :: * -> *) a b. (Distributive g, Functor f) => (a -> g b) -> f a -> g (f b) forall (f :: * -> *) a b. Functor f => (a -> w b) -> f a -> w (f b) collect ((⊗) v w b -> w b forall (f :: * -> *) (g :: * -> *) x. (⊗) f g x -> g x prodSnd ((⊗) v w b -> w b) -> (a -> (⊗) v w b) -> a -> w b forall b c a. (b -> c) -> (a -> b) -> a -> c . a -> (⊗) v w b f) f a x) instance (Representable v, Representable w) => Representable (v ⊗ w) where type Rep (v ⊗ w) = Rep v ⊕ Rep w index :: forall a. (⊗) v w a -> Rep (v ⊗ w) -> a index (FunctorProd v a x w a y) = \case Inj1 Rep v i -> v a -> Rep v -> a forall a. v a -> Rep v -> a forall (f :: * -> *) a. Representable f => f a -> Rep f -> a index v a x Rep v i Inj2 Rep w i -> w a -> Rep w -> a forall a. w a -> Rep w -> a forall (f :: * -> *) a. Representable f => f a -> Rep f -> a index w a y Rep w i tabulate :: forall a. (Rep (v ⊗ w) -> a) -> (⊗) v w a tabulate Rep (v ⊗ w) -> a f = v a -> w a -> (⊗) v w a forall (f :: * -> *) (g :: * -> *) x. f x -> g x -> (⊗) f g x FunctorProd ((Rep v -> a) -> v a forall a. (Rep v -> a) -> v a forall (f :: * -> *) a. Representable f => (Rep f -> a) -> f a tabulate (Rep (v ⊗ w) -> a (Rep v ⊕ Rep w) -> a f ((Rep v ⊕ Rep w) -> a) -> (Rep v -> Rep v ⊕ Rep w) -> Rep v -> a forall b c a. (b -> c) -> (a -> b) -> a -> c . Rep v -> Rep v ⊕ Rep w forall x y. x -> x ⊕ y Inj1)) ((Rep w -> a) -> w a forall a. (Rep w -> a) -> w a forall (f :: * -> *) a. Representable f => (Rep f -> a) -> f a tabulate (Rep (v ⊗ w) -> a (Rep v ⊕ Rep w) -> a f ((Rep v ⊕ Rep w) -> a) -> (Rep w -> Rep v ⊕ Rep w) -> Rep w -> a forall b c a. (b -> c) -> (a -> b) -> a -> c . Rep w -> Rep v ⊕ Rep w forall x y. y -> x ⊕ y Inj2)) instance Arbitrary1 Id where liftArbitrary :: forall a. Gen a -> Gen (Id a) liftArbitrary = (a -> Id a) -> Gen a -> Gen (Id a) forall a b. (a -> b) -> Gen a -> Gen b forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b fmap a -> Id a forall x. x -> Id x Id instance Arbitrary1 One where liftArbitrary :: forall a. Gen a -> Gen (One a) liftArbitrary Gen a _ = One a -> Gen (One a) forall a. a -> Gen a forall (f :: * -> *) a. Applicative f => a -> f a pure One a forall x. One x FunctorOne instance (Arbitrary1 f, Arbitrary1 g) => Arbitrary1 (f ⊗ g) where liftArbitrary :: forall a. Gen a -> Gen ((⊗) f g a) liftArbitrary Gen a g = f a -> g a -> (⊗) f g a forall (f :: * -> *) (g :: * -> *) x. f x -> g x -> (⊗) f g x FunctorProd (f a -> g a -> (⊗) f g a) -> Gen (f a) -> Gen (g a -> (⊗) f g a) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> Gen a -> Gen (f a) forall a. Gen a -> Gen (f a) forall (f :: * -> *) a. Arbitrary1 f => Gen a -> Gen (f a) liftArbitrary Gen a g Gen (g a -> (⊗) f g a) -> Gen (g a) -> Gen ((⊗) f g a) forall a b. Gen (a -> b) -> Gen a -> Gen b forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b <*> Gen a -> Gen (g a) forall a. Gen a -> Gen (g a) forall (f :: * -> *) a. Arbitrary1 f => Gen a -> Gen (f a) liftArbitrary Gen a g instance (Arbitrary1 f, Arbitrary1 g) => Arbitrary1 (f ∘ g) where liftArbitrary :: forall a. Gen a -> Gen ((∘) f g a) liftArbitrary Gen a g = f (g a) -> (∘) f g a forall {k} {k} (f :: k -> *) (g :: k -> k) (x :: k). f (g x) -> (∘) f g x Comp (f (g a) -> (∘) f g a) -> Gen (f (g a)) -> Gen ((∘) f g a) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> Gen (g a) -> Gen (f (g a)) forall a. Gen a -> Gen (f a) forall (f :: * -> *) a. Arbitrary1 f => Gen a -> Gen (f a) liftArbitrary (Gen a -> Gen (g a) forall a. Gen a -> Gen (g a) forall (f :: * -> *) a. Arbitrary1 f => Gen a -> Gen (f a) liftArbitrary Gen a g) instance Applicative Id where pure :: forall x. x -> Id x pure = a -> Id a forall x. x -> Id x Id Id a -> b f <*> :: forall a b. Id (a -> b) -> Id a -> Id b <*> Id a x = b -> Id b forall x. x -> Id x Id (a -> b f a x) instance Applicative One where pure :: forall a. a -> One a pure a _ = One a forall x. One x FunctorOne One (a -> b) _ <*> :: forall a b. One (a -> b) -> One a -> One b <*> One a _ = One b forall x. One x FunctorOne instance (Applicative f, Applicative g) => Applicative (f ∘ g) where Comp f (g (a -> b)) f <*> :: forall a b. (∘) f g (a -> b) -> (∘) f g a -> (∘) f g b <*> Comp f (g a) x = f (g b) -> (∘) f g b forall {k} {k} (f :: k -> *) (g :: k -> k) (x :: k). f (g x) -> (∘) f g x Comp (((g (a -> b) -> g a -> g b) -> f (g (a -> b)) -> f (g a -> g b) forall a b. (a -> b) -> f a -> f b forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b fmap g (a -> b) -> g a -> g b forall a b. g (a -> b) -> g a -> g b forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b (<*>) f (g (a -> b)) f) f (g a -> g b) -> f (g a) -> f (g b) forall a b. f (a -> b) -> f a -> f b forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b <*> f (g a) x) pure :: forall a. a -> (∘) f g a pure a x = f (g a) -> (∘) f g a forall {k} {k} (f :: k -> *) (g :: k -> k) (x :: k). f (g x) -> (∘) f g x Comp (g a -> f (g a) forall a. a -> f a forall (f :: * -> *) a. Applicative f => a -> f a pure (a -> g a forall a. a -> g a forall (f :: * -> *) a. Applicative f => a -> f a pure a x)) instance (Applicative f, Applicative g) => Applicative (f ⊗ g) where FunctorProd f (a -> b) f g (a -> b) g <*> :: forall a b. (⊗) f g (a -> b) -> (⊗) f g a -> (⊗) f g b <*> FunctorProd f a x g a y = f b -> g b -> (⊗) f g b forall (f :: * -> *) (g :: * -> *) x. f x -> g x -> (⊗) f g x FunctorProd (f (a -> b) f f (a -> b) -> f a -> f b forall a b. f (a -> b) -> f a -> f b forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b <*> f a x) (g (a -> b) g g (a -> b) -> g a -> g b forall a b. g (a -> b) -> g a -> g b forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b <*> g a y) pure :: forall a. a -> (⊗) f g a pure a x = f a -> g a -> (⊗) f g a forall (f :: * -> *) (g :: * -> *) x. f x -> g x -> (⊗) f g x FunctorProd (a -> f a forall a. a -> f a forall (f :: * -> *) a. Applicative f => a -> f a pure a x) (a -> g a forall a. a -> g a forall (f :: * -> *) a. Applicative f => a -> f a pure a x) instance (Applicative f) => Applicative (Dual f) where FunctorDual f (a -> b) f <*> :: forall a b. Dual f (a -> b) -> Dual f a -> Dual f b <*> FunctorDual f a x = f b -> Dual f b forall (f :: * -> *) x. f x -> Dual f x FunctorDual (f (a -> b) f f (a -> b) -> f a -> f b forall a b. f (a -> b) -> f a -> f b forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b <*> f a x) pure :: forall a. a -> Dual f a pure a x = f a -> Dual f a forall (f :: * -> *) x. f x -> Dual f x FunctorDual (a -> f a forall a. a -> f a forall (f :: * -> *) a. Applicative f => a -> f a pure a x)