{-| Module  : FiniteCategories
Description : Enumerate all maps between two lists.
Copyright   : Guillaume Sabbagh 2021
License     : GPL-3
Maintainer  : guillaumesabbagh@protonmail.com
Stability   : experimental
Portability : portable

Enumerate all maps between two lists.
-}
module Utils.EnumerateMaps
(
    enumMaps
)
where
    import Utils.CartesianProduct
    import Utils.AssociationList
    
    -- | Returns all association lists from a domain to a codomain.

    enumMaps :: [a] -- ^ Domain.

             -> [b] -- ^ Codomain.

             -> [AssociationList a b] -- ^ All association lists from domain to codomain.

    enumMaps :: forall a b. [a] -> [b] -> [AssociationList a b]
enumMaps [a]
dom [b]
codom = [a] -> [b] -> [(a, b)]
forall a b. [a] -> [b] -> [(a, b)]
zip [a]
dom ([b] -> [(a, b)]) -> [[b]] -> [[(a, b)]]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [b]
codom [b] -> Int -> [[b]]
forall {a}. [a] -> Int -> [[a]]
|^| ([a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
dom)