module Data.Difference (Difference (..), negate) where import qualified "base" Prelude as Base import qualified "base" Data.Monoid as Base data Difference a = Neg a | Zero | Pos a deriving (Foldable, Functor, Traversable, Base.Eq, Show) instance PartialEq a => PartialEq (Difference a) where (≡) = Base.getAny ∘∘ getConst ∘∘ liftCompare' (Const ∘∘ Base.Any ∘∘ (≡)) instance Preord a => Preord (Difference a) where Neg a ≤ Neg b = b ≤ a Neg _ ≤ _ = True _ ≤ Neg _ = False Pos a ≤ Pos b = a ≤ b Pos _ ≤ _ = False _ ≤ Pos _ = True Zero ≤ Zero = True instance PartialOrd a => PartialOrd (Difference a) where tryCompare = liftCompare' tryCompare instance Eq a => Eq (Difference a) instance Ord a => Ord (Difference a) where compare = runIdentity ∘∘ liftCompare' (Identity ∘∘ compare) instance Base.Ord a => Base.Ord (Difference a) where compare = runIdentity ∘∘ liftCompare' (Identity ∘∘ Base.compare) liftCompare' :: Applicative f => (a -> b -> f Ordering) -> Difference a -> Difference b -> f Ordering liftCompare' cmp = curry $ \ case (Neg a, Neg b) -> op <$> cmp a b (Neg _, _) -> pure LT (_, Neg _) -> pure GT (Pos a, Pos b) -> cmp a b (Pos _, _) -> pure GT (_, Pos _) -> pure LT (Zero, Zero) -> pure EQ where op = \ case LT -> GT; GT -> LT; EQ -> EQ instance Applicative Difference where pure = Pos Zero <*> _ = Zero Neg f <*> x = negate (f <$> x) Pos f <*> x = id (f <$> x) negate :: Difference a -> Difference a negate = \ case Zero -> Zero Neg a -> Pos a Pos a -> Neg a