Question

我有一些代码，我需要一个类型级函数，它接受两个键值对的列表，这些键值对按键排序，每个键只有一次，然后将它们合并为一个这样的列表（首选列表如果是密钥存在于两个列表中。）

经过大量的反复试验后，我终于成功完成了以下工作：

{-# LANGUAGE DataKinds, KindSignatures, PolyKinds, TypeFamilies, TypeOperators, UndecidableInstances #-}

import Data.Proxy
import GHC.TypeLits

data KVPair s a = Pair s a

type family Merge (as :: [KVPair Symbol *]) (bs :: [KVPair Symbol *]) :: [KVPair Symbol *] where
  Merge '[] bs = bs
  Merge as '[] = as
  Merge ((Pair k1 a) : as) ((Pair k2 b) : bs) = Merge' (CmpSymbol k1 k2) ((Pair k1 a) : as) ((Pair k2 b) : bs)

type family Merge' (ord :: Ordering) (as :: [k]) (bs :: [k]) :: [k] where
  Merge' LT (a : as) (b : bs) = a : Merge as (b : bs)
  Merge' EQ (a : as) (b : bs) = a : Merge as bs
  Merge' GT (a : as) (b : bs) = b : Merge (a : as) bs

test :: Proxy (Merge [Pair "A" Int, Pair "Hello" (Maybe Char), Pair "Z" Bool] [Pair "Hello" String, Pair "F" ()])
test = Proxy

当在GHCi中询问test的类型时，你会得到预期的结果：

*Main> :t test
test
  :: Proxy
       '['Pair "A" Int, 'Pair "Hello" (Maybe Char), 'Pair "F" (),
         'Pair "Z" Bool]

这使用了两个类型系列，因此第二个类型实际上可以对键的顺序进行模式匹配，但这看起来要比它应该复杂得多。有没有办法让一个类型的家庭获得类似的情况呢？

Answer 1

当然，这里是一个单一类型的家庭Merge'和类型同义词Merge：

{-# LANGUAGE DataKinds #-}
{-# LANGUAGE KindSignatures #-}
{-# LANGUAGE PolyKinds #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE UndecidableInstances #-}
module Merge where

import Data.Proxy
import GHC.TypeLits

type family Merge' (mord :: Maybe Ordering) (as :: [(Symbol,*)]) (bs :: [(Symbol,*)]) :: [(Symbol,*)] where
  Merge' 'Nothing '[] bs = bs
  Merge' 'Nothing as '[] = as
  Merge' 'Nothing (('(k1, a)) : at) (('(k2, b)) : bt) = Merge' ('Just (CmpSymbol k1 k2)) (('(k1, a)) : at) (('(k2, b)) : bt)

  Merge' ('Just 'LT) (a : as) (b : bs) = a : Merge' 'Nothing as (b : bs)
  Merge' ('Just 'EQ) (a : as) (b : bs) = a : Merge' 'Nothing as bs
  Merge' ('Just 'GT) (a : as) (b : bs) = b : Merge' 'Nothing (a : as) bs

type Merge as bs = Merge' 'Nothing as bs

test :: Proxy (Merge ['("A", Int), '("Hello", Maybe Char), '("Z", Bool)] ['("Hello", String), '("F", ())])
test = Proxy

Answer 2

我想这可能不是您想要的，但您可以使用singletons包中的Data.Promotion.TH将功能提升为封闭类型系列。编写这种类型的函数非常方便。

{-# LANGUAGE DataKinds, FlexibleContexts, GADTs, PolyKinds, ScopedTypeVariables,
             TemplateHaskell, TypeFamilies, UndecidableInstances #-}

import Data.Proxy
import Data.Promotion.TH
import Data.Singletons.Prelude

promote [d|
    data KVPair k v = Pair k v

    merge :: Ord k => [KVPair k a] -> [KVPair k a] -> [KVPair k a]
    merge [] bs = bs
    merge as [] = as
    merge as@((Pair ka va):ass) bs@((Pair kb vb):bss) =
        case compare ka kb of
            LT -> (Pair ka va):merge ass bs
            EQ -> (Pair ka va):merge ass bss
            GT -> (Pair kb vb):merge as bss
  |]

test :: Proxy (Merge [Pair "A" Int, Pair "Hello" (Maybe Char), Pair "Z" Bool] [Pair "Hello" String, Pair "F" ()])
test = Proxy

如何简化这种比较符号的类型级函数？

2 个答案: