Ошибка при определении Applicative <*> с аксессорами записей: невозможно создать бесконечный тип: t ~ t -> t1

Question

У меня есть следующий код:

{-# LANGUAGE DeriveFunctor #-}

data Foo a = Foo { field1 :: a, field2 :: a} deriving (Functor)

instance Applicative Foo where
  pure a = Foo a a
  f <*> a = Foo (r field1) (r field2)
    where r g = g f $ g a

Я получаю следующие ошибки в GHCi:

help.hs:8:23: error:
    • Occurs check: cannot construct the infinite type: t ~ t -> t1
    • In the second argument of ‘($)’, namely ‘g a’
      In the expression: g f $ g a
      In an equation for ‘r’: r g = g f $ g a
    • Relevant bindings include
        g :: Foo (a -> b) -> t -> t1 (bound at help.hs:8:13)
        r :: (Foo (a -> b) -> t -> t1) -> t1 (bound at help.hs:8:11)

help.hs:8:25: error:
    • Couldn't match type ‘a’ with ‘a -> b’
      ‘a’ is a rigid type variable bound by
        the type signature for:
          (<*>) :: forall a b. Foo (a -> b) -> Foo a -> Foo b
        at help.hs:7:5
      Expected type: Foo (a -> b)
        Actual type: Foo a
    • In the first argument of ‘g’, namely ‘a’
      In the second argument of ‘($)’, namely ‘g a’
      In the expression: g f $ g a
    • Relevant bindings include
        g :: Foo (a -> b) -> t -> t1 (bound at help.hs:8:13)
        r :: (Foo (a -> b) -> t -> t1) -> t1 (bound at help.hs:8:11)
        a :: Foo a (bound at help.hs:7:9)
        f :: Foo (a -> b) (bound at help.hs:7:3)
        (<*>) :: Foo (a -> b) -> Foo a -> Foo b (bound at help.hs:7:3)

Как я могу реализовать этот экземпляр аппликативного функтора Foo, чтобы он компилировался?

Answer 1

Определение

r g = g f $ g a

требовать g быть полиморфной функцией - GHC не может вывести такой сложный тип.

Вы должны быть более явными в своих типах, если вы действительно хотите, чтобы ваш код компилировался:

{-# LANGUAGE ScopedTypeVariables, DeriveFunctor, InstanceSigs, Rank2Types #-}
instance Applicative Foo where
  pure a = Foo a a
  (<*>) :: forall a b. Foo (a->b) -> Foo a -> Foo b
  f <*> a = Foo (r field1) (r field2)
     where
     r :: (forall t. Foo t -> t) ->  b
     r g = g f $ g a

В качестве альтернативы можно использовать более прямой подход:

instance Applicative Foo where
  pure a = Foo a a
  (Foo f1 f2) <*> (Foo a1 a2) = Foo (f1 a1) (f2 a2)