haskell - 如何在镜头样式单板库中为更高种类的类型实现孔和上下文？

Question

András Kovács 提出了这个问题 in response to an answer to a previous question.

在用于各种类型的镜头式单板库中 * -> *基于类

class Uniplate1 f where
    uniplate1 :: Applicative m => f a -> (forall b. f b -> m (f b)) -> m (f a)

类似于 kind * 类型的类

class Uniplate on where
    uniplate :: Applicative m => on -> (on -> m on) -> m on

是否可以实现 contexts 的类似物？和 holes , 两者的类型都是 Uniplate on => on -> [(on, on -> on)]无需 Typeable1 ?

很明显，这可以在使用 Str 的老式单板库中实现。通过返回具有子项类型的类型级列表的结构来表示数据的结构。

孔可以用以下数据类型表示，它将替换 (on, on -> on)在 contexts 的签名中和 holes

data Hole f a where
    Hole :: f b -> (f b -> f a) -> Hole f a

holes :: Uniplate1 f => f a -> [Hole f a]
...

但是，尚不清楚是否有 holes 的实现。不需要 Typeable1 .

Answer 1

建议类型Hole对函数的返回类型进行了不必要的限制。下面的类型可以代表之前的一切Hole表示，以及更多，而不会丢失任何类型信息。

{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE GADTs #-}

data Hole f a where
    Hole :: f b -> (f b -> a) -> Hole f a

如果我们需要返回类型 f a , 我们可以使用 Hole f (f a)来代表它。因为我们将使用 Hole很多，最好有一些实用功能。因为 Hole中函数的返回类型不再局限于 f ，我们可以制作一个 Functor例如它

instance Functor (Hole f) where
    fmap f (Hole b g) = Hole b (f . g)

contexts1可以为 Hole 的任一版本编写通过替换 uniplate 库的 contexts 中元组的构造函数与 Hole :

contexts1 :: Uniplate1 f => f a -> [Hole f (f a)]
contexts1 x = Hole x id  : f (holes1 x)
    where    
        f xs = [ Hole y (ctx . context)
               | Hole child ctx <- xs
               , Hole y context <- contexts1 child]

holes1比较棘手，但仍然可以通过修改 holes 来实现来自 uniplate图书馆。它需要一个新的 Replace1 Applicative Functor使用 Hole而不是一个元组。元组的第二个字段被 second (f .) 修改。我们替换为 fmap f对于 Hole .

data Replace1 f a = Replace1 {replaced1 :: [Hole f a], replacedValue1 :: a}

instance Functor (Replace1 f) where
    fmap f (Replace1 xs v) = Replace1 (map (fmap f) xs) (f v)

instance Applicative (Replace1 f) where
    pure v = Replace1 [] v
    Replace1 xs1 f <*> Replace1 xs2 v = Replace1 (ys1 ++ ys2) (f v)
        where ys1 = map (fmap ($ v)) xs1
              ys2 = map (fmap (f)) xs2

holes1 :: Uniplate1 f => f a -> [Hole f (f a)]
holes1 x = replaced1 $ descendM1 (\v -> Replace1 [Hole v id] v) x

decendM1在 the preceding answer 中定义. Replace和 Replace1可以统一；如何做到这一点在示例之后描述。

让我们根据上一个问题中的代码来尝试一些示例。 Hole 上的以下实用程序功能s 会很有用。

onHole :: (forall b. f b -> c) -> Hole f a -> c
onHole f (Hole x _) = f x

inHole :: (forall b. f b -> f b) -> Hole f a -> a
inHole g (Hole x f) = f . g $ x

例子

我们将根据前面问题的代码使用以下示例数据和函数:

example = If (B True) (I 2 `Mul` I 3) (I 1)

zero :: Expression b -> Expression b
zero x = case x of
    I _ -> I 0
    B _ -> B False
    Add _ _ -> I 0
    Mul _ _ -> I 0
    Eq  _ _ -> B False
    And _ _ -> B False
    Or  _ _ -> B False
    If  _ a _ -> zero a

孔

sequence_ . map (onHole print) . holes1 $ example

B True
Mul (I 2) (I 3)
I 1

上下文

sequence_ . map (onHole print) . contexts1 $ example

If (B True) (Mul (I 2) (I 3)) (I 1)
B True
Mul (I 2) (I 3)
I 2
I 3
I 1

替换每个上下文

sequence_ . map print . map (inHole zero) . contexts1 $ example

I 0
If (B False) (Mul (I 2) (I 3)) (I 1)
If (B True)  (I 0)             (I 1)
If (B True)  (Mul (I 0) (I 3)) (I 1)
If (B True)  (Mul (I 2) (I 0)) (I 1)
If (B True)  (Mul (I 2) (I 3)) (I 0)

统一替换
Replace Applicative Functor可以重构，使其不知道任何 Uniplate 的孔的类型或 Uniplate1 , 而只知道孔是 Functor . Uniplate 的孔使用类型 (on, on -> a)并且基本上使用 fmap f = second (f .) ;这是 (on, ) 的组成和 on->仿函数。

而不是捕获 Compose从转换器库中，我们将为 Hole 创建一个新类型对于 Uniplate ，这将使这里的示例代码更加一致和独立。

data Hole on a = Hole on (on -> a)

instance Functor (Hole on) where
    fmap f (Hole on g) = Hole on (f . g)

我们将重命名 Hole从以前到 Hole1 .

data Hole1 f a where
    Hole1 :: f b -> (f b -> a) -> Hole1 f a

instance Functor (Hole1 f) where
    fmap f (Hole1 b g) = Hole1 b (f . g)

Replace可以丢弃任何一种洞的所有知识。

data Replace f a = Replace {replaced :: [f a], replacedValue :: a}

instance Functor f => Functor (Replace f) where
    fmap f (Replace xs v) = Replace (map (fmap f) xs) (f v)

instance Functor f => Applicative (Replace f) where
    pure v = Replace [] v
    Replace xs1 f <*> Replace xs2 v = Replace (ys1 ++ ys2) (f v)
        where ys1 = map (fmap ($ v)) xs1
              ys2 = map (fmap (f)) xs2

两个 holes和 holes1可以根据新的 Replace 来实现.

holes :: Uniplate on => on -> [Hole on on]
holes x = replaced $ descendM (\v -> Replace [Hole v id] v) x

holes1 :: Uniplate1 f => f a -> [Hole1 f (f a)]
holes1 x = replaced $ descendM1 (\v -> Replace [Hole1 v id] v) x