And i forgot to include the defs of (co)prod:

coprod (<>) i1 i2 = (\a b -> i1 a <> i2 b)
prod   (><) p1 p2 = (\a   -> p1 a >< p2 a)

diag = foldr (curry (prod mappend
                            fst
                            snd
        . uncurry (coprod mappend
                            (splitAt 2)
                            (splitAt 1)))) []

Matt