Как могут быть реализованы дыры и контексты для типов с более высоким родом в одноплатной библиотеке в стиле линз?

Андраш Ковач предложил этот вопрос в ответ на ответ на предыдущий вопрос.

В одноплатной библиотеке в стиле линз для разных видов * -> * на основе класса

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,

Источник

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 библиотека. Требуется новый Replace1ApplicativeFunctor который использует 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 могут быть объединены; как это сделать, описано после примеров.

Давайте попробуем несколько примеров с точки зрения кода в предыдущем вопросе. Следующие служебные функции на 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)

Объединяющий Заменить

ReplaceApplicativeFunctor может быть реорганизован так, что он не знает о типе отверстий для 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
Источник
Другие вопросы по тегам