{-| Module  : FiniteCategories
Description : The type for association lists.
Copyright   : Guillaume Sabbagh 2021
License     : GPL-3
Maintainer  : guillaumesabbagh@protonmail.com
Stability   : experimental
Portability : portable

The type for association lists.

It is used when the 'Ord' constraint of `Data.Map` is too restrictive.
-}

module Utils.AssociationList
(
    AssociationList,
    keys,
    values,
    (!-),
    (!-!),
    (!-?),
    (!-.),
    mkAssocListIdentity,
    enumAssocLists,
    functToAssocList,
    assocListToFunct,
    inverse,
    removeKey,
    removeValue,
)
where
    import Utils.CartesianProduct
    import Data.Tuple (swap)
    
    -- | The type of association lists (a list of couples).

    type AssociationList a b = [(a, b)]
    
    -- | Returns the keys of the association list.

    keys :: (AssociationList a b) -> [a]
    keys :: forall a b. AssociationList a b -> [a]
keys = ((a, b) -> a) -> [(a, b)] -> [a]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (a, b) -> a
forall a b. (a, b) -> a
fst
    
    -- | Returns the values of the association list.

    values :: (AssociationList a b) -> [b]
    values :: forall a b. AssociationList a b -> [b]
values = ((a, b) -> b) -> [(a, b)] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (a, b) -> b
forall a b. (a, b) -> b
snd
    
    -- | If the key is in the association list, returns Just the value associated, otherwise Nothing.

    --

    -- Same as lookup in `Data.Map`.

    (!-) :: (Eq a) => a -> (AssociationList a b) -> Maybe b
    !- :: forall a b. Eq a => a -> AssociationList a b -> Maybe b
(!-) a
_ [] = Maybe b
forall a. Maybe a
Nothing
    (!-) a
k ((a
a,b
b):[(a, b)]
xs)
        | a
a a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
k = b -> Maybe b
forall a. a -> Maybe a
Just b
b
        | Bool
otherwise = a
k a -> [(a, b)] -> Maybe b
forall a b. Eq a => a -> AssociationList a b -> Maybe b
!- [(a, b)]
xs
        
    -- | If the key is in the association list, returns the value associated, otherwise throws an error.

    --

    -- Same as (!) in `Data.Map`.

    (!-!) :: (Eq a) => (AssociationList a b) -> a -> b
    !-! :: forall a b. Eq a => AssociationList a b -> a -> b
(!-!) [] a
_ = [Char] -> b
forall a. HasCallStack => [Char] -> a
error [Char]
"Key not in association list."
    (!-!) ((a
a,b
b):[(a, b)]
xs) a
k
        | a
a a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
k = b
b
        | Bool
otherwise = [(a, b)]
xs [(a, b)] -> a -> b
forall a b. Eq a => AssociationList a b -> a -> b
!-! a
k
      
    -- | If the key is in the association list, returns the value associated, otherwise returns a default value.

    --

    -- Same as /findWithDefault/ in `Data.Map`.      

    (!-?) :: (Eq a) => b -> a -> (AssociationList a b) -> b
    !-? :: forall a b. Eq a => b -> a -> AssociationList a b -> b
(!-?) b
d a
_ [] = b
d
    (!-?) b
d a
k ((a
a,b
b):[(a, b)]
xs)
        | a
a a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
k = b
b
        | Bool
otherwise = b -> a -> [(a, b)] -> b
forall a b. Eq a => b -> a -> AssociationList a b -> b
(!-?) b
d a
k [(a, b)]
xs
                               
    -- | Composition of association lists.

    (!-.) :: (Eq a, Eq b) => (AssociationList b c) -> (AssociationList a b) -> (AssociationList a c)
    !-. :: forall a b c.
