I have the category definition:
-- | Cat is the definition of a morphism
type Cat i = i -> i -> Type
-- | Vacuous Constraint
class Vacuous (p :: Cat i) (a :: i)
instance Vacuous p a
class Category (h :: Cat i) where
type Ob h :: i -> Constraint
type Ob h = Vacuous h
id :: Ob h a => h a a
(.) :: h b c -> h a b -> h a c
and I am trying to implement identity and associativity laws for it in QuickCheck, e.g.,
-- | Constraints
type Constraints h a b =
(
Category h, Ob h a,
Arbitrary (h a b), Eq (h a b), Show (h a b)
)
-- | Properties
prop_left_identity :: forall h a b. Constraints h a b => Property
prop_left_identity = property $ \(f:: h a b) -> f. id == f
Issue here is in Eq (h a b), if for instance h = (->), then I will have trouble defining Eq (a -> b) because function equality is not straightforward (I will have issue with unbounded types, and in case of bounded go through all possible inputs and I don't want that). So, I tried avoiding the point free notation and applying f to a, so I can only focus on Eq (b), but I don't have any means to do it. I need a function ap :: h a b -> a -> b but compiler gives an error because b is not of kind Type.
Any ideas about this please 🙏🏻
Related
Prism is like Iso except one of the two conversions is partial. Is there an optic where both conversions are partial?
Of course one can create a type (s -> Maybe a, b -> Maybe t) but I'm wondering if such a thing could be expressed an as Optic _ _?
You can generalize Isos (i.e., (s -> a, b -> t)) into (s -> m a, b -> m t) by replacing profunctors over Hask (i.e., Profunctor, that's the constraint in the definition of Iso as an Optic) with profunctors over Kleisli categories (here for the Maybe monad).
class Monad m => KProfunctor m p where
dimapM :: (s -> m a) -> (b -> m t) -> p a b -> p s t
-- dimapM pure pure = id
-- dimapM f g . dimapM h i = dimapM (h >=> f) (g >=> i)
type Optic p s t a b = p a b -> p s t
type KIso m s t a b = forall p. KProfunctor m p => Optic p s t a b
To construct one example of such profunctor, take the type of pseudo-isos (s -> m a, b -> m t) that we are trying to work with in the first place, and put s and t as the main indices:
data PseudoIso m a b s t = MkPseudoIso
{ toM :: s -> m a
, fromM :: b -> m t
}
instance Monad m => KProfunctor m (PseudoIso m) where
-- exercise for the reader
To go from PseudoIso to KIso, use dimapM (the fields of PseudoIso are exactly the right type for the arguments of dimapM)
To go from KIso to PseudoIso, partially apply to the identity PseudoIso a b a b
Actually, it doesn't have to be a Kleisli category. A profunctor over any category (:->) :: k -> k -> Type will give you a class of optics of the form (s :-> a, b :-> t).
Note: you can define an instance of Choice with KProfunctor Maybe, so maybe everything should really be specialized to Maybe so Choice could reasonably be added as a superclass of KProfunctor, then KIso would be a subtype of Prism.
Let us look at profunctor encoding. It's simpler.
Choice is a class for Prisms, we are making subclass of Prisms, so Choice is natural choice for a superclass:
class Choice p => Weird p where
weird :: (s -> Maybe a) -> (b -> Maybe t) -> p a b -> p s t
If we try to write an instance for p = (->), it won't work.
So our new kind of optics is not a superclass of Setter.
The hierarchy would probably look something like: at best probably something like
(Can a Traversal and thus Lens be turned into the new Weird optic, maybe?)
Lens
/ \
Iso Traversal -> Setter
\ /
Prism
\
Weird
Let's try with another concrete Profunctors.
I'll use types as defined in my blog post: Glassery
ForgetM is used to implement preview
type Optic' p s a = p a a -> p s s
preview :: Optic' (ForgetM a) s a -> s -> Maybe a
preview o = runForgetM (o (ForgetM Just))
newtype ForgetM r a b = ForgetM { runForgetM :: a -> Maybe r }
instance Profunctor (ForgetM r) where
dimap f _ (ForgetM p) = ForgetM (p . f)
instance Choice (ForgetM r) where
right' (ForgetM p) = ForgetM (either (const Nothing) p)
instance Weird (ForgetM r) where
weird sa _bt (ForgetM ab) = ForgetM $ \s -> sa s >>= ab
TaggedM can be used to define something in oppisite direction (not in Glassery):
repreview :: Optic' TaggedM s a -> a -> Maybe s
repreview o a = unTaggedM (o (TaggedM (Just a)))
newtype TaggedM a b = TaggedM { unTaggedM :: Maybe b }
instance Profunctor TaggedM where
dimap _sa bt (TaggedM b) = TaggedM (fmap bt b)
instance Choice TaggedM where
right' (TaggedM b) = TaggedM (fmap Right b)
instance Weird TaggedM where
weird _sa bt (TaggedM b) = TaggedM (b >>= bt)
We can now try this.
Simple case works:
*Main> preview (weird Just Just) 'x'
Just 'x'
*Main> repreview (weird Just Just) 'x'
Just 'x'
Prisms can be used as new thing (thing right' = _Right):
*Main> preview right' (Left 'x')
Nothing
*Main> preview right' (Right 'x')
Just 'x'
There's also a nice symmetric Profunctor:
newtype Re p s t a b = Re { runRe :: p b a -> p t s }
instance Profunctor p => Profunctor (Re p s t) where
dimap f g (Re p) = Re (p . dimap g f)
instance Cochoice p => Choice (Re p s t) where
right' (Re p) = Re (p . unright)
instance Choice p => Cochoice (Re p s t) where
unright (Re p) = Re (p . right')
and we can write Weird instance for it:
instance Weird p => Weird (Re p s t) where
weird sa bt (Re p) = Re (p . weird bt sa)
And we notice that, we need to add Cochoice to be the superclass of Weird:
class (Choice p, Cochoice p) => Weird p where
weird :: (s -> Maybe a) -> (b -> Maybe t) -> p a b -> p s t
That starts to look promising.
van-Laarhoven. That's tricky.
Compare Prism in profunctor and VL encodings:
type PrismVL s t a b = forall f p. (Choice p, Applicative f) => p a (f b) -> p s (f t)
type PrismP s t a b = forall p. (Choice p) => p a b -> p s t
The good start is to assume that this Weird thing would look like
type WeirdOptic s t a b = forall p f. (Weird p, Applicative f) => Optic p f s t a b
Maybe we would need to strengten the f constraint too, a bit.
But I leave something for you to experiment with.
Also an open question is what's the intuition behind this new Weird optic;
and what laws it should have (to be an optic, and not just two functions
smashed together). It feels than trying to do similar Monad / Kleisli optic
with anything fancier than Maybe is difficult, but maybe it would work out too.
Here's a solution in lens-style optics (rather than profunctor optics as in the other answers) using the Filterable type-class:
-- A partial variant of (#) for partial reviews
infixr 8 #?
(#?) :: Optic Tagged Maybe s t a b -> b -> Maybe t
f #? b = Just b & Tagged & f & unTagged
-- A Prism "turned around", i.e a getter but a partial review
type InvPrism s t a b =
forall p f. (Profunctor p, Filterable f) => Optic p f s t a b
-- A partial iso-morphism, i.e a partial getter and partial review
type PartialIso s t a b =
forall p f. (Choice p, Applicative f, Filterable f) => Optic p f s t a b
-- Turn APrism around
invPrism :: APrism b a t s -> InvPrism s t a b
invPrism p =
dimap
(review (reviewing (clonePrism p)))
(mapMaybe (^? getting (clonePrism p)))
-- Create a PartialIso from two partial conversions
partialIso :: (s -> Maybe a) -> (b -> Maybe t) -> PartialIso s t a b
partialIso sma ams =
dimap
(maybe (Left ()) Right . sma)
(catMaybes . either (const (pure Nothing)) (fmap ams)) .
right'
-- Coerce APrism to an Optic'
reviewing ::
(Choice p, Bifunctor p, Functor f, Settable f) =>
APrism s t a b -> Optic' p f t b
reviewing p =
bimap f (fmap f)
where
f = runIdentity . unTagged . clonePrism p . Tagged . Identity
The below defined function mapRightR change only the map's set contents, not the keys and produce a valid Relation type.
Is it really impossible use this high-level function to define the Functor Relation instance, or is my implementation wrong.
{-# LANGUAGE GADTs #-}
import Data.Map as M
import Data.Set as S
data Relation a b where
R :: (Ord a, Ord b) => Map a (Set b) -> Relation a b
instance Functor Relation where
fmap f r = mapRightR f r
mapRightR :: Ord b1 => (b2 -> b1) -> Relation a b2 -> Relation a b1
mapRightR f (R r) = R $ M.map (S.map f) r
Thanks, chepner.
I tried another definition of Relation, using List instead of Set and it work!
data Relation a b where
R :: (Ord a) => Map a [b] -> Relation a b
instance Functor (Relation a) where
fmap f r = mapRightR f r
mapRightR :: (b2 -> b1) -> Relation a b2 -> Relation a b1
mapRightR f (R r) = R $ M.map (L.map f) r
mapRightR is constrained, it will not work for any type b as fmap requires:
-- Specialized for f ~ Relation c
fmap :: (a -> b) -> Relation c a -> Relation c b
but
mapRightR :: Ord b => (a -> b) -> Relation c a -> Relation c b
In more categorical terms, Relation c is not an endofunctor that maps Hask to Hask (which is what the Functor typeclass represents), but rather a functor that maps a subcategory of Hask consisting only of types with Ord instances to Hask. (I think I characterized this correctly; corrections welcome.)
I tried to write the following code:
{-# LANGUAGE GADTs #-}
module V where
data V a where
V :: (c -> a) -> V a
down :: V (V a) -> V a
down (V f) = V $ \(c,d) -> case f c of
V f' -> f' d
Then GHC answered type variable `c' would escape its scope.
I understand why it doesn't compile: it uses hidden type of existential out of case.
But actually the type is still hidden by V. so essentially function down has no problem I think.
Is there a way to write a compilable down function?
Here's the fundamental problem: f can have a peek at c and use the value of c to determine which type to hide in its existential. For example:
v :: V (V Int)
v = V $ \p -> case p of
False -> V (id :: Int -> Int)
True -> V (fromEnum :: Char -> Int)
So d would need to be both a valid Int and a valid Char if we called down v! To be able to feed an existential that can be so variable, you'll need to ensure that its argument can take on all the types it may demand.
newtype Forall = Forall (forall a. a)
down :: V (V a) -> V a
down (V f) = V $ \(c, d_) -> case f c of
V f' -> case d_ of
Forall d -> f' d
In Haskell, I can't find a simple way to make your code work.
I find it interesting though, that your idea does work in a language with full dependent types like Coq (and likely Agda, Idris, etc.).
The main crux, as Daniel Wagner points out, is that the type resulting from f can depend on the value of c, so the pair (c,d) in the original code should be a dependent pair.
For what it is worth, here's how we can do it in Coq.
Note that this does not involve an uninhabited type like forall a. a.
(* An existential type, under an impredicative encoding *)
Inductive V (A: Type): Type :=
Vk : forall (B: Type), (B -> A) -> V A
.
(* The usual "identity to equivalence" *)
Definition subst {A B: Type} (p: A = B) (x: A): B :=
match p with
| eq_refl => x
end .
(* The main function.
Essentially, we want to turn
Vk B (fun b => Vk C g)
into
Vk (B*C) (fun (b,c) => g c)
but both C and g can depend on (b:B), so (B*C)
should be a Sigma type {b:B & ty b}.
*)
Definition down (A: Type) (x: V (V A)): V A :=
match x with
| Vk B f => let
ty (z: V A): Type := match z with | Vk C g => C end
in Vk A {b:B & ty (f b)} (fun w =>
match w with
| existT b y =>
match f b as o return ty (f b) = ty o-> A with
| Vk C g => fun (h: ty (f b) = C) =>
g (subst h y)
end eq_refl
end )
end .
Thanks for another great answer, chi!
I rewrote the code for Agda and actually it does compile. As an additional note for the above answer, I place my code here.
module down where
open import Level
open import Data.Product
data V {ℓ} (A : Set ℓ) : Set (suc ℓ) where
Vk : {B : Set} → (B → A) → V A
down : ∀ {ℓ} {A : Set ℓ} → V (V A) → V A
down {ℓ} {A} (Vk {B} f) = Vk go where
ty : V A → Set
ty (Vk {C} _) = C
go : Σ B (λ b → ty (f b)) → A
go (b , c) with f b
go (b , c) | Vk {C} g = g c
Recently I've finally started to feel like I understand catamorphisms. I wrote some about them in a recent answer, but briefly I would say a catamorphism for a type abstracts over the process of recursively traversing a value of that type, with the pattern matches on that type reified into one function for each constructor the type has. While I would welcome any corrections on this point or on the longer version in the answer of mine linked above, I think I have this more or less down and that is not the subject of this question, just some background.
Once I realized that the functions you pass to a catamorphism correspond exactly to the type's constructors, and the arguments of those functions likewise correspond to the types of those constructors' fields, it all suddenly feels quite mechanical and I don't see where there is any wiggle room for alternate implementations.
For example, I just made up this silly type, with no real concept of what its structure "means", and derived a catamorphism for it. I don't see any other way I could define a general-purpose fold over this type:
data X a b f = A Int b
| B
| C (f a) (X a b f)
| D a
xCata :: (Int -> b -> r)
-> r
-> (f a -> r -> r)
-> (a -> r)
-> X a b f
-> r
xCata a b c d v = case v of
A i x -> a i x
B -> b
C f x -> c f (xCata a b c d x)
D x -> d x
My question is, does every type have a unique catamorphism (up to argument reordering)? Or are there counterexamples: types for which no catamorphism can be defined, or types for which two distinct but equally reasonable catamorphisms exist? If there are no counterexamples (i.e., the catamorphism for a type is unique and trivially derivable), is it possible to get GHC to derive some sort of typeclass for me that does this drudgework automatically?
The catamorphism associated to a recursive type can be derived mechanically.
Suppose you have a recursively defined type, having multiple constructors, each one with its own arity. I'll borrow OP's example.
data X a b f = A Int b
| B
| C (f a) (X a b f)
| D a
Then, we can rewrite the same type by forcing each arity to be one, uncurrying everything. Arity zero (B) becomes one if we add a unit type ().
data X a b f = A (Int, b)
| B ()
| C (f a, X a b f)
| D a
Then, we can reduce the number of constructors to one, exploiting Either instead of multiple constructors. Below, we just write infix + instead of Either for brevity.
data X a b f = X ((Int, b) + () + (f a, X a b f) + a)
At the term-level, we know we can rewrite any recursive definition
as the form x = f x where f w = ..., writing an explicit fixed point equation x = f x. At the type-level, we can use the same method
to refector recursive types.
data X a b f = X (F (X a b f)) -- fixed point equation
data F a b f w = F ((Int, b) + () + (f a, w) + a)
Now, we note that we can autoderive a functor instance.
deriving instance Functor (F a b f)
This is possible because in the original type each recursive reference only occurred in positive position. If this does not hold, making F a b f not a functor, then we can't have a catamorphism.
Finally, we can write the type of cata as follows:
cata :: (F a b f w -> w) -> X a b f -> w
Is this the OP's xCata type? It is. We only have to apply a few type isomorphisms. We use the following algebraic laws:
1) (a,b) -> c ~= a -> b -> c (currying)
2) (a+b) -> c ~= (a -> c, b -> c)
3) () -> c ~= c
By the way, it's easy to remember these isomorphisms if we write (a,b) as a product a*b, unit () as1, and a->b as a power b^a. Indeed they become
c^(a*b) = (c^a)^b
c^(a+b) = c^a*c^b
c^1 = c
Anyway, let's start to rewrite the F a b f w -> w part, only
F a b f w -> w
=~ (def F)
((Int, b) + () + (f a, w) + a) -> w
=~ (2)
((Int, b) -> w, () -> w, (f a, w) -> w, a -> w)
=~ (3)
((Int, b) -> w, w, (f a, w) -> w, a -> w)
=~ (1)
(Int -> b -> w, w, f a -> w -> w, a -> w)
Let's consider the full type now:
cata :: (F a b f w -> w) -> X a b f -> w
~= (above)
(Int -> b -> w, w, f a -> w -> w, a -> w) -> X a b f -> w
~= (1)
(Int -> b -> w)
-> w
-> (f a -> w -> w)
-> (a -> w)
-> X a b f
-> w
Which is indeed (renaming w=r) the wanted type
xCata :: (Int -> b -> r)
-> r
-> (f a -> r -> r)
-> (a -> r)
-> X a b f
-> r
The "standard" implementation of cata is
cata g = wrap . fmap (cata g) . unwrap
where unwrap (X y) = y
wrap y = X y
It takes some effort to understand due to its generality, but this is indeed the intended one.
About automation: yes, this can be automatized, at least in part.
There is the package recursion-schemes on hackage which allows
one to write something like
type X a b f = Fix (F a f b)
data F a b f w = ... -- you can use the actual constructors here
deriving Functor
-- use cata here
Example:
import Data.Functor.Foldable hiding (Nil, Cons)
data ListF a k = NilF | ConsF a k deriving Functor
type List a = Fix (ListF a)
-- helper patterns, so that we can avoid to match the Fix
-- newtype constructor explicitly
pattern Nil = Fix NilF
pattern Cons a as = Fix (ConsF a as)
-- normal recursion
sumList1 :: Num a => List a -> a
sumList1 Nil = 0
sumList1 (Cons a as) = a + sumList1 as
-- with cata
sumList2 :: forall a. Num a => List a -> a
sumList2 = cata h
where
h :: ListF a a -> a
h NilF = 0
h (ConsF a s) = a + s
-- with LambdaCase
sumList3 :: Num a => List a -> a
sumList3 = cata $ \case
NilF -> 0
ConsF a s -> a + s
A catamorphism (if it exists) is unique by definition. In category theory a catamorphism denotes the unique homomorphism from an initial algebra into some other algebra. To the best of my knowledge in Haskell all catamorphisms exists because Haskell's types form a Cartesian Closed Category where terminal objects, all products, sums and exponentials exist. See also Bartosz Milewski's blog post about F-algebras, which gives a good introduction to the topic.
I have the following definitions for a monoidal category class (Similar to the standard library, but providing inverses of the necessary natural isomorphisms):
class (Category r, Category s, Category t) => Bifunctor p r s t | p r -> s t, p s -> r t, p t -> r s where
bimap :: r a b -> s c d -> t (p a c) (p b d)
--
class (Bifunctor b k k k) => Associative k b where
associate :: k (b (b x y) z) (b x (b y z))
associateInv :: k (b x (b y z)) (b (b x y) z)
--
class (Bifunctor b k k k) => HasIdentity k b i | k b -> i
class (Associative k b, HasIdentity k b i) => Monoidal k b i | k b -> i where
idl :: k (b i a) a
idr :: k (b a i) a
idlInv :: k a (b i a)
idrInv :: k a (b a i)
--
The problem with composing morphisms in a monoidal category using (.) is that the objects may be associated differently. For instance Monoidal Hask (,) (), we might want to compose a morphism of type x -> ((a, b), c) with a morphism of type ((a, ()), (b, c)) -> y. To make the types fit, the natural isomorphism given by bimap idrInv id . associate has to be applied.
Does the Haskell type system enable an automatic way of determining an appropriate isomorphism, based on the desired domain and and codomain type? I can't figure out how to do it.
I figured it out, sort of. The basic idea is to use a multi-parameter type class with a normalizing function and its inverse as methods. The normalizer associates everything to the right, recursively. The type class needs an instance for each case of the recursion. Then, to convert from one way to associate stuff to another, just compose the normalizer for the type of the first morphism and the inverse normalizer for the type of the second morphism.
I will link code here as soon as I will have published it.