{-| Module  : WeakSets
Description : Homogeneous functions are functions between `HomogeneousSet`s. They are more flexible than Data.Map because they do not require the keys to be orderable.
Copyright   : Guillaume Sabbagh 2022
License     : LGPL-3.0-or-later
Maintainer  : guillaumesabbagh@protonmail.com
Stability   : experimental
Portability : portable

Homogeneous functions are functions between `HomogeneousSet`s.

They are more flexible than Data.Map because they do not require the keys to be orderable.

The datatype only assumes its keys are equatable, it is therefore slower than the Data.Map datatype.

We use this datatype because most of the datatypes we care about are not orderable.

Inline functions related to homogeneous functions are written between pipes @|@.

Function names should not collide with Prelude but may collide with Data.Map.
-}

module Data.WeakSets.HomogeneousFunction
(
    -- * Function datatype and smart constructor

    AssociationList(..),
    Function, -- abstract type, the smart constructor is `function`

    function, -- the smart constructor for `Function`

    -- * Function related functions

    domain,
    image,
    idFromSet,
    (|.|),
    -- * Query

    size,
    member,
    notMember,
    (|?|),
    (|!|),
    findWithDefault,
    -- * Construction

    -- ** Insertion

    insert,
    insertWith,
    insertWithKey,
    -- ** Delete/Update 

    delete,
    adjust,
    adjustWithKey,
    alter,
    -- * Combine

    -- ** Union

    union,
    -- * Traversal

    mapKeys,
    -- * Conversion 

    keys,
    elems,
    functionToSet,
    memorizeFunction,
)
where
    import              Data.WeakSets.HomogeneousSet
    
    -- | A function of homogeneous sets. It is a set of pairs (key,value) such that their should only be one pair with a given key.

    --

    -- It is an abstract type, the smart constructor is `function`.

    data Function k v = Function (Set (k,v)) deriving (Function k v -> Function k v -> Bool
(Function k v -> Function k v -> Bool)
-> (Function k v -> Function k v -> Bool) -> Eq (Function k v)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall k v. (Eq k, Eq v) => Function k v -> Function k v -> Bool
/= :: Function k v -> Function k v -> Bool
$c/= :: forall k v. (Eq k, Eq v) => Function k v -> Function k v -> Bool
== :: Function k v -> Function k v -> Bool
$c== :: forall k v. (Eq k, Eq v) => Function k v -> Function k v -> Bool
Eq)
    
    instance (Show k, Show v) => Show (Function k v) where
        show :: Function k v -> String
show (Function Set (k, v)
al) = String
"(function "String -> ShowS
forall a. [a] -> [a] -> [a]
++Set (k, v) -> String
forall a. Show a => a -> String
show Set (k, v)
alString -> ShowS
forall a. [a] -> [a] -> [a]
++String
")"
    
    instance Semigroup (Function k v) where
        (Function Set (k, v)
al1) <> :: Function k v -> Function k v -> Function k v
<> (Function Set (k, v)
al2) = Set (k, v) -> Function k v
forall k v. Set (k, v) -> Function k v
Function (Set (k, v) -> Function k v) -> Set (k, v) -> Function k v
forall a b. (a -> b) -> a -> b
$ Set (k, v)
al1 Set (k, v) -> Set (k, v) -> Set (k, v)
forall a. Semigroup a => a -> a -> a
<> Set (k, v)
al2
    
    instance Monoid (Function k v) where
        mempty :: Function k v
mempty = Set (k, v) -> Function k v
forall k v. Set (k, v) -> Function k v
Function ([(k, v)] -> Set (k, v)
forall a. [a] -> Set a
set [])
        
    instance Foldable (Function k) where
        foldr :: forall a b. (a -> b -> b) -> b -> Function k a -> b
foldr a -> b -> b
f b
d (Function Set (k, a)
al) = ((k, a) -> b -> b) -> b -> Set (k, a) -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (\(k
k,a
v) -> a -> b -> b
f a
v) b
d Set (k, a)
al

    instance Functor (Function k) where
        fmap :: forall a b. (a -> b) -> Function k a -> Function k b