(Eq a, Eq b) =>
AssociationList b c -> AssociationList a b -> AssociationList a c
(!-.) AssociationList b c
al2 AssociationList a b
al1 = [(a
k, AssociationList b c
al2 AssociationList b c -> b -> c
forall a b. Eq a => AssociationList a b -> a -> b
!-! (AssociationList a b
al1 AssociationList a b -> a -> b
forall a b. Eq a => AssociationList a b -> a -> b
!-! a
k)) | a
k <- AssociationList a b -> [a]
forall a b. AssociationList a b -> [a]
keys AssociationList a b
al1, b -> [b] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem (AssociationList a b
al1 AssociationList a b -> a -> b
forall a b. Eq a => AssociationList a b -> a -> b
!-! a
k) (AssociationList b c -> [b]
forall a b. AssociationList a b -> [a]
keys AssociationList b c
al2)]
    
    -- | Constructs the identity association list of a list of values.

    -- 

    -- For example, @ mkAssocListIdentity [1,2,3] = [(1,1),(2,2),(3,3)]@

    mkAssocListIdentity :: [a] -> AssociationList a a
    mkAssocListIdentity :: forall a. [a] -> AssociationList a a
mkAssocListIdentity [a]
xs = [(a
o,a
o) | a
o <- [a]
xs]
    
    -- | Enumerates all association lists possible between a domain and a codomain.

    enumAssocLists :: [a] -> [b] -> [AssociationList a b]
    enumAssocLists :: forall a b. [a] -> [b] -> [AssociationList a b]
enumAssocLists [a]
dom [b]
codom = [[a] -> [b] -> AssociationList a b
forall a b. [a] -> [b] -> [(a, b)]
zip [a]
dom [b]
im | [b]
im <- ([b]
codom [b] -> Int -> [[b]]
forall {a}. [a] -> Int -> [[a]]
|^| ([a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
dom))]
    
    -- | Transforms a function and a domain into an association list.

    functToAssocList :: (a -> b) -> [a] -> (AssociationList a b)
    functToAssocList :: forall a b. (a -> b) -> [a] -> AssociationList a b
functToAssocList a -> b
f [a]
d = [(a
o, a -> b
f a
o) | a
o <- [a]
d]
    
    -- | Transforms an association list to a function.

    assocListToFunct :: (Eq a) => (AssociationList a b) -> a -> b
    assocListToFunct :: forall a b. Eq a => AssociationList a b -> a -> b
assocListToFunct [] a
_ = [Char] -> b
forall a. HasCallStack => [Char] -> a
error [Char]
"Can't transform an empty list into a function."
    assocListToFunct ((a
k,b
v):[(a, b)]
xs) a
x
        | a
k a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
x = b
v
        | Bool
otherwise = [(a, b)] -> a -> b
forall a b. Eq a => AssociationList a b -> a -> b
assocListToFunct [(a, b)]
xs a
x
        
    -- | Inverse of an association list

    inverse :: (AssociationList a b) -> (AssociationList b a)
    inverse :: forall a b. AssociationList a b -> AssociationList b a
inverse AssociationList a b
kvs = (a, b) -> (b, a)
forall a b. (a, b) -> (b, a)
swap ((a, b) -> (b, a)) -> AssociationList a b -> [(b, a)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> AssociationList a b
kvs
    
    -- | Remove all couples with a certain key

    removeKey :: (Eq a) => (AssociationList a b) -> a -> (AssociationList a b)
    removeKey :: forall a b. Eq a => AssociationList a b -> a -> AssociationList a b
removeKey AssociationList a b
al a
key = [(a, b)
c | c :: (a, b)
c@(a
k,b
_) <- AssociationList a b
al, a
k a -> a -> Bool
forall a. Eq a => a -> a -> Bool
/= a
key]
    
    -- | Remove all couples with a certain value

    removeValue :: (Eq b) => (AssociationList a b) -> b -> (AssociationList a b)
    removeValue :: forall b a. Eq b => AssociationList a b -> b -> AssociationList a b
removeValue AssociationList a b
al b
value = [(a, b)
c | c :: (a, b)
c@(a
_,b
v) <- AssociationList a b
al, b
v b -> b -> Bool
forall a. Eq a => a -> a -> Bool
/= b
value]