+ class Debatable a where
+ weigh :: a -> a -> Comparison
+
+ newtype OrdDebatable a = OrdDebatable a deriving (Ord, Eq)
+
+ instance Ord a => Debatable (OrdDebatable a) where
+ weigh (OrdDebatable a) (OrdDebatable b) = case compare a b of
+ LT -> Dominates
+ GT -> Dominated
+ EQ -> WeakTie
+
+ deriving via OrdDebatable Int instance Debatable Int
+ deriving via OrdDebatable Integer instance Debatable Integer
+ deriving via OrdDebatable Double instance Debatable Double
+ deriving via OrdDebatable Float instance Debatable Float
+
+ instance Debatable a => Debatable (Down a) where
+ weigh (Down a) (Down b) = case weigh a b of
+ Dominates -> Dominated
+ Dominated -> Dominates
+ r -> r
+
+ instance (Debatable a, Debatable b) => Debatable (a,b) where
+ weigh ~(a1,a2) ~(b1,b2) = weigh a1 b1 <> weigh a2 b2
+
+ newtype Front a = Front [a] deriving (Show)
+
+ singleton :: a -> Front a
+ singleton a = Front [a]
+
+ instance Debatable a => Semigroup (Front a) where
+ 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'
+
+ instance Debatable a => Monoid (Front a) where
+ mempty = Front []
+
+ getFront :: Front a -> [a]
+ getFront (Front l) = l