Add `Co` constructor for turning products into sums and vice versa

[masaeedu]

Hi there. Not sure if I was looking carefully enough, but I wasn't able to find an equivalent for this type constructor that is sometimes useful:

newtype Flip t a b = Flip { unFlip :: t b a }

newtype Co b = Co { runCo :: forall r. b (Flip (->) r) -> r }

Given a sum type, like this:

data Something f = TheInt (f Int) | TheString (f String)

You get a record:

getTheInt :: Co Something -> Int
getTheInt (Co f) = f $ TheInt $ Flip id

getTheString :: Co Something -> String
getTheString (Co f) = f $ TheString $ Flip id

buildSomething :: (x -> Int) -> (x -> String) -> x -> Co Something
buildSomething f g x = Co $ \case
  TheInt (Flip fi) -> fi $ f x
  TheString (Flip fs) -> fs $ g x

And given a record type, like so:

data SomethingElse f = SomethingElse { theInt :: f Int, theString :: f String }

You get a sum:

buildAnInt :: Int -> Co SomethingElse
buildAnInt i = Co $ \SomethingElse { theInt } -> unFlip theInt i

buildAString :: String -> Co SomethingElse
buildAString s = Co $ \SomethingElse { theString } -> unFlip theString s

matchSomethingElse :: (Int -> r) -> (String -> r) -> Co SomethingElse -> r
matchSomethingElse f g (Co c) = c $ SomethingElse
  { theInt = Flip f
  , theString = Flip g
  }

Assuming the idea is clear enough, it's more aesthetically pleasing to "keep things closed" by parametrizing Co further, so that it produces something of the same kind as what it consumes.

type Co :: ((k -> *) -> *) -> (k -> *) -> *
newtype Co b f = Co { runCo :: forall r. b (Compose (Flip (->) r) f) -> r }

data Something f = TheInt (f Int) | TheString (f String)

getTheInt :: Co Something f -> f Int
getTheInt (Co f) = f $ TheInt $ Compose $ Flip id

getTheString :: Co Something f -> f String
getTheString (Co f) = f $ TheString $ Compose $ Flip id

buildSomething :: (x -> f Int) -> (x -> f String) -> x -> Co Something f
buildSomething f g x = Co $ \case
  TheInt (Compose (Flip fi)) -> fi $ f x
  TheString (Compose (Flip fs)) -> fs $ g x

data SomethingElse f = SomethingElse { theInt :: f Int, theString :: f String }

buildAnInt :: f Int -> Co SomethingElse f
buildAnInt i = Co $ \SomethingElse { theInt = Compose (Flip x) } -> x i

buildAString :: f String -> Co SomethingElse f
buildAString s = Co $ \SomethingElse { theString = Compose (Flip x) } -> x s

matchSomethingElse :: (f Int -> r) -> (f String -> r) -> Co SomethingElse f -> r
matchSomethingElse f g (Co c) = c $ SomethingElse
  { theInt = Compose $ Flip f
  , theString = Compose $ Flip g
  }

For any product/coproduct type (and I speculate generally for any limit/colimit type), this should form a nice involution:

fwd :: Co (Co Something) f -> Something f
fwd (Co c) = c $ Co $ \case
  TheInt (Compose (Flip fi)) -> fi $ Compose $ Flip TheInt
  TheString (Compose (Flip fs)) -> fs $ Compose $ Flip TheString

bwd :: Something f -> Co (Co Something) f
bwd = \case
  TheInt fi -> Co $ \(Co c) -> c $ TheInt $ Compose $ Flip $ \(Compose (Flip f)) -> f fi
  TheString fs -> Co $ \(Co c) -> c $ TheString $ Compose $ Flip $ \(Compose (Flip f)) -> f fs

We need some kind of typeclass to represent limits/colimits before we can write this more polymorphically, but I'm fairly confident that it works for all products/coproducts at least.

[masaeedu]

Happy to PR this if you think this makes sense and can tell me where I should put it.

[jcpetruzza]

Ok, I'm still digesting this! 😃 Let me see if I got it straight...

If we think of a datatype as built from sums and products, let's call the "dual" of a type T, Dual(T), the type obtained by flipping sums by products and vice-versa in T. For the first version of your Co wrapper, the claim is:

Co b ~ Dual(b Identity)

Let's consider the possible cases:

Case B f ~ f X:
  Co B
    ~ forall r. (X -> r) -> r   ("Yoneda Identity")
    ~ X  

Using algebraic identities plus r^r^a ~ a from the Yoneda lemma:

Case B f ~ f X + f Y:
  Co B
    ~ r^(r^X + r^Y)
    ~ r^r^X * r^r^Y
    ~ X * Y
  
Case B f ~ f X * f Y:
  Co B
    ~ r^(r^X * r^Y)
    ~ r^r^(X + Y)
    ~ X + Y

Now, for the second version of Co, what one would like is, I think:

Co b f ~ Dual(b f)

