сдерживающими экземпляры

Question

Допустим, мы получили следующее:

{-# LANGUAGE TypeFamilies #-} 
{-# LANGUAGE ConstraintKinds #-} 
{-# LANGUAGE FlexibleInstances #-} 
{-# LANGUAGE TypeFamilyDependencies #-} 

type family CategoryLikeT p_a_b = t | t -> p_a_b 

type IsCategoryLike p t a b = (t ~ CategoryLikeT (p, a, b)) 

class CategoryLike p where 
    (>>>) :: 
    (
     IsCategoryLike p t1 a b, 
     IsCategoryLike p t2 b c, 
     IsCategoryLike p t3 a c 
    ) => t1 -> t2 -> t3 

Мы находим, что это нормально компилируется:

f :: 
    (
    CategoryLike p, 
    IsCategoryLike p t1 a b, 
    IsCategoryLike p t2 b c, 
    IsCategoryLike p t3 c d, 
    IsCategoryLike p t4 a d 
) => t1 -> t2 -> t3 -> t4 
f x y z = x >>> y >>> z 

Но мы не определили экземпляры еще. Позволяет сделать:

data BasicFunction 
type instance CategoryLikeT (BasicFunction, a, b) = a -> b 

instance CategoryLike BasicFunction where 
    (>>>) = flip (.) 

, но и «Ints» при сложении является своим родом категории, как, если мы предположим, «а» и «б» являются как Void, например: BasicInt данные типа экземпляра CategoryLikeT (BasicInt, Пустота, Пустота) = Int

instance CategoryLike BasicFunction where 
    (>>>) = (+) 

конечно выше не работает, потому что нет никаких ограничений на «а» или «б» в определении экземпляра, так что нет гарантирую >>> получает все-таки типа, следовательно, (+) недостаточно общего. Так что я считал делает следующее:

Во-первых, добавление типа ограничений:

type family CategoryConstraints p t a b 

И затем добавляет к определению IsCategoryLike как следующее:

type IsCategoryLike p t a b = 
    (t ~ CategoryLikeT (p, a, b), CategoryConstraints p t) 

Затем мы можем добавить следующее ограничение:

type instance CategoryConstraints BasicInt t = (t ~ Int) 

Но теперь у нас есть проблема , не f больше не работает, что дает эту ошибку:

Could not deduce: CategoryConstraints p (CategoryLikeT (p, a, c))) 

Мы можем исправить это двумя способами:

Во-первых, путем добавления IsCategoryLike p t5 a c к ограничениям в f. Но это может стать очень грязным для более сложных функций, вам придется добавить ограничение для каждой операции. Также тривиальные изменения, например изменение до x >>> (y >>> z), требуют изменения подписи, что не требовалось, если у вас не было ограничений.

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

Тем не менее, я хотел бы сохранить подписи полного типа, не увеличиваясь и не выдерживая сложностей. Могут ли люди предлагать альтернативные подходы?

Answer 1

Хммм ... Я не уверен, что это лучший подход, но здесь прямое улучшение того, что у вас есть. В частности, я думаю, что использование связанных типов делает вещи чище ...

{-# LANGUAGE TypeFamilies, 
      ConstraintKinds, 
      FlexibleInstances, 
      TypeFamilyDependencies #-} 

import GHC.Exts (Constraint) 

class CategoryLike p where 
    type CategoryLikeT p a b = t | t -> p a b 
    type CategoryConstraints p a b :: Constraint 
    type CategoryConstraints p a b =() 
    (>>>) :: (CategoryConstraints p a b, CategoryConstraints p b c, CategoryConstraints p a c) 
    => CategoryLikeT p a b -> CategoryLikeT p b c -> CategoryLikeT p a c 

data BasicFunction 
instance CategoryLike BasicFunction where 
    type CategoryLikeT BasicFunction a b = a -> b 
    (>>>) = flip (.) 

data BasicInt 
instance CategoryLike BasicInt where 
    type CategoryLikeT BasicInt Int Int = Int 
    type CategoryConstraints BasicInt a b = (a ~ Int, b ~ Int) 
    (>>>) = (+) 

Итак, это то, что f выглядит сейчас: (я пишу это с явным FORALL, потому что делает его кандидатом для использования TypeApplications)

f :: forall p a b c d. (
    CategoryLike p, 
    CategoryConstraints p a b, 
    CategoryConstraints p b c, 
    CategoryConstraints p a c, 
    CategoryConstraints p a d, 
    CategoryConstraints p d b 
) => CategoryLikeT p a d -> 
     CategoryLikeT p d b -> 
     CategoryLikeT p b c -> 
     CategoryLikeT p a c 
f x y z = x >>> y >>> z 

Чтобы использовать его, я могу сделайте что-то вроде этого (что выглядит удивительно красиво):

ghci> :set -XTypeApplications 
ghci> :t f @BasicFunction (+1) id show 
f @BasicFunction (+1) id show :: (Show a, Num a) => a -> [Char] 
ghci> :t f @BasicInt 1 2 3 
f @BasicInt 1 2 3 :: Int