如何编写将DSType泛型转换为Tag形的函数？

Question

如何实现此toDSum函数？ 我设法使基本情况得以编译，但是我不知道如何在递归调用中传递所有类型信息。 在尝试递归之前，我是否必须从类型中剥离Code ？

（这是如何编写此GEq实例的后续文章。 ）

{-# 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

Answer 1

我的另一个答案是该代码的一个版本，但是类型略有不同，这实际上简化了代码。

正如您在instance GEq (GTag_ t)看到的instance GEq (GTag_ t) ，当您想在NS或NP上编写归纳函数时，需要保持索引参数化-您将在“依赖”编程中看到这种通用模式（都是真实依赖）在Haskell中进行编程和伪造）。

这正是bar的问题：

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

没有办法，这样的功能是递归的-仅仅是因为如果S rep :: NS (NP I) (Code t1)那么它是没有必要的情况下（事实上，这是从来没有这里的情况），其rep :: NS (NP I) (Code t2)大约t2即使这个事实是正确的，您也很难说服编译器。

您必须在索引中将此函数（重命名为toTagValG ）参数化：

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

然后，当您使用to或from时，使用Code t实例化xss ，因为from :: a -> Rep a和Rep a = SOP I (Code a) ：

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

请注意，此类型是推断的（如果您关闭了MonomorphismRestriction）

另一个方向更简单：

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

尽管您也可以使用归纳法在lambda中编写函数：

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 

请注意，您可以非常一般类型分配给该功能，并toTagValG -事实上，它并没有提到NP I的。 您还应该能够使自己确信这些函数是彼此相反的，因此可以见证NS f xss和DSum (GTag_ xss) f之间的同构。

Answer 2

尽管已经回答了这个问题，但是由于我花了几个小时来解决这个问题，所以我还是要添加自己的答案。

简短而甜美

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