But for this, IIUC, we need to define it differently. We'd like to use Yoneda f in the base case above, so I think we need instead:

newtype Co b f = Co {runCo :: forall r. b (Flip (->) r) -> f r}  

Of course Co b is also a functor, etc.

instance FunctorB (Co b) where
  bmap h (Co f) = Co (h . f)

Does this make sense? I may have misunderstood the second version.

In any case, I found this transformation surprising, very cool! Do you have possible use cases in mind? I guess, one would then need a way to work generically with a type and it's dual, but I'm not sure what operations would be useful then. Maybe having a generic way to go from, say, a lens on a type to a prism on it's dual and vice-versa? Not sure...

[masaeedu]

Hello @jcpetruzza, thanks for looking into this. I'm not sure I follow the syntax you're using for your reasoning here:

Case B f ~ f X:
  Co B
    ~ forall r. (X -> r) -> r   ("Yoneda Identity")
    ~ X  

What does Case mean in this context, and what is B standing for?

[jcpetruzza]

Sorry this was a bit confusing. The full proof of the equivalence would be an induction on the structure of the type, here I'm just looking at the thee main cases. The first one would be the induction base, when B f is isomorphic to f X for some type X (this is what I meant with Case B f ~ f X); the next two cases are when B f is isomorphic to a sum or a prod. I didn't write these as inductive cases but the idea is the same (one just needs to apply the induction hypothesis)

[masaeedu]

Ah, nice, sorry for being dense. I still have to do some digesting of your comment to understand why Co b f should be the way you wrote instead of the original version, but it doesn't look like it'll resolve itself tonight.

An interesting perspective that occurred to me today while thinking about this is that an HKD is simply a continuation-monad-kinded type. The reason this jumped out at me is because the "base case" type constructor that you are working with is simply the return/pure operation of this monad.

Here's some of the equipment that obviously falls out of this perspective:

type HKD k = (k -> *) -> *

type BPure :: k -> HKD k
newtype BPure a cb = BPure { unBPure :: cb a }

type BJoin :: HKD (HKD k) -> HKD k
newtype BJoin kka cb = BJoin { unBJoin :: kka (BPure cb) }

type BFMap :: (a -> b) -> HKD a -> HKD b
newtype BFMap ab ka cb = BFMap { unBFMap :: ka (Compose cb ab) }

type BFFMap :: HKD a -> (a -> b) -> HKD b
newtype BFFMap ka ab cb = BFFMap { unBFFMap :: BFMap ab ka cb }

type BBind :: (a -> HKD b) -> HKD a -> HKD b
type BBind f k = BJoin (BFMap f k)

type BLift2 :: (a -> b -> c) -> HKD a -> HKD b -> HKD c
newtype BLift2 f kba kbb cb = BLift2 { unBLift2 :: BBind (BFFMap kbb) (BFMap f kba) cb }

type BProd :: HKD Type -> HKD Type -> HKD Type
type BProd = BLift2 (,)

type BSum :: HKD Type -> HKD Type -> HKD Type
type BSum = BLift2 Either

And here are some proofs of lawfulness:

data Iso p a b = Iso { fwd :: p a b, bwd :: p b a }

type FCoercible f = (forall a b. Coercible a b => Coercible (f a) (f b) :: Constraint)
type BCoercible k = (forall f g. (FCoercible f, FCoercible g) => Coercible (k f) (k g) :: Constraint)

coercible :: Coercible a b => Iso (->) a b
coercible = Iso { fwd = coerce, bwd = coerce }

--------------------------------------------------------------------------------

-- Left unit law
type LUnit1 :: HKD a -> HKD a
newtype LUnit1 k cb = LUnit1 { unLUnit1 :: BJoin (BPure k) cb }

type LUnit2 :: HKD a -> HKD a
newtype LUnit2 k cb = LUnit2 { unLUnit2 :: k cb }

lunit :: Iso (->) (LUnit1 k cb) (LUnit2 k cb)
lunit = coercible

--------------------------------------------------------------------------------

-- Right unit law
type RUnit1 :: HKD Type -> HKD Type
newtype RUnit1 k cb = RUnit1 { unRUnit1 :: BJoin (BFMap BPure k) cb }

type RUnit2 :: HKD Type -> HKD Type
newtype RUnit2 k cb = RUnit2 { unRUnit2 :: k cb }

runit :: (FCoercible cb, BCoercible k) => Iso (->) (RUnit1 k cb) (RUnit2 k cb)
runit = coercible

--------------------------------------------------------------------------------

-- Associativity law
type Assoc1 :: HKD (HKD (HKD a)) -> HKD a
newtype Assoc1 k cb = Assoc1 { unAssoc1 :: BJoin (BJoin k) cb }

type Assoc2 :: HKD (HKD (HKD a)) -> HKD a
newtype Assoc2 k cb = Assoc2 { unAssoc2 :: BJoin (BFMap BJoin k) cb }

