{-# LANGUAGE DefaultSignatures #-}
{-# LANGUAGE KindSignatures #-}

{-|
Module      : Data.JoinSemilattice.Class.Abs
Description : Relationships between values and their absolutes.
Copyright   : (c) Tom Harding, 2020
License     : MIT
-}
module Data.JoinSemilattice.Class.Abs where

import Data.Hashable (Hashable)
import Data.JoinSemilattice.Class.Merge (Merge)
import Data.JoinSemilattice.Defined (Defined)
import Data.JoinSemilattice.Intersect (Intersect)
import qualified Data.JoinSemilattice.Intersect as Intersect
import Data.Kind (Type)

-- | Unlike the 'abs' we know, which is a /function/ from a value to its
-- absolute value, 'absR' is a /relationship/ between a value and its absolute.
--
-- For some types, while we can't truly reverse the `abs` function, we can say
-- that there are two /possible/ inputs to consider, and so we can push /some/
-- information in the reverse direction.
class Merge x => AbsR (x :: Type) where

  -- | Given a value and its absolute, try to learn something in either
  -- direction.
  absR :: ( x, x ) -> ( x, x )

  -- | By default, this relationship is one-way.
  default absR :: Num x => ( x, x ) -> ( x, x )
  absR ( x
x, x
_ ) = ( x
forall a. Monoid a => a
mempty, x -> x
forall a. Num a => a -> a
abs x
x )

instance (Eq x, Num x) => AbsR (Defined x)

instance (Bounded x, Enum x, Ord x, Hashable x, Num x)
    => AbsR (Intersect x) where
  absR :: (Intersect x, Intersect x) -> (Intersect x, Intersect x)
absR ( Intersect x
x, Intersect x
y ) = ( Intersect x -> Intersect x -> Intersect x
forall x.
Intersectable x =>
Intersect x -> Intersect x -> Intersect x
Intersect.union Intersect x
y (Intersect x -> Intersect x
forall a. Num a => a -> a
negate Intersect x
y), Intersect x -> Intersect x
forall a. Num a => a -> a
abs Intersect x
x )