Как предоставить экземпляр Functor для типа данных, созданного для общих схем рекурсии?

Question

У меня есть рекурсивный тип данных, который имеет экземпляр Functor:

data Expr1 a 
    = Val1 a 
    | Add1 (Expr1 a) (Expr1 a) 
    deriving (Eq, Show, Functor) 

Теперь, я заинтересован в изменении этого типа данных для поддержки общих схем рекурсии, как они описаны в this tutorial и this Hackage package. Мне удалось получить катаморфизм к работе:

newtype Fix f = Fix {unFix :: f (Fix f)} 

data ExprF a r 
    = Val a 
    | Add r r 
    deriving (Eq, Show, Functor) 

type Expr2 a = Fix (ExprF a) 

cata :: Functor f => (f a -> a) -> Fix f -> a 
cata f = f . fmap (cata f) . unFix 

eval :: Expr2 Int -> Int 
eval = cata $ \case 
    Val n -> n 
    Add x y -> x + y 

main :: IO() 
main = 
    print $ eval 
    (Fix (Add (Fix (Val 1)) (Fix (Val 2)))) 

Но теперь я не могу понять, как дать Expr2 тот же экземпляр функтора, что первоначально Expr имел. Кажется, что это своего рода несоответствие при попытке определить экземпляр функтора:

instance Functor (Fix (ExprF a)) where 
    fmap = undefined 