assoc :: (FCoercible cb, BCoercible k) => Iso (->) (Assoc1 k cb) (Assoc2 k cb)
assoc = coercible

[masaeedu]

@jcpetruzza Sorry about the long delay getting back to you. So to pick a random place to resume this:

But for this, IIUC, we need to define it differently. We'd like to use Yoneda f in the base case above, so I think we need instead:

newtype Co b f = Co {runCo :: forall r. b (Flip (->) r) -> f r}

Of course Co b is also a functor, etc.

instance FunctorB (Co b) where
  bmap h (Co f) = Co (h . f)

So having thought about it a bit I'm not sure I agree that reformulation is what we'd want. But before I get into that, it's worth noting that the original formulation of Co b is also a (covariant) functor, although with all the flip-flopping it's a bit hard to see.

type K k = (k -> Type) -> Type

type Co :: K k -> K k
newtype Co b f = Co {runCo :: forall r. b (Compose (Flip (->) r) f) -> r}

instance FunctorB b => FunctorB (Co b) where
  bmap f (Co proj) = Co $ proj . bmap (\(Compose (Flip v)) -> Compose $ Flip $ v . f)

Now as far as which formulation to use, it helps to get a bit less abstract and think about finite products and coproducts of things as HKDs. We can write these roughly as follows:

-- A "heterogenization" of `Nat`
type HList :: [k] -> K k
data HList as f
  where
  HNil :: HList '[] f
  HCons :: f x -> HList xs f -> HList (x ': xs) f

-- A "heterogenization" of `Fin`
type HItem :: [k] -> K k
data HItem as f
  where
  HHere :: f x -> HItem (x ': xs) f
  HThere :: HItem xs f -> HItem (x ': xs) f

The question we'd like to answer is:

is there a type constructor Co :: K k -> K k, such that for all type level lists xs :: [k], Co (HItem xs) ~ HList xs and HItem xs ~ Co (HList xs)

It seems reasonable to say that up to isomorphism, there can at most one such Co type constructor. It also seems reasonable to say that the two flavors of Co we've come up with are not isomorphic to each other.

Now I haven't proved that the original Co solves the equations, but I can show that it's possible to write pairs of functions Co (HItem xs) <~> HList xs and HItem xs <~> Co (HList xs) that "roundtrip" satisfactorily on all the examples where I've tried them.

On the other hand, I've been stuck on the following implausible looking definition for the other version of Co:

newtype Co b f = Co {runCo :: forall r. b (Flip (->) r) -> f r}

fwd :: Co (HList '[]) f -> HItem '[] f
fwd (Co f) = _ $ f HNil

I'm now required to produce a (forall r. f r) -> HItem '[] f, with the understanding that HItem '[] f is essentially Void. But this formula is supposed to work for all f, and it clearly doesn't if you have for example (forall r. Maybe r) -> HItem '[] Maybe, since (forall r. Maybe r) is inhabited (by Nothing). In the other definition, you can simply use the forall r. r that you've recovered as the answer.

[MichaelXavier]

I was wondering if folks were still pursuing this feature. I've been using Barbies a lot to define flexible records that can hold things like raw values, mappings, etc. I've then collected these records into a sum so I can have a closed universe of such records. It would be extremely helpful to be able to turn that sum into a record that covers each case which I currently have to do manually. For example:

data A = A
  { a1 :: f Text,
    a2 :: f Bool
  }

data B = B
  { b1 :: f Int
  }

-- Hold a single instance of any of the known records
data MyRecs f = MyRecs_A (A f) | MyRecs_B (B f)

-- Hold something simultaneously for each type of record. Would be nice to derive that from MyRecs
data AllRecs f = AllRecs
  {
    allRecs_A :: A f,
    allRecs_B :: B f
  }

I was just wondering if this is something that this issue would allow for or if there's a different way to achieve what I'm after.

[masaeedu]

Hi @MichaelXavier. Yes. In fact you can take your pick of MyRecs and AllRecs and derive a type isomorphic to the other. In both cases the operation to apply is the same: Co.

[masaeedu]

Ah wait, it might not work for the nested records 🤔 .

[masaeedu]

The limitation as it's stated that it only works for types that are overall a pure product or coproduct.

But the types above have somewhat unexpected decompositions as co/products:

MyRecs := (Bool × Text) + Int =: (2 × T) + I
                              =   T + T  + I

So our dumb Co-nverter ends up producing:

Co MyRecs := NotAllRecs      :=   T × T  × I
                              =     T²   x I := (2 → T) × I =: (Bool → Text) × Int

Unfortunately this is:

                             != MyRecs       := (2 × T) + I =: (Bool × Text) + Int

And Co-nversely.

It's possible that there's no way to avoid this "piecewise" duality without switching to some kind of description of the datatype.

[MichaelXavier]

I appreciate you walking through that! Fair enough. I'll probably get fewer strange looks from coworkers if I just explicitly define the type. Thanks!