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