防止无意中使用不同的类型类实例

Question

我希望我的应用实例有以下行为ZipList':

zipListApplyTest = fs <*> xs
  where fs = ZipList' [negate, id]
        xs = ZipList' [1..5]

-- Result: ZipList' [-1,2]

这是我的第一次尝试:

newtype ZipList' a = ZipList' [a]
                   deriving (Eq, Show)

instance Functor ZipList' where
  fmap f (ZipList' xs) = ZipList' $ fmap f xs

instance Applicative ZipList' where
  pure x = ZipList' [x]

  ZipList' (f:fs) <*> ZipList' (x:xs) =
     ZipList' $ f x : (fs <*> xs) -- <-- the bug is here
  ZipList' [] <*> _ = ZipList' []
  _ <*> ZipList' []  = ZipList' []

-- Unexpected result: ZipList' [-1,2,3,4,5]

经过一番头疼,我意识到在我的应用实例中ZipList'不小心使用了错误<*>:

在标有行the bug is here,我申请<*>属于内置列表类型[]而不是应用<*>的ZipList'递归.

这就是为什么第二个函数id应用于列表的其余部分,而不是仅应用于第二个元素2.

这产生了预期的结果:

ZipList' fs <*> ZipList' xs = ZipList' $ zipApply fs xs
  where zipApply :: [(a -> b)] -> [a] -> [b]
        zipApply (f:fs) (x:xs) = f x : zipApply fs xs
        zipApply _ _           = []

是否有编译器标志,语言习惯用法或其他技术可以防止此错误或者更容易发现？

我正在进行GHC 8.2.2.

Answer 1

我们做得到:

{-# LANGUAGE PatternSynonyms, ViewPatterns #-}
-- at very top of file ^
-- ...
-- pick whatever names/operators you want
-- synonym signatures are given in GADT-like syntax
-- ZCons decomposes a ZipList' a into an a and a ZipList' a
-- (assuming it succeeds). This is the syntax even for pattern synonyms that
-- can only be used as patterns
-- (e.g. pattern Fst :: a -> (a, b); pattern Fst a <- (a, _)).
pattern ZCons :: a -> ZipList' a -> ZipList' a
-- xs needs to be a ZipList', but it's only a [a], so we uglify this synonym
-- by using the newtype wrapper as a view
pattern ZCons x xs <- ZipList' (x:(ZipList' -> xs))
-- views aren't in general invertible, so we cannot make this an automatically
-- bidirectional synonym (like ZNil is). We can give an explicit version
  where ZCons x (ZipList' xs) = ZipList' $ x:xs
-- simple enough that we can use one definition for both pattern and expression
pattern ZNil :: ZipList' a
pattern ZNil = ZipList' []
{-# COMPLETE ZNil, ZCons #-}
-- ZNil and ZCons cover all ZipLists

instance Applicative ZipList' where
  pure x = ZipList' $ repeat x
  -- these are bidirectional
  (ZCons f fs) <*> (ZCons x xs) = ZCons (f x) (fs <*> xs)
  _ <*> _ = ZNil