fmap a -> b
f (Function Set (k, a)
al) = Set (k, b) -> Function k b
forall k v. Set (k, v) -> Function k v
Function (Set (k, b) -> Function k b) -> Set (k, b) -> Function k b
forall a b. (a -> b) -> a -> b
$ (\(k
k,a
v) -> (k
k,a -> b
f a
v)) ((k, a) -> (k, b)) -> Set (k, a) -> Set (k, b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Set (k, a)
al
    
    -- | An association list is a list of pairs (key,value).

    type AssociationList k v = [(k,v)]
    
    -- | /O(1)/. The smart constructor of functions. This is the only way of instantiating a `Function`.

    --

    -- Takes an association list and returns a function which maps to each key the value associated.

    --

    -- If several pairs have the same keys, they are kept until the user wants an association list back.

    function :: AssociationList k v -> Function k v
    function :: forall k v. AssociationList k v -> Function k v
function AssociationList k v
al = Set (k, v) -> Function k v
forall k v. Set (k, v) -> Function k v
Function (Set (k, v) -> Function k v) -> Set (k, v) -> Function k v
forall a b. (a -> b) -> a -> b
$ AssociationList k v -> Set (k, v)
forall a. [a] -> Set a
set (AssociationList k v -> Set (k, v))
-> AssociationList k v -> Set (k, v)
forall a b. (a -> b) -> a -> b
$ AssociationList k v
al
    
    -- | /O(n)/. Return the domain of a function.

    domain :: Function k v -> Set k
    domain :: forall k v. Function k v -> Set k
domain (Function Set (k, v)
al) = (k, v) -> k
forall a b. (a, b) -> a
fst ((k, v) -> k) -> Set (k, v) -> Set k
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Set (k, v)
al
    
    -- | /O(n)/. Return the image of a function. The image of a function is the set of values which are reachable by applying the function.

    image :: Function k v -> Set v
    image :: forall k v. Function k v -> Set v
image (Function Set (k, v)
al) = (k, v) -> v
forall a b. (a, b) -> b
snd ((k, v) -> v) -> Set (k, v) -> Set v
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Set (k, v)
al
    
    -- | /O(n)/. Return the identity function associated to a `Set`.

    idFromSet :: Set a -> Function a a
    idFromSet :: forall a. Set a -> Function a a
idFromSet Set a
set = Set (a, a) -> Function a a
forall k v. Set (k, v) -> Function k v
Function (Set (a, a) -> Function a a) -> Set (a, a) -> Function a a
forall a b. (a -> b) -> a -> b
$ (\a
x -> (a
x,a
x)) (a -> (a, a)) -> Set a -> Set (a, a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Set a
set
    
    -- | Compose two functions. If the two functions are not composable, strips the functions until they can compose.

    (|.|) :: (Eq a, Eq b) => Function b c -> Function a b -> Function a c
    |.| :: forall a b c.
(Eq a, Eq b) =>
Function b c -> Function a b -> Function a c
(|.|) Function b c
f2 Function a b
f1 = Set (a, c) -> Function a c
forall k v. Set (k, v) -> Function k v
Function (Set (a, c) -> Function a c) -> Set (a, c) -> Function a c
forall a b. (a -> b) -> a -> b
$ [(a, c)] -> Set (a, c)
forall a. [a] -> Set a
set [(a
k,(Function b c
f2 Function b c -> b -> c
forall k v. Eq k => Function k v -> k -> v
|!| (Function a b
f1 Function a b -> a -> b
forall k v. Eq k => Function k v -> k -> v
|!| a
k))) | a
k <- (Set a -> [a]
forall a. Eq a => Set a -> [a]
setToList(Set a -> [a]) -> (Function a b -> Set a) -> Function a b -> [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Function a b -> Set a
forall k v. Function k v -> Set k
domain (Function a b -> [a]) -> Function a b -> [a]
forall a b. (a -> b) -> a -> b
$ Function a b
f1), Function a b
f1 Function a b -> a -> b
forall k v. Eq k => Function k v -> k -> v
|!| a
k b -> Set b -> Bool
forall a. Eq a => a -> Set a -> Bool
`isIn` (Function b c -> Set b
forall k v. Function k v -> Set k
domain Function b c
f2)]
        
{--------------------------------------------------------------------
  Query
--------------------------------------------------------------------}
    
    -- | /O(n)/. The number of entries in the function.

    size :: (Eq k) => Function k v -> Int
    size :: forall k v. Eq k => Function k v -> Int
size Function k v
f = [k] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length([k] -> Int) -> (Function k v -> [k]) -> Function k v -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Set k -> [k]
forall a. Eq a => Set a -> [a]
setToList(Set k -> [k]) -> (Function k v -> Set k) -> Function k v -> [k]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Function k v -> Set k
forall k v. Function k v -> Set k
keys (Function k v -> Int) -> Function k v -> Int
forall a b. (a -> b) -> a -> b
$ Function k v
f
    
    -- | /O(n)/. Return wether a key is in the function domain or not.

    member :: (Eq k) => Function k v -> k -> Bool
    member :: forall k v. Eq k => Function k v -> k -> Bool
member Function k v
f k
k = k
k k -> Set k -> Bool
forall a. Eq a => a -> Set a -> Bool
`isIn` (Function k v -> Set k
forall k v. Function k v -> Set k
domain Function k v
f)
    
    -- | /O(n)/. Negation of member.

    notMember :: (Eq k) => Function k v -> k -> Bool
    notMember :: forall k v. Eq k => Function k v -> k -> Bool
notMember Function k v
f k
k = Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ Function k v -> k -> Bool
forall k v. Eq k => Function k v -> k -> Bool
member Function k v
f k
k
    
    -- | /O(n)/. Apply a function to a given value. If the function is not defined on the given value returns `Nothing`, otherwise returns `Just` the image.

    --

    -- This function is like `lookup` in Data.Map for function (the order of the argument are reversed though).

    (|?|) :: (Eq k) => Function k v -> k -> Maybe v
    |?| :: forall k v. Eq k => Function k v -> k -> Maybe v
(|?|) (Function Set (k, v)
al) k
key = Set v -> Maybe v
forall a. Set a -> Maybe a
setToMaybe(Set v -> Maybe v)
-> (Set (Maybe v) -> Set v) -> Set (Maybe v) -> Maybe v
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Set (Maybe v) -> Set v
forall a. Set (Maybe a) -> Set a
catMaybesToSet (Set (Maybe v) -> Maybe v) -> Set (Maybe v) -> Maybe v
forall a b. (a -> b) -> a -> b
$ (\(k
k,v
v) -> if k
k k -> k -> Bool
forall a. Eq a => a -> a -> Bool
== k
key then v -> Maybe v
forall a. a -> Maybe a
Just v
v else Maybe v
forall a. Maybe a
Nothing) ((k, v) -> Maybe v) -> Set (k, v) -> Set (Maybe v)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Set (k, v)
al
    
    -- | /O(n)/. Unsafe version of `(|?|)`.

    --

    -- This function is like `(!)` in Data.Map for function.

    (|!|) :: (Eq k) => Function k v -> k -> v
    |!| :: forall k v. Eq k => Function k v -> k -> v
(|!|) Function k v
f k
key
        | Maybe v -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null Maybe v
safeResult = String -> v
forall a. HasCallStack => String -> a
error String
"Function applied on a value not in the domain."
        | Bool
otherwise = v
result
        where
            safeResult :: Maybe v
safeResult = Function k v
f Function k v -> k -> Maybe v
forall k v. Eq k => Function k v -> k -> Maybe v
|?| k
key
            Just v
result = Maybe v
safeResult
    
    -- | /O(n)/. Apply a function to a given value, if the value is in the domain returns the image, otherwise return a default value.

    --

    -- This function is like `findWithDefault` in Data.Map for function (the order of the argument are reversed though).

    findWithDefault :: (Eq k) => Function k v -> v -> k -> v
    findWithDefault :: forall k v. Eq k => Function k v -> v -> k -> v
findWithDefault Function k v
f v
d k
key
        | Maybe v -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null Maybe v
safeResult = v
d
        | Bool
otherwise = v
result
        where
            safeResult :: Maybe v
safeResult = Function k v
f Function k v -> k -> Maybe v
forall k v. Eq k => Function k v -> k -> Maybe v
|?| k
key
            Just v
result = Maybe v
safeResult
            
{--------------------------------------------------------------------
  Insertion
--------------------------------------------------------------------}

    -- | O(1). Insert a new key and value in the function. If the key is already present in the function, the associated value is replaced with the supplied value. insert is equivalent to insertWith const. 

    insert :: k -> v -> Function k v -> Function k v
    insert :: forall k v. k -> v -> Function k v -> Function k v
insert k
k v
v (Function Set (k, v)
al) = Set (k, v) -> Function k v
forall k v. Set (k, v) -> Function k v
Function (Set (k, v) -> Function k v) -> Set (k, v) -> Function k v
forall a b. (a -> b) -> a -> b
$ ([(k, v)] -> Set (k, v)
forall a. [a] -> Set a
set [(k
k,v
v)]) Set (k, v) -> Set (k, v) -> Set (k, v)
forall a. Set a -> Set a -> Set a
||| Set (k, v)
al
    
    -- | O(n). Insert with a function, combining new value and old value. insertWith f key value mp will insert the pair (key, value) into mp if key does not exist in the function. If the key does exist, the function will insert the pair (key, f new_value old_value). 

    insertWith :: (Eq k) => (v -> v -> v) -> k -> v -> Function k v -> Function k v
    insertWith :: forall k v.
Eq k =>
(v -> v -> v) -> k -> v -> Function k v -> Function k v
insertWith v -> v -> v
comb k
k v
v Function k v
f
        | Maybe v -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null Maybe v
prev = k -> v -> Function k v -> Function k v
forall k v. k -> v -> Function k v -> Function k v
insert k
k v
v Function k v
f
        | Bool
otherwise = k -> v -> Function k v -> Function k v
forall k v. k -> v -> Function k v -> Function k v
insert k
k (v -> v -> v
comb v
v v
prev_value) Function k v
f
        where
            prev :: Maybe v
prev = Function k v
f Function k v -> k -> Maybe v
forall k v. Eq k => Function k v -> k -> Maybe v
|?| k
k
            Just v
prev_value = Maybe v
prev

    -- | O(n). Insert with a function, combining key, new value and old value. insertWithKey f key value mp will insert the pair (key, value) into mp if key does not exist in the function. If the key does exist, the function will insert the pair (key,f key new_value old_value). Note that the key passed to f is the same key passed to insertWithKey. 

    insertWithKey :: Eq k => (k -> a -> a -> a) -> k -> a -> Function k a -> Function k a
    insertWithKey :: forall k a.
Eq k =>
(k -> a -> a -> a) -> k -> a -> Function k a -> Function k a
insertWithKey k -> a -> a -> a
comb k
k a
v Function k a
f
        | Maybe a -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null Maybe a
prev = k -> a -> Function k a -> Function k a
forall k v. k -> v -> Function k v -> Function k v
insert k
k a
v Function k a
f
        | Bool
otherwise = k -> a -> Function k a -> Function k a
forall k v. k -> v -> Function k v -> Function k v
insert k
k (k -> a -> a -> a
comb k
k a
v a
prev_value) Function k a
f
        where
            prev :: Maybe a
prev = Function k a
f Function k a -> k -> Maybe a
forall k v. Eq k => Function k v -> k -> Maybe v
|?| k
k
            Just a
prev_value = Maybe a
prev

{--------------------------------------------------------------------
  Conversion
--------------------------------------------------------------------}

    -- | /O(n)/. Transform a function back into its underlying association list.

    functionToSet :: (Eq k) => Function k v -> Set (k,v)
    functionToSet :: forall k v. Eq k => Function k v -> Set (k, v)
functionToSet (Function Set (k, v)
al) = ((k, v) -> (k, v) -> Bool) -> Set (k, v) -> Set (k, v)
forall a. (a -> a -> Bool) -> Set a -> Set a
nubSetBy (\(k, v)
x (k, v)
y -> ((k, v) -> k
forall a b. (a, b) -> a
fst (k, v)
x) k -> k -> Bool
forall a. Eq a => a -> a -> Bool
== ((k, v) -> k
forall a b. (a, b) -> a
fst (k, v)
y)) Set (k, v)
al

    -- | /O(n)/. Alias of domain.

    keys :: Function k v -> Set k
    keys :: forall k v. Function k v -> Set k
keys = Function k v -> Set k
forall k v. Function k v -> Set k
domain
    
    -- | /O(n)/. Alias of image.

    elems :: Function k v -> Set v
    elems :: forall k v. Function k v -> Set v
elems = Function k v -> Set v
forall k v. Function k v -> Set v
image

    -- | /O(n)/. Memorize a Haskell function on a given finite domain.

    memorizeFunction :: (k -> v) -> Set k -> Function k v
    memorizeFunction :: forall k v. (k -> v) -> Set k -> Function k v
memorizeFunction k -> v
f Set k
xs = Set (k, v) -> Function k v
forall k v. Set (k, v) -> Function k v
Function (Set (k, v) -> Function k v) -> Set (k, v) -> Function k v
forall a b. (a -> b) -> a -> b
$ (\k
k -> (k
k, k -> v
f k
k)) (k -> (k, v)) -> Set k -> Set (k, v)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Set k
xs
    
{--------------------------------------------------------------------
  Delete/Update 
--------------------------------------------------------------------}
    -- | O(n). Delete a key and its value from the function. When the key is not a member of the function, the original function is returned. 

    delete :: Eq k => k -> Function k a -> Function k a
    delete :: forall k a. Eq k => k -> Function k a -> Function k a
delete k
key (Function Set (k, a)
al) = Set (k, a) -> Function k a
forall k v. Set (k, v) -> Function k v
Function (Set (k, a) -> Function k a) -> Set (k, a) -> Function k a
forall a b. (a -> b) -> a -> b
$ ((k, a) -> Bool) -> Set (k, a) -> Set (k, a)
forall a. (a -> Bool) -> Set a -> Set a
filterSet (\(k
k,a
v) -> k
key k -> k -> Bool
forall a. Eq a => a -> a -> Bool
/= k
k) Set (k, a)
al
    
    -- | O(n). Update a value at a specific key with the result of the provided function. When the key is not a member of the function, the original function is returned. 

    adjust :: Eq k => (a -> a) -> k -> Function k a -> Function k a
    adjust :: forall k a. Eq k => (a -> a) -> k -> Function k a -> Function k a
adjust a -> a
func k
key (Function Set (k, a)
al) = Set (k, a) -> Function k a
forall k v. Set (k, v) -> Function k v
Function (Set (k, a) -> Function k a) -> Set (k, a) -> Function k a
forall a b. (a -> b) -> a -> b
$ (\(k
k,a
v) -> if k
key k -> k -> Bool
forall a. Eq a => a -> a -> Bool
== k
k then (k
k, a -> a
func a
v) else (k
k,a
v)) ((k, a) -> (k, a)) -> Set (k, a) -> Set (k, a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Set (k, a)
al
    
    -- | O(n). Adjust a value at a specific key. When the key is not a member of the function, the original function is returned. 

    adjustWithKey :: Eq k => (k -> a -> a) -> k -> Function k a -> Function k a
    adjustWithKey :: forall k a.
Eq k =>
(k -> a -> a) -> k -> Function k a -> Function k a
adjustWithKey k -> a -> a
func k
key (Function Set (k, a)
al) = Set (k, a) -> Function k a
forall k v. Set (k, v) -> Function k v
Function (Set (k, a) -> Function k a) -> Set (k, a) -> Function k a
forall a b. (a -> b) -> a -> b
$ (\(k
k,a
v) -> if k
key k -> k -> Bool
forall a. Eq a => a -> a -> Bool
== k
k then (k
k, k -> a -> a
func k
k a
v) else (k
k,a
v)) ((k, a) -> (k, a)) -> Set (k, a) -> Set (k, a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Set (k, a)
al
    
    -- | O(n). The expression (`alter` f k function) alters the value x at k, or absence thereof. alter can be used to insert, delete, or update a value in a `Function`. In short : `lookup` k (`alter` f k m) = f (`lookup` k m). 

    alter :: Eq k => (Maybe a -> Maybe a) -> k -> Function k a -> Function k a
    alter :: forall k a.
Eq k =>
(Maybe a -> Maybe a) -> k -> Function k a -> Function k a
alter Maybe a -> Maybe a
func k
key Function k a
f
        | Maybe a -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null Maybe a
lookupKey = k -> a -> Function k a -> Function k a
forall k v. k -> v -> Function k v -> Function k v
insert k
key a
unpackedImageNothing Function k a
f
        | Maybe a -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null Maybe a
result = k -> Function k a -> Function k a
forall k a. Eq k => k -> Function k a -> Function k a
delete k
key Function k a
f
        | Bool
otherwise = (a -> a) -> k -> Function k a -> Function k a
forall k a. Eq k => (a -> a) -> k -> Function k a -> Function k a
adjust (a -> a -> a
forall a b. a -> b -> a
const a
unpackedResult) k
key Function k a
f
        where
            lookupKey :: Maybe a
lookupKey = Function k a
f Function k a -> k -> Maybe a
forall k v. Eq k => Function k v -> k -> Maybe v
|?| k
key
            result :: Maybe a
result = Maybe a -> Maybe a
func Maybe a
lookupKey
            Just a
unpackedResult = Maybe a
result
            Just a
unpackedImageNothing = Maybe a -> Maybe a
func Maybe a
forall a. Maybe a
Nothing
            
    -- | /O(n)/. Map a function over the keys of a function.

    mapKeys :: (k1 -> k2) -> Function k1 v -> Function k2 v
    mapKeys :: forall k1 k2 v. (k1 -> k2) -> Function k1 v -> Function k2 v
mapKeys k1 -> k2
f (Function Set (k1, v)
al) = Set (k2, v) -> Function k2 v
forall k v. Set (k, v) -> Function k v
Function (Set (k2, v) -> Function k2 v) -> Set (k2, v) -> Function k2 v
forall a b. (a -> b) -> a -> b
$ (\(k1
k,v
v) -> (k1 -> k2
f k1
k,v
v)) ((k1, v) -> (k2, v)) -> Set (k1, v) -> Set (k2, v)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Set (k1, v)
al
    
    
    -- | /O(n)/. The expression (`union` t1 t2) takes the left-biased union of t1 and t2. It prefers t1 when duplicate keys are encountered. 

    union :: Eq k => Function k a -> Function k a -> Function k a
    union :: forall k a. Eq k => Function k a -> Function k a -> Function k a
union (Function Set (k, a)
al1) (Function Set (k, a)
al2) = Set (k, a) -> Function k a
forall k v. Set (k, v) -> Function k v
Function (Set (k, a) -> Function k a) -> Set (k, a) -> Function k a
forall a b. (a -> b) -> a -> b
$ Set (k, a)
al1 Set (k, a) -> Set (k, a) -> Set (k, a)
forall a. Set a -> Set a -> Set a
||| Set (k, a)
al2