{-# LANGUAGE DefaultSignatures #-}

-- | This module exposes the base class used to power multimap functionality. You should not need to
-- be aware of it unless you are interested in adding a new specific multimap type.
module Data.Multimap.Collection (
  Collection(..)
) where

import Prelude hiding (filter)
import qualified Prelude as Prelude

import Data.Foldable (foldl')
import Data.Sequence (Seq)
import qualified Data.Sequence as Seq
import Data.Set (Set)
import qualified Data.Set as Set

-- | A lower bound for multimap values. By creating an instance of this class, you can use multimap
-- operations with a custom type. An alternative could have been to use 'Applicative' but that would
-- have precluded common implementations like 'Set'.
class Foldable c => Collection c where
  -- | Creates a singleton collection.
  singleton :: v -> c v
  default singleton :: Applicative c => v -> c v
  singleton = v -> c v
forall (f :: * -> *) a. Applicative f => a -> f a
pure

  filter :: (v -> Bool) -> c v -> c v

  -- | Returns the size of the collection. The default implementation folds over the entire
  -- structure and is /O(n)/.
  size :: c v -> Int
  size = (Int -> v -> Int) -> Int -> c v -> Int
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (\Int
n v
_ -> Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) Int
0

  -- | Checks whether the collection is empty. The default implementation lazily folds over the
  -- structure.
  null :: c v -> Bool
  null = (v -> Bool -> Bool) -> Bool -> c v -> Bool
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (\v
_ Bool
_ -> Bool
False) Bool
True

instance Collection [] where
  filter :: (v -> Bool) -> [v] -> [v]
filter = (v -> Bool) -> [v] -> [v]
forall v. (v -> Bool) -> [v] -> [v]
Prelude.filter

instance Collection Seq where
  size :: Seq v -> Int
size = Seq v -> Int
forall v. Seq v -> Int
Seq.length
  filter :: (v -> Bool) -> Seq v -> Seq v
filter = (v -> Bool) -> Seq v -> Seq v
forall v. (v -> Bool) -> Seq v -> Seq v
Seq.filter
  null :: Seq v -> Bool
null = Seq v -> Bool
forall v. Seq v -> Bool
Seq.null

instance Collection Set where
  singleton :: v -> Set v
singleton = v -> Set v
forall v. v -> Set v
Set.singleton
  filter :: (v -> Bool) -> Set v -> Set v
filter = (v -> Bool) -> Set v -> Set v
forall v. (v -> Bool) -> Set v -> Set v
Set.filter
  size :: Set v -> Int
size = Set v -> Int
forall v. Set v -> Int
Set.size
  null :: Set v -> Bool
null = Set v -> Bool
forall v. Set v -> Bool
Set.null