Question

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

在基于类

的类型* -> *的镜头式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，因此拥有一些实用程序函数会很不错。由于Hole中函数的返回类型不再受限于f，我们可以为其创建Functor个实例

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

通过使用contexts1替换uniplate库Hole中元组的构造函数，可以为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上的以下实用程序功能将非常有用。

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

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

1 个答案:

实施例

统一替换