Welcome to the Functional Programming Zulip Chat Archive. You can join the chat here. Is there any way to eliminate the duplication in definitions like this?

``````{-# LANGUAGE ImpredicativeTypes #-}
module Whatever where

import Data.Profunctor

newtype ForgetP p a b = ForgetP { runForgetP :: p a b }
deriving Profunctor

class (forall p. Profunctor p => thing (t p)) => Free thing t
where
fwd :: (Profunctor p, thing q) => (p :-> ForgetP q) -> t p :-> q
bwd :: (Profunctor p, thing q) => (t p :-> q) -> p :-> ForgetP q

data TheFree thing p a b = TheFree { runFree :: forall q. (Profunctor q, thing q) => (p :-> ForgetP q) -> q a b }

instance Profunctor p => Profunctor (TheFree thing p)
where
dimap f g (TheFree x) = TheFree \$ \cb -> dimap f g \$ x cb

instance Profunctor p => Strong (TheFree Strong p)
where
first' (TheFree p) = TheFree \$ \cb -> first' \$ p cb

instance Free Strong (TheFree Strong)
where
fwd cb (TheFree p) = p cb
bwd cb p = ForgetP \$ cb \$ TheFree \$ runForgetP . (\$ p)

instance Profunctor p => Costrong (TheFree Costrong p)
where
unfirst (TheFree p) = TheFree \$ \cb -> unfirst \$ p cb

instance Free Costrong (TheFree Costrong)
where
fwd cb (TheFree p) = p cb
bwd cb p = ForgetP \$ cb \$ TheFree \$ runForgetP . (\$ p)

instance Profunctor p => Choice (TheFree Choice p)
where
left' (TheFree p) = TheFree \$ \cb -> left' \$ p cb

instance Free Choice (TheFree Choice)
where
fwd cb (TheFree p) = p cb
bwd cb p = ForgetP \$ cb \$ TheFree \$ runForgetP . (\$ p)

instance Profunctor p => Cochoice (TheFree Cochoice p)
where
unleft (TheFree p) = TheFree \$ \cb -> unleft \$ p cb

instance Free Cochoice (TheFree Cochoice)
where
fwd cb (TheFree p) = p cb
bwd cb p = ForgetP \$ cb \$ TheFree \$ runForgetP . (\$ p)

-- ...
``````