Как я могу извлечь эту функцию полиморфной рекурсии?

Я делаю это довольно забавно с GHC 7.8, но столкнулся с проблемой. У меня есть следующее:

mkResultF :: Eq k => Query kvs ('KV k v) -> k -> ResultF (Reverse kvs) (Maybe v)
mkResultF Here key = ResultComp (pure . lookup key)
mkResultF [email protected](There p) key =
  case mkResultF p key of
    ResultFId a -> pure a
    ResultComp c ->
      ResultComp $ \foo ->
       case c foo of
         ResultFId a -> pure a
         ResultComp c ->
           ResultComp $ \foo ->
            case c foo of
              ResultFId a -> pure a

Ясно, что здесь есть что абстрагироваться, но я не могу понять, как это сделать. Когда я попробую следующее:

mkResultF :: Eq k => Query kvs ('KV k v) -> k -> ResultF (Reverse kvs) (Maybe v)
mkResultF Here key = ResultComp (pure . lookup key)
mkResultF [email protected](There p) key = magic (mkResultF p key)

magic :: ResultF (Reverse kvs) (Maybe v) -> ResultF (Reverse kvs ++ '[('KV x y)]) (Maybe v)
magic (ResultFId a) = pure a
magic (ResultComp c) = ResultComp (\foo -> magic (c foo))

Это похоже на "очевидное" решение, но оно не печатает проверку:

Could not deduce (kvs2 ~ Reverse kvs0)
from the context (Reverse kvs ~ ('KV k v1 : kvs2))
  bound by a pattern with constructor
             ResultComp :: forall a k v (kvs :: [KV * *]).
                           ([(k, v)] -> ResultF kvs a) -> ResultF ('KV k v : kvs) a,
           in an equation for `magic'
  at query-kv.hs:202:8-19
  `kvs2' is a rigid type variable bound by
         a pattern with constructor
           ResultComp :: forall a k v (kvs :: [KV * *]).
                         ([(k, v)] -> ResultF kvs a) -> ResultF ('KV k v : kvs) a,
         in an equation for `magic'
         at query-kv.hs:202:8
Expected type: ResultF (Reverse kvs0) (Maybe v)
  Actual type: ResultF kvs2 (Maybe v)
Relevant bindings include
  c :: [(k, v1)] -> ResultF kvs2 (Maybe v)
    (bound at query-kv.hs:202:19)
In the first argument of `magic', namely `(c foo)'
In the expression: magic (c foo)

Я действительно застрял в этом. Полный список кодов со стартовым кодом можно найти здесь: https://gist.github.com/ocharles/669758b762b426a3f930

Ответы

Ответ 1

Почему у вас включен AllowAmbiguousTypes? Это почти никогда не было хорошей идеей. Без расширения вы получите гораздо лучшее сообщение об ошибке:

Couldn't match type ‘Reverse kvs0’ with ‘Reverse kvs’
NB: ‘Reverse’ is a type function, and may not be injective
The type variable ‘kvs0’ is ambiguous
Expected type: ResultF (Reverse kvs) (Maybe v)
               -> ResultF (Reverse kvs ++ '['KV x y]) (Maybe v)
  Actual type: ResultF (Reverse kvs0) (Maybe v)
               -> ResultF (Reverse kvs0 ++ '['KV x0 y0]) (Maybe v)
In the ambiguity check for:
  forall (kvs :: [KV * *]) v x y.
  ResultF (Reverse kvs) (Maybe v)
  -> ResultF (Reverse kvs ++ '['KV x y]) (Maybe v)
To defer the ambiguity check to use sites, enable AllowAmbiguousTypes
In the type signature for ‘magic’:
  magic :: ResultF (Reverse kvs) (Maybe v)
           -> ResultF (Reverse kvs ++ '[KV x y]) (Maybe v)

Проблема действительно в сигнатуре типа для magic, где у вас

magic :: ResultF (Reverse kvs) (Maybe v)
      -> ResultF (Reverse kvs ++ '[('KV x y)]) (Maybe v)

Все переменные kvs, x и y встречаются только как аргументы Reverse и ++, которые являются семействами типов и не должны быть инъективными. Такая ситуация всегда подозрительна.

Самое простое исправление - добавить прокси. Здесь код, который компилируется для меня:

mkResultF :: forall k v kvs. Eq k
           => Query kvs ('KV k v) -> k -> ResultF (Reverse kvs) (Maybe v)
mkResultF Here key = ResultComp (pure . lookup key)
mkResultF (There p) key = magic (Proxy :: Proxy kvs) (mkResultF p key)

magic :: Proxy ('KV x y ': kvs)
      -> ResultF (Reverse kvs) (Maybe v)
      -> ResultF (Reverse ('KV x y ': kvs)) (Maybe v)
magic _ r =
  case r of
    ResultFId a -> pure a
    ResultComp c ->
      ResultComp $ \foo ->
       case c foo of
         ResultFId a -> pure a
         ResultComp c ->
           ResultComp $ \foo ->
            case c foo of
              ResultFId a -> pure a

Изменить

Я снова посмотрел на это, и здесь версия, использующая ваше определение magic (as magic2). Он все еще не очень изящный, но, надеюсь, его хватит как доказательство концепции:

mkResultF :: forall k v kvs. Eq k
           => Query kvs ('KV k v) -> k -> ResultF (Reverse kvs) (Maybe v)
mkResultF Here      key = ResultComp (pure . lookup key)
mkResultF (There p) key = magic1 (Proxy :: Proxy kvs) (mkResultF p key)

magic1 :: forall x y kvs v. Proxy ('KV x y ': kvs)
       -> ResultF (Reverse kvs) (Maybe v)
       -> ResultF (Reverse ('KV x y ': kvs)) (Maybe v)
magic1 _ = magic2 (Proxy :: Proxy ('KV x y)) (Proxy :: Proxy (Reverse kvs))

magic2 :: Proxy ('KV x y) -> Proxy kvs
       -> ResultF kvs (Maybe v)
       -> ResultF (kvs ++ '[('KV x y)]) (Maybe v)
magic2 _ _ (ResultFId a) = pure a
magic2 p _ (ResultComp (c :: ([(k, v')] -> ResultF kvs' (Maybe v))))
  = ResultComp (\ foo -> magic2 p (Proxy :: Proxy kvs') (c foo))