How to make a comonad instance of list zipper of list zippers data type?

Question

I heard that every zipper is a comonad, and I think every zipper composed with itself is still a zipper, therefore it's a comonad. So I decided to create one.

I have the following list zipper:

{-# 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

And I want to make newtype Grid a = Grid {getGrid :: ListZipper (ListZipper a)} deriving (Functor, Eq) into a comonad, since it's also a zipper.

What I tried to do:

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

I decided to test the code via Quick Check. What QuickCheck has to say:

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]]

I have a feeling I'm very close, but I don't know what went wrong. I'm out of ideas.

Answer 1

A zipper is a convenient representation of a data structure plus a cursor. Hence, a composition of two zippers will be a data structure with an "outer cursor" whose elements are data structures each with their own "inner cursor", so there's more structure to a composition of two zippers than just another zipper. The composition of two zippers is a zipper only in the same way a tree of trees is a tree, or a list of lists is a list.

The problem you're running into here is that a composition of two ListZippers will serve as a zipper only to the extent that the "inner cursors" can be sensibly and consistently aligned and paired with the "outer cursor" to represent the overall cursor for the composition. If your Grid is rectangular, then the Grid's cursor can be represented by pointing the "outer cursor" at the desired row and aligning ALL of the "inner cursors" at the desired column. If you test your implementation on rectangular Grids, you'll see that it behaves correctly.

The problem comes when you consider "ragged" Grids, like the failed test case or the even simpler example:

Grid (ZList [] (ZList [] 1 []) [ZList [] 2 [3]])

This Grid's cursor is pointing at the upper-left element 1 by setting the outer cursor to the top row, and the inner cursors to the first column of each row. No problem so far. But, when you try -- in your duplicate call -- to generate the set of inner ZLists for the second column, there is no proper representation for this Grid to point at the bottom-right element 3. Specifically, goRight on the outer ZList (i.e., down) generates:

Just (Grid (ZList [ZList [] 1 []] (ZList [] 2 [3]) []))

but then goRight mapped over the inner ZLists (i.e., right), generates Nothing for the first inner ZList and Just (ZList [2] 3 []) for the second. Sequencing over these correctly returns Nothing. Note that there's no obvious right answer here. Just "stopping" at the end of short rows doesn't work:

Just (Grid (ZList [ZList [] 1 []] (ZList [2] 3 []) []))

because the inner cursors don't align anymore. Imagine a ragged grid with 2 elements in the first row and 3 elements in the second. Go right twice and left twice, and you're not back where you started.

Anyway, in trying to move to the second column in the duplicate call, your implementation "falls off the end" of the first row, and so generates an incomplete duplication that consists of only the first column, even though the sub-Grids in that first column are correct:

ghci> duplicate $ Grid (ZList [] (ZList [] 1 []) [ZList [] 2 [3]])
Grid (ZList [] 
            (ZList []
                   (Grid (ZList []                -- row 1, col 1
                                (ZList [] 1 []) 
                                [ZList [] 2 [3]])) 
                   [])                            -- no row 1, col 2
            [ZList [] 
                   (Grid (ZList [ZList [] 1 []]   -- row 2, col 1
                                (ZList [] 2 [3]) 
                                [])) 
                   []])                           -- no row 2, col 2

So, obviously, if you fmap extract over this, you only get the first column of the original:

ghci> fmap extract . duplicate $ Grid (ZList [] (ZList [] 1 []) [ZList [] 2 [3]])
Grid (ZList [] (ZList [] 1 []) [ZList [] 2 []])

This is certainly related to the discussion in @Joe's link in the comments. Two comonads that also distribute can be composed into a comonad using:

duplicate = fmap distribute . duplicate . fmap duplicate

but two ListZippers don't naturally distribute (AKA transpose) unless all the inner ZLists have the same length with their cursors all set to the same position.