Kind mis-match 
    The first argument of `Functor' should have kind `* -> *', 
    but `Fix (ExprF a)' has kind `*' 
    In the instance declaration for `Functor (Fix (ExprF a))' 

Как написать экземпляр Functor для Expr2?

Я думал о оберточной Expr2 в Newtype с newtype Expr2 a = Expr2 (Fix (ExprF a)) но тогда это Newtype должно быть развернута, чтобы быть переданы cata, что я не очень люблю. Я также не знаю, можно ли автоматически получить экземпляр-функтор Expr2, как я сделал с Expr1.

Answer 1

Интересно, если вы могли бы быть лучше использовать тип Free:

data Free f a 
    = Pure a 
    | Wrap (f (Free f a)) 
deriving Functor 

data ExprF r 
    = Add r r 
deriving Functor 

Это имеет дополнительное преимущество, что есть довольно много библиотек, которые работают на свободных монад уже, так что, возможно, они будут спасти вас некоторые работы.

Answer 2

Типа ключевого слова используются только как синоним существующего типа, может быть, это то, что вы ищете

newtype Expr2 a r = In { out :: (ExprF a r)} deriving Functor 

Answer 3

Это старая болячка для меня. Важнейшим моментом является то, что ваш ExprF является функториальным в и его параметрами. Так что, если мы имели

class Bifunctor b where 
    bimap :: (x1 -> y1) -> (x2 -> y2) -> b x1 x2 -> b y1 y2 

тогда можно определить (или представить себе машину, определяющий для вас)

instance Bifunctor ExprF where 
    bimap k1 k2 (Val a) = Val (k1 a) 
    bimap k1 k2 (Add x y) = Add (k2 x) (k2 y) 

и теперь вы можете иметь

newtype Fix2 b a = MkFix2 (b a (Fix2 b a)) 

сопровождается

map1cata2 :: Bifunctor b => (a -> a') -> (b a' t -> t) -> Fix2 b a -> t 
map1cata2 e f (MkFix2 bar) = f (bimap e (map1cata2 e f) bar) 

, который, в свою очередь, дает вам п вы возьмете в неподвижной опоры одного из параметров, что осталось еще функториальна в другом

instance Bifunctor b => Functor (Fix2 b) where 
    fmap k = map1cata2 k MkFix2 

и вы как бы получить то, что вы хотели. Но ваш экземпляр Bifunctor не будет создан магией. И это немного раздражает, что вам нужен другой оператор fixpoint и совершенно новый вид функтора. Беда в том, что у вас теперь есть две подструктуры: «значения» и «подвыражения».

И вот очередь. Существует понятие функтора закрыто под фиксированными точками.Включите раковину (особенно DataKinds) и

type s :-> t = forall x. s x -> t x 

class FunctorIx (f :: (i -> *) -> (o -> *)) where 
    mapIx :: (s :-> t) -> f s :-> f t 

Обратите внимание, что «элементы» приходят в виде индексированной над i и «структурами» в виде индексированной над какими-либо другими o. Возьмем функции i -preserving на элементах до o, сохраняя функции на структурах. Реально, i и o могут быть разными.

Волшебные слова «1, 2, 4, 8, время, чтобы подчеркнуть!». Тип вида * можно легко превратить в тривиально индексированный GADT вида () -> *. И два типа могут быть свернуты вместе, чтобы сделать GADT вида Either()() -> *. Это означает, что мы можем объединить обе подструктуры вместе. В общем, у нас есть тип типа either.

data Case :: (a -> *) -> (b -> *) -> Either a b -> * where 
    CL :: f a -> Case f g (Left a) 
    CR :: g b -> Case f g (Right b) 

оборудован с понятием "карты"

mapCase :: (f :-> f') -> (g :-> g') -> Case f g :-> Case f' g' 
mapCase ff gg (CL fx) = CL (ff fx) 
mapCase ff gg (CR gx) = CR (gg gx) 

Таким образом, мы можем refunctor нашего bifactors в Either -indexed FunctorIx экземпляров.

И теперь мы можем взять фиксированную точку любой структуры узла f, которая имеет места для любых элементов p или подносы. Это та же самая сделка, что и у нас.

newtype FixIx (f :: (Either i o -> *) -> (o -> *)) 
       (p :: i -> *) 
       (b :: o) 
    = MkFixIx (f (Case p (FixIx f p)) b) 

mapCata :: forall f p q t. FunctorIx f => 
    (p :-> q) -> (f (Case q t) :-> t) -> FixIx f p :-> t 
mapCata e f (MkFixIx node) = f (mapIx (mapCase e (mapCata e f)) node) 

Но теперь, мы получаем тот факт, что FunctorIx закрывается под FixIx.

instance FunctorIx f => FunctorIx (FixIx f) where 
    mapIx f = mapCata f MkFixIx 

Функционалы на индексированных наборах (с дополнительной свободой для изменения индекса) могут быть очень точными и очень мощными. Они обладают гораздо более удобными свойствами закрытия, чем Functor. Я не думаю, что они поймают.

Answer 4

Ничего плохого с ответом pigworker, но, может быть, вы можете использовать более простой, как трамплин:

{-# LANGUAGE DeriveFunctor, ScopedTypeVariables #-} 

import Prelude hiding (map) 

newtype Fix f = Fix { unFix :: f (Fix f) } 

-- This is the catamorphism function you hopefully know and love 
-- already. Generalizes 'foldr'. 
cata :: Functor f => (f r -> r) -> Fix f -> r 
cata phi = phi . fmap (cata phi) . unFix 

-- The 'Bifunctor' class. You can find this in Hackage, so if you 
-- want to use this just use it from there. 
-- 
-- Minimal definition: either 'bimap' or both 'first' and 'second'. 
class Bifunctor f where 
    bimap :: (a -> c) -> (b -> d) -> f a b -> f c d 
    bimap f g = first f . second g 

    first :: (a -> c) -> f a b -> f c b 
    first f = bimap f id 

    second :: (b -> d) -> f a b -> f a d 
    second g = bimap id g 

-- The generic map function. I wrote this out with 
-- ScopedTypeVariables to make it easier to read... 
map :: forall f a b. (Functor (f a), Bifunctor f) => 
     (a -> b) -> Fix (f a) -> Fix (f b) 
map f = cata phi 
    where phi :: f a (Fix (f b)) -> Fix (f b) 
      phi = Fix . first f 

Теперь ваш язык выражение работает следующим образом:

-- This is the base (bi)functor for your expression type. 
data ExprF a r = Val a 
       | Add r r 
       deriving (Eq, Show, Functor) 

instance Bifunctor ExprF where 
    bimap f g (Val a) = Val (f a) 
    bimap f g (Add l r) = Add (g l) (g r) 

newtype Expr a = Expr (Fix (ExprF a)) 

instance Functor Expr where 
    fmap f (Expr exprF) = Expr (map f exprF) 

EDIT: Вот ссылка на bifunctors package in Hackage.