{-| Module  : FiniteCategories
Description : Utilitary functions for sets with list as underlying representation.
Copyright   : Guillaume Sabbagh 2021
License     : GPL-3
Maintainer  : guillaumesabbagh@protonmail.com
Stability   : experimental
Portability : portable

Utilitary functions for sets with list as underlying representation.

It has the advantage of not requiring the Ord typeclass at all.
-}

module Utils.SetList
(
    isIncludedIn,
    doubleInclusion,
    powerList
) where
    -- | Returns a boolean indicating if the set of elements of a list are included in an another.

    isIncludedIn :: (Eq a) => [a] -> [a] -> Bool
    [] isIncludedIn :: forall a. Eq a => [a] -> [a] -> Bool
`isIncludedIn` [a]
_ = Bool
True
    (a
x:[a]
xs) `isIncludedIn` [a]
l2
        | a
x a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [a]
l2 = [a]
xs [a] -> [a] -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isIncludedIn` [a]
l2
        | Bool
otherwise = Bool
False
        
    -- | Returns a boolean indicating if the set of elements of two lists are equal.

    doubleInclusion :: (Eq a) => [a] -> [a] -> Bool
    [a]
l1 doubleInclusion :: forall a. Eq a => [a] -> [a] -> Bool
`doubleInclusion` [a]
l2 = ([a]
l1 [a] -> [a] -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isIncludedIn` [a]
l2) Bool -> Bool -> Bool
&& ([a]
l2 [a] -> [a] -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isIncludedIn` [a]
l1)
    
    -- | Returns the list of all sublists of a list.

    powerList :: (Eq a) => [a] -> [[a]]
    powerList :: forall a. Eq a => [a] -> [[a]]
powerList [] = [[]]
    powerList (a
x:[a]
xs) = ([a] -> [[a]]
forall a. Eq a => [a] -> [[a]]
powerList [a]
xs) [[a]] -> [[a]] -> [[a]]
forall a. [a] -> [a] -> [a]
++ ((a
xa -> [a] -> [a]
forall a. a -> [a] -> [a]
:) ([a] -> [a]) -> [[a]] -> [[a]]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ([a] -> [[a]]
forall a. Eq a => [a] -> [[a]]
powerList [a]
xs))