如何簡化幾個arvals類型構造函數的「產品」類型類？

Question

請原諒我下面可能濫用類別理論術語。如果我看起來有一半線索，我會判斷自己非常成功。

我發現自己寫了一系列的類來處理多個類型構造函數的產品。像這樣：

import Control.Applicative 

-- | RWS monad. 
newtype RWS r w s a = RWS {runRWS :: r -> s -> (a, s, w)} 

-- | A class for unary type constructors that support a Cartesian 
-- product operation. 
class ProductObject f where 
    (***) :: f a -> f b -> f (a, b) 
infixr *** 

-- | Example instance of 'ProductObject'. 
instance ProductObject [] where 
    (***) = liftA2 (,) 


-- | A class for binary type constructors (read as morphisms 
-- between their type parameters) that support a product morphism 
-- operation. 
class ProductMorphism arrow where 
    (****) :: arrow a b -> arrow c d -> arrow (a, c) (b, d) 
infixr **** 

-- | Example instance of 'ProductMorphism'. 
instance ProductMorphism (->) where 
    f **** g = \(a, c) -> (f a, g c) 


-- | A class for ternary type constructors (read as two-place 
-- multiarrows @a, b -> c@) with products. 
class ProductMultimorphism2 arr2 where 
    (*****) :: arr2 a b c -> arr2 d e f -> arr2 (a, d) (b, e) (c, f) 
infixr ***** 


-- | A class for ternary type constructors (read as two-place 
-- multiarrows @a, b -> c@) with products. 
class ProductMultimorphism3 arr3 where 
    (******) :: arr3 a b c d -> arr3 e f g h -> arr3 (a, e) (b, f) (c, g) (d, h) 
infixr ****** 

-- | Let's pretend that the 'RWS' monad was not a type synonym 
-- for 'RWST'. Then an example of 'ProductMorphism3' would be: 
instance ProductMultimorphism3 RWS where 
    f ****** g = RWS $ \(fr, gr) (fs, gs) -> 
     let (fa, fs', fw) = runRWS f fr fs 
      (ga, gs', gw) = runRWS g gr gs 
     in ((fa, ga), (fs', gs'), (fw, gw)) 

現在，這是令人討厭的幾個原因。最大的問題是我必須在我的應用程序中修改其中的一種類型以添加​​第三個參數，這意味着現在我必須去查找該類型的所有用途****並將它們更改爲*****。

我可以申請緩解這種情況嗎？我試圖瞭解GHC中的PolyKinds是否適用於此，但（a）這很慢，（b）我聽說GHC 7.4.x中的PolyKinds是buggy。

Answer 1

嗯，我想通了我自己：

{-# LANGUAGE MultiParamTypeClasses, TypeFamilies #-} 

import Control.Applicative 

class Product f g where 
    type Prod a b :: * 
    (***) :: f -> g -> Prod f g 


instance Product [a] [b] where 
    type Prod [a] [b] = [(a, b)] 
    (***) = liftA2 (,) 

instance Product (a -> b) (c -> d) where 
    type Prod (a -> b) (c -> d) = (a, c) -> (b, d) 
    f *** g = \(a, c) -> (f a, g c)