Data.Set.NonTransitive

module Data.Set.NonTransitive where

-- | A class for non-transitive equalities, e.g. x == y and y == z doesn't imply x == z.
class NonTransEq a where
  nonTransEq :: a -> a -> Bool

newtype Set a = Set { toList :: [a] }
  deriving Show

instance (NonTransEq a, Semigroup a) => Semigroup (Set a) where
  as <> Set bs = foldr insert as bs

instance (NonTransEq a, Semigroup a) => Monoid (Set a) where
  mempty = Set []
                                                                                                                                                                                  fromList :: NonTransEq a => Semigroup a => [a] -> Set a                                                                                                                           fromList = foldr insert (Set [])                                                                                                                                                                                                                                                                                                                                    fromListWith :: Semigroup a => (a -> a -> Bool) -> [a] -> Set a                                                                                                                   fromListWith f = foldr (insertWith f) (Set [])                                                                                                                                                                                                                                                                                                                      insertWith :: Semigroup a => (a -> a -> Bool) -> a -> Set a -> Set a                                                                                                              insertWith eq x (Set (a:as))                                                                                                                                                        | x `eq` a = insertWith eq (x <> a) (Set as)                                                                                                                                      | otherwise = Set (a:toList (insertWith eq x (Set as)))                                                                                                                         insertWith _ x (Set []) = Set [x]
insert :: Semigroup a => NonTransEq a => a -> Set a -> Set a
insert = insertWith nonTransEq