FoldThese1 :: Monoid m => [These m b] -> These

Question

FoldThese1 :: Monoid m => [These m b] -> These

m [b]
foldThese1 [] = This mempty
foldThese1 (x:xs) = fmap ($[])
$ foldl'
(\a b -> case a of
This xa -> case b of
This ya -> This (xa <> ya)
That _ -> This xa
These ya _ -> This (xa<>ya)
That xb -> case b of
This ya -> This ya
That yb -> That (xb .(yb:))
These ya yb -> These ya (xb .(yb:))
These xa xb -> case b of
This ya -> This (xa <> ya)
That yb -> These xa (xb .(yb:))
These ya yb -> These (xa<>ya) (xb .(yb:))) (fmap (\t -> (t:)) x) xs

А вот такое адищще как-то проще же выражается?
Смысл мы проходимся по всем веткам, собираем все ошибки (Here (This a, These a), если среди данных не было таких, где только ошибка (This) то собираем все There (That b, These _ b), ну и за 1 проход это