如何为List Zipper嵌套的Grid类型实现正确的Comonad实例？

已知所有拉链（Zipper）都是Comonad，嵌套后的拉链仍然是拉链，因此newtype Grid a = Grid {getGrid :: ListZipper (ListZipper a)}也应当是Comonad。已完成ListZipper的Comonad实例实现，但是为Grid编写的Comonad实例在QuickCheck测试中，fmap extract . duplicate = id用例失败，需要排查问题。

已实现的ListZipper代码 #

{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE InstanceSigs #-}
module ListZipper where
import Control.Comonad
import Data.List (unfoldr)
import Test.QuickCheck (Arbitrary (arbitrary))

data ListZipper a = ZList {previous :: [a], currentL :: a, next :: [a]} deriving (Functor, Eq)

goLeft, goRight :: ListZipper a -> Maybe (ListZipper a)
goLeft  (ZList (p:ps) cur ns) = Just $ ZList ps p (cur : ns)
goLeft _  = Nothing
goRight (ZList ps cur (n:ns)) = Just $ ZList (cur : ps) n ns
goRight _ = Nothing

fork :: b -> (b, b)
fork x = (x, x)

instance Comonad ListZipper where
    extract :: ListZipper a -> a
    extract = currentL
    duplicate :: ListZipper a -> ListZipper (ListZipper a)
    duplicate zl = ZList pl zl nl where
        pl = unfoldr (fmap fork . goLeft ) zl
        nl = unfoldr (fmap fork . goRight) zl

尝试实现的Grid Comonad实例代码 #

sequenceZList :: Applicative f => ListZipper (f a) -> f (ListZipper a)
sequenceZList (ZList pl cur nl) = ZList <$> sequenceA pl <*> cur <*> sequenceA nl

f :: ListZipper (ListZipper a) -> ListZipper (Grid a)
f z = ZList dcl (Grid z) ucl where
        dcl = Grid <$> unfoldr (fmap fork . sequenceZList . fmap goLeft) z
        ucl = Grid <$> unfoldr (fmap fork . sequenceZList . fmap goRight) z

instance Comonad Grid where
    extract = extract . extract . getGrid
    duplicate = Grid . extend f . getGrid

QuickCheck测试结果 #

ComonadGrid
  extract . duplicate      = id [✔]
    +++ OK, passed 100 tests.
  fmap extract . duplicate = id [✘]
  duplicate . duplicate    = fmap duplicate . duplicate [✔]     
    +++ OK, passed 100 tests.
ComonadListZipper
  extract . duplicate      = id [✔]
    +++ OK, passed 100 tests.
  fmap extract . duplicate = id [✔]
    +++ OK, passed 100 tests.
  duplicate . duplicate    = fmap duplicate . duplicate [✔]     
    +++ OK, passed 100 tests.
Unit
  left  . right == id [✔]
    +++ OK, passed 100 tests.
  right . left  == id [✔]
    +++ OK, passed 100 tests.
  up    . down  == id [✔]     
    +++ OK, passed 100 tests. 
  down  . up    == id [✔]     
    +++ OK, passed 100 tests.      
  down  . left  == left  . down [✔]     
    +++ OK, passed 100 tests.      
  down  . right == right . down [✔]     
    +++ OK, passed 100 tests.
  up    . left  == left  .   up [✔]     
    +++ OK, passed 100 tests.
  up    . right == right .   up [✔]
    +++ OK, passed 100 tests.

Failures:

  test\unit\ComonadGridSpec.hs:12:5: 
  1) ComonadGrid fmap extract . duplicate = id
       Falsified (after 2 tests):
         [[0],[1,0,-1]]

代码逻辑接近正确，但无法定位fmap extract . duplicate = id测试失败的具体原因，寻求帮助。

内容的提问来源于stack exchange，提问作者Артём Мухамед-Каримов МПБ-802