Strata,

  stratum,
  getStrata,

import Data.List (transpose)

import Data.List (partition, transpose)

newtype Strata a = Strata  [Front a] deriving (Show)

stratum :: a -> Strata a
stratum a = Strata [singleton a]
fuse :: Debatable a => Front a -> Front a -> (Front a, Front a, Front a)
fuse (Front a) (Front b) = let
  m = map (flip map b . weigh) a
  m' = transpose m
  s = map (not . any (== Dominated)) m
  s' = map (not . any (== Dominates)) m'
  (f1, t1) = partition snd $ zip a s
  (f2, t2) = partition snd $ zip b s'
  in (Front $ map fst (f1 ++ f2), Front $ map fst t1, Front $ map fst t2)

  Front a <> Front b = let
    m = map (flip map b . weigh) a
    m' = transpose m
    s = map (not . any (== Dominated)) m
    s' = map (not . any (== Dominates)) m'
    in Front $ map fst $ filter snd $ zip a s ++ zip b s'

  a <> b = let
    (r, _, _) = fuse a b
    in r

instance Debatable a => Semigroup (Strata a) where
  a <> b = mconcat [a,b]
  
instance Debatable a => Monoid (Strata a) where
  mempty = Strata []
  mconcat = Strata . rebuild . transpose . map getStrata where
    rebuild [] = []
    rebuild ([] : r) = rebuild r
    rebuild ([x] : r) = x : rebuild r
    rebuild ((x : y : s) : r) = let
      (f, p, q) = fuse x y
      r' = push p $ push q r
      in rebuild ((f: s): r')
    push (Front []) r = r
    push q [] = [[q]]
    push q (s : r) = ((q:s) : r)

getStrata :: Strata a -> [Front a]
getStrata (Strata l) = l