How can I write function to convert generic type to Tag-shaped type for use with DSum?

问题

How can I implement this toDSum function? I've managed to get the base case to compile, but I don't know how to carry all the type information across a recursive call. Do I have to strip off the Code from the type before trying to recurse?

(this is a followup to How can I write this GEq instance?)

{-# LANGUAGE GADTs #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE KindSignatures #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}

module Foo where

import Data.Dependent.Sum
import Data.GADT.Compare
import Data.Proxy
import Generics.SOP
import qualified GHC.Generics as GHC

type GTag t = GTag_ (Code t)
newtype GTag_ t (as :: [*]) = GTag (NS ((:~:) as) t)

instance GEq (GTag_ t) where
  geq (GTag (Z Refl)) (GTag (Z Refl)) = Just Refl
  geq (GTag (S x))    (GTag (S y))    = GTag x `geq` GTag y
  geq _               _               = Nothing

toDSum :: forall t . Generic t => t -> DSum (GTag t) (NP I)
toDSum = foo . unSOP . from
  where
    foo :: ()
        => NS (NP I) (Code t)
        -> DSum (GTag t) (NP I)
    foo = bar (Proxy :: Proxy t)

    bar :: forall t1 . ()
        => Proxy t1 -> NS (NP I) (Code t1)
        -> DSum (GTag t1) (NP I)
    bar _ (Z x) = GTag (Z Refl) :=> x
    bar _ (S x) = undefined

回答1:

A version of this code was in my other answer, but the types are slightly different, which actually simplifies the code.

As you have seen with instance GEq (GTag_ t), when you want to write inductive functions on NS or NP, you need to keep the index parametric - you will see this general pattern quite a bit with 'dependant' programming (both real dependant programming and faking it in Haskell).

This is precisely the issue with bar:

forall t1 . () => Proxy t1 -> NS (NP I) (Code t1) -> DSum (GTag t1) (NP I)
                                        ^^^^^^^^^

There is no way for such a function to be recursive - simply because if S rep :: NS (NP I) (Code t1), then it is not necessarily the case (indeed, it is never the case here) that rep :: NS (NP I) (Code t2) for some t2 - and even if this fact were true, you would struggle to convince the compiler of it.

You must make this function (renaming to toTagValG) parametric in the index:

type GTagVal_ t = DSum (GTag_ t) (NP I)
type GTagVal t = DSum (GTag t) (NP I)

toTagValG :: NS f xss -> DSum (GTag_ xss) f 
toTagValG (Z rep) = GTag (Z Refl) :=> rep 
toTagValG (S rep) = case toTagValG rep of GTag tg :=> args -> GTag (S tg) :=> args

Then xss is instantiated with Code t when you use to or from, since from :: a -> Rep a and Rep a = SOP I (Code a):

toTagVal :: Generic a => a -> GTagVal a
toTagVal = toTagValG . unSOP . from

Note this type is inferred (if you turn off the MonomorphismRestriction)

The other direction is even simpler:

fromTagVal :: Generic a => GTagVal a -> a 
fromTagVal = to . SOP . (\(GTag tg :=> args) -> hmap (\Refl -> args) tg)

Although you can write the function in the lambda with induction as well:

fromTagValG :: DSum (GTag_ xss) f -> NS f xss 
fromTagValG (GTag (Z Refl) :=> rep) = Z rep 
fromTagValG (GTag (S tg) :=> args) = S $ fromTagValG $ GTag tg :=> args

Note that you can assign a very general type to this function, and toTagValG - indeed, it does not mention NP I at all. You should also be able to convince yourself that these functions are each others inverses, and so witness an isomorphism between NS f xss and DSum (GTag_ xss) f.

回答2:

although this is already answered, I'll add my own anyway since I spent several hours working it out.

short and sweet

toDSum :: Generic t => t -> DSum (GTag t) (NP I)
toDSum = foo (\f b -> GTag f :=> b) . unSOP . from
  where
    foo :: (forall a . (NS ((:~:) a) xs) -> NP I a -> r)
        -> NS (NP I) xs
        -> r
    foo k (Z x) =     (k . Z) Refl x
    foo k (S w) = foo (k . S)      w

来源：https://stackoverflow.com/questions/40710801/how-can-i-write-function-to-convert-generic-type-to-tag-shaped-type-for-use-with

标签

haskell

generic-programming