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

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