如何在镜头式单片库中为更高级的类型实现孔和上下文？

Question

AndrásKovács 在回答前一个问题时提出了这个问题.

在镜头风格的uniplate库中,* -> *基于类的类型

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

类似于类的种类 *

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

是有可能实现类似物contexts和holes,二者均具有类型Uniplate on => on -> [(on, on -> on)],而不需要Typeable1？

很明显,这可以在uniplate库的旧式中实现,该库用于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大量使用，因此最好有一些实用函数。因为函数 in 的返回类型Hole不再限制为 in f，所以我们可以Functor为它创建一个实例

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

contexts1可以通过将Holeuniplate 库中元组的构造函数替换为以下内容来为任一版本编写：contextsHole

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]

holes1holes比较棘手，但仍然可以通过从库中修改来实现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是在前面的答案中定义的。Replace并且Replace1可以统一；示例后面描述了如何执行此操作。

让我们根据上一个问题中的代码尝试一些示例。s上的以下实用函数Hole将会很有用。

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孔的类型，而只知道该孔是 a 。孔的使用类型和本质上使用；这是和函子的组合。UniplateUniplate1FunctorUniplate(on, on -> a)fmap f = second (f .)(on, )on->

我们将为for创建一个新类型，而不是Compose从 Transformers 库中获取，这将使此处的示例代码更加一致和独立。HoleUniplate

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