使用标准的haskell泛型库进行类型化同构

jbe*_*man 17 generics haskell ghc haskell-platform

有在短短的哈斯克尔平台单独(许多重叠的模块数泛型库syb,Data.Typeable,Data.Data,GHC.Generics),但我有一个非常基本的通用编程任务的麻烦.

我希望能够在相同形状的类型之间进行转换,即我想要在同构类型之间的多态,类型转换函数,本质上是本文末尾提供的(PDF),其中提到了索引类型族.

我并不关心废弃我的样板,而是能够围绕总和和产品抽象构建新的库.

下面的问题是GHC.Generic我认为最接近我需要的问题,但欢迎其他解决方案.


以下两种类型具有相同的形状

data Pair = Pair Char Int deriving (Generic, Show)
data Pair2 = Pair2 Char Int deriving (Generic, Show)
Run Code Online (Sandbox Code Playgroud)

我想使用GHC.Generics在它们之间转换值.由于所有幻像参数和其他废话,以下未能进行类型检查:

f :: Pair -> Pair2
f = to . from
Run Code Online (Sandbox Code Playgroud)

最终,我想要一个类似于fromInteger具有任何Generic(或任何其他类可支持此实例)实例的多态返回值的函数.我想我正在寻找类似的东西GHC.Generics:

--class:
type family NormalForm a
class ToGeneric a where
    to :: a -> NormalForm a
class FromGeneric b where
    from :: NormalForm b -> b

--examples:
data A = A Char Int deriving Show
data B = B Char Int deriving Show

type instance NormalForm A = (Char,Int)
instance ToGeneric A where
    to (A a b) = (a,b)
instance FromGeneric A where
    from (a,b) = A a b

type instance NormalForm B = (Char,Int)
instance ToGeneric B where
    to (B a b) = (a,b)
instance FromGeneric B where
    from (a,b) = B a b

-- the function I'm looking for
coerce :: (ToGeneric a, FromGeneric b, NormalForm a ~ NormalForm b)=> a -> b
coerce = from . to
Run Code Online (Sandbox Code Playgroud)

有了上述,我们可以做我想做的一切:

*Main> (coerce $A 'a' 1) :: B
B 'a' 1
*Main> (coerce $A 'a' 1) :: A
A 'a' 1
Run Code Online (Sandbox Code Playgroud)

编辑:f实际上,这就是Nathan Howell的功能如何在下面工作.

问题

  1. 这可能与目前在haskell平台上的库有关吗?

  2. 如果不是这样,可能一个库被定义为利用现有deriving的机制Generic,Data等等,而不诉诸TH?

Nat*_*ell 9

这是可能的,而且相对无痛.与unsafeCoerce直接使用不同,如果类型不对齐,您将获得构建中断.您可以依赖于等式约束f来提供足够的编译时类型安全性以unsafeCoerce避免与该Rep系列一起使用.

{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE TypeFamilies #-}

import GHC.Generics

data Pair1 = Pair1 Char Int deriving (Generic, Show)
data Pair2 = Pair2 Char Int deriving (Generic, Show)

data Triple1 = Triple1 Char Int Double deriving (Generic, Show)
data Triple2 = Triple2 Char Int Double deriving (Generic, Show)

f :: (Generic a, Generic c, Rep a ~ D1 da (C1 ca f), Rep c ~ D1 db (C1 cb f))
  => a -> c
f = to . M1 . M1 . unM1 . unM1 . from
-- this might also be acceptable:
-- f = unsafeCoerce

p1 :: Pair1 -> Pair2
p1 = f

p2 :: Pair2 -> Pair1
p2 = f

t1 :: Triple1 -> Triple2
t1 = f

t2 :: Triple2 -> Triple1
t2 = f
Run Code Online (Sandbox Code Playgroud)

运行它会产生预期的结果:

*Main> p1 $ Pair1 'x' 1
Pair2 'x' 1
*Main> p2 $ Pair2 'x' 1
Pair1 'x' 1
*Main> t1 $ Triple1 'y' 2 3.0
Triple2 'y' 2 3.0
*Main> t2 $ Triple2 'y' 2 3.0
Triple1 'y' 2 3.0
Run Code Online (Sandbox Code Playgroud)

  • 我认为重点是它应该适用于具有相同形状的任何一对类型`Pair`和`Pair2`; 否则你可能刚刚完成`f(Pair ab)= Pair2 ab`. (2认同)

max*_*kin 4

如果“形状相同”意味着数据类型等于构造函数名称、记录选择器和类型同义词,那么数据类型转换就像遍历表示一样简单。

{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE FlexibleContexts, FlexibleInstances #-}

import GHC.Generics

conv
  :: (Generic a, Generic b, Conv (Rep a) (Rep b))
  => a -> b
conv = to . cv . from

class Conv a b where
  cv :: a x -> b x

-- skip irrelevant parts: datatype name, constructor name, selector
instance Conv f1 f2 => Conv (M1 i1 c1 f1) (M1 i2 c2 f2) where
  cv = M1 . cv . unM1

instance (Conv a1 a2, Conv b1 b2) => Conv (a1 :*: b1) (a2 :*: b2) where
  cv ~(a :*: b) = cv a :*: cv b

instance (Conv a1 a2, Conv b1 b2) => Conv (a1 :+: b1) (a2 :+: b2) where
  cv (L1 a) = L1 $ cv a
  cv (R1 b) = R1 $ cv b

-- copy values
instance Conv U1 U1 where cv = id
instance Conv (K1 R c) (K1 R c) where cv = id
Run Code Online (Sandbox Code Playgroud)

测试用例:

data A = A1 String Int | A2 (Int,Int) deriving (Generic, Show)
data B = B1 [Char] Int | B2 { xy :: (Int,Int) } deriving (Generic, Show)
data X = X Int Int deriving (Generic, Show)

*Main> conv $ X 3 14 :: (Int,Int)
(3,14)
*Main> conv $ A1 "hello" 42 :: B
B1 "hello" 42
*Main> conv $ A2 (13,42) :: B
B2 {xy = (13,42)}
Run Code Online (Sandbox Code Playgroud)

更新

更多的实例允许更有趣的转换:

instance Conv U1 (M1 S s (K1 R ())) where
  cv _ = M1 $ K1 ()
-- *> conv (Nothing :: Maybe Int) :: Either () Int
-- Left ()

instance Conv (M1 S s (K1 R ())) U1 where
  cv _ = U1
-- *> conv (Left () :: Either () Int) :: Maybe Int
-- Nothing

-- this one requires OverlappingInstances
instance (Generic c1, Generic c2, Conv (Rep c1) (Rep c2))
  => Conv (K1 R c1) (K1 R c2)
  where
    cv (K1 x) = K1 $ conv x
 -- *> conv (Right Nothing :: Either () (Maybe Int)) :: Maybe (Either () Int)
 -- Just (Left ())

 -- data List a = Empty | Cons a (List a) deriving (Generic, Show)
 -- *> conv [1,2,3::Int] :: List Int
 -- Cons 1 (Cons 2 (Cons 3 Empty))
Run Code Online (Sandbox Code Playgroud)