Using  Roman’s smallcheck code (thanks!) here’s some evidence that codensity turns a bad diagonalizing ziplist instance into a good one, by fixing associativity. I’ve been pondering this for some time, and I’m glad this thread kicked me into making it work out. Also, as David noted, this works with or without the “take i” in the code, which enforces that minimum criteria I mentioned. So I suppose there’s a range of possibilities here.

If this works out, it looks like this also shows that a “purely algebraic” argument as to why ZipList can’t be a monad doesn't exist. I.e. there’s no conflict in the laws. It’s just that using a plain list as the underlying datastructure can’t force a uniform associativity. 

To make a real “monadic ziplist” out of this, I think  the codensity stuff would just need to be inlined under the ziplist constructor.

Cheers,
Gershom

import Data.List
import Data.Maybe
import Test.SmallCheck.Series
import Test.Tasty
import Test.Tasty.SmallCheck
import Control.Monad
import Control.Applicative
import System.Environment

data ZL a = ZL {unZL :: [a]} deriving (Eq, Show)


instance Functor ZL where
 fmap f (ZL xs) = ZL (fmap f xs)

joinZL :: ZL (ZL a) -> ZL a
joinZL (ZL []) = ZL []
joinZL (ZL zs) = ZL (chop . diag (0,[]) $ map unZL zs)
 where diag :: (Int,[a]) -> [[a]] -> (Int,[a])
 diag (i,acc) [] = (i,acc)
 diag (i,acc) (x:xs) = case drop i x of
 [] -> (length x, acc)
 (y:_) ->diag (i+1, (y : acc)) xs
 chop (i,acc) = take i $ reverse acc

instance Applicative ZL where
 pure = return
 f <*> x = joinZL $ fmap (\g -> fmap g x) f

instance Monad ZL where
 return x = ZL (repeat x)
 x >>= f = joinZL $ fmap (f $) x


newtype Codensity m a = Codensity { runCodensity :: forall b. (a -> m b) -> m b }

instance Functor (Codensity k) where fmap f (Codensity m) = Codensity (\k -> m (\x -> k (f x)))

instance Applicative (Codensity f) where
 pure x = Codensity (\k -> k x)
 Codensity f <*> Codensity g = Codensity (\bfr -> f (\ab -> g (\x -> bfr (ab x))))

instance Monad (Codensity f) where
 return = pure
 m >>= k = Codensity (\c -> runCodensity m (\a -> runCodensity (k a) c))

lowerCodensity :: Monad m => Codensity m a -> m a
lowerCodensity a = runCodensity a return

lift m = Codensity (m >>=)

-- tests

instance Serial m a => Serial m (ZL a) where
 series = ZL <$> series

instance Serial m a => Serial m (Codensity ZL a) where
 series = lift <$> series

instance Show (Codensity ZL Int) where
 show x = show (lowerCodensity x)

instance Show (Codensity ZL Bool) where
 show x = show (lowerCodensity x)

main = do
 setEnv "TASTY_SMALLCHECK_DEPTH" "4"
 defaultMain $ testGroup "Monad laws"
 [ testProperty "Right identity" $ \(z :: Codensity ZL Int) ->
 lowerCodensity (z >>= return) == lowerCodensity z
 , testProperty "Left identity" $ \(b :: Bool) (f :: Bool -> Codensity ZL Bool) ->
 lowerCodensity (return b >>= f) == lowerCodensity (f b)
 , testProperty "Associativity" $
 \(f1 :: Bool -> Codensity ZL Bool)
 (f2 :: Bool -> Codensity ZL Bool)
 (z :: Codensity ZL Bool) ->
 lowerCodensity (z >>= (\x -> f1 x >>= f2)) == lowerCodensity ((z >>= f1) >>= f2)
 ]