{-# LANGUAGE CPP #-}

-- | Data structure for describing selections of values

module Data.Selection
  ( Selection
  , includes
  , selectBy
  , empty
  , universal
  , select
  , union
  , intersection
  , difference
  , allExcept
  ) where



-- | Selection: description of a set of values
data Selection a = Selection (a -> Bool)

#if MIN_VERSION_base(4,11,0)
instance Semigroup (Selection a)
  where
    <> :: Selection a -> Selection a -> Selection a
(<>) = Selection a -> Selection a -> Selection a
forall a. Selection a -> Selection a -> Selection a
union
#endif

-- |
-- @
-- `mempty`  = `empty`
-- `mappend` = `union`
-- @
instance Monoid (Selection a)
  where
    mempty :: Selection a
mempty  = Selection a
forall a. Selection a
empty
    mappend :: Selection a -> Selection a -> Selection a
mappend = Selection a -> Selection a -> Selection a
forall a. Semigroup a => a -> a -> a
(<>)

-- | Check whether a value is included in a selection
includes :: Selection a -> a -> Bool
includes :: Selection a -> a -> Bool
includes (Selection a -> Bool
p) = a -> Bool
p

-- | Select the values that fulfill a predicate
selectBy :: (a -> Bool) -> Selection a
selectBy :: (a -> Bool) -> Selection a
selectBy = (a -> Bool) -> Selection a
forall a. (a -> Bool) -> Selection a
Selection

-- | Empty selection
empty :: Selection a
empty :: Selection a
empty = (a -> Bool) -> Selection a
forall a. (a -> Bool) -> Selection a
Selection ((a -> Bool) -> Selection a) -> (a -> Bool) -> Selection a
forall a b. (a -> b) -> a -> b
$ \a
_ -> Bool
False

-- | Select all values
universal :: Selection a
universal :: Selection a
universal = (a -> Bool) -> Selection a
forall a. (a -> Bool) -> Selection a
Selection ((a -> Bool) -> Selection a) -> (a -> Bool) -> Selection a
forall a b. (a -> b) -> a -> b
$ \a
_ -> Bool
True

-- | Union of selections
union :: Selection a -> Selection a -> Selection a
union :: Selection a -> Selection a -> Selection a
union Selection a
s Selection a
t = (a -> Bool) -> Selection a
forall a. (a -> Bool) -> Selection a
Selection ((a -> Bool) -> Selection a) -> (a -> Bool) -> Selection a
forall a b. (a -> b) -> a -> b
$ \a
a -> Selection a -> a -> Bool
forall a. Selection a -> a -> Bool
includes Selection a
s a
a Bool -> Bool -> Bool
|| Selection a -> a -> Bool
forall a. Selection a -> a -> Bool
includes Selection a
t a
a

-- | Intersection of selections
intersection :: Selection a -> Selection a -> Selection a
intersection :: Selection a -> Selection a -> Selection a
intersection Selection a
s Selection a
t = (a -> Bool) -> Selection a
forall a. (a -> Bool) -> Selection a
Selection ((a -> Bool) -> Selection a) -> (a -> Bool) -> Selection a
forall a b. (a -> b) -> a -> b
$ \a
a -> Selection a -> a -> Bool
forall a. Selection a -> a -> Bool
includes Selection a
s a
a Bool -> Bool -> Bool
&& Selection a -> a -> Bool
forall a. Selection a -> a -> Bool
includes Selection a
t a
a

-- | Difference of selections
difference :: Selection a -> Selection a -> Selection a
difference :: Selection a -> Selection a -> Selection a
difference Selection a
s Selection a
t = (a -> Bool) -> Selection a
forall a. (a -> Bool) -> Selection a
Selection ((a -> Bool) -> Selection a) -> (a -> Bool) -> Selection a
forall a b. (a -> b) -> a -> b
$ \a
a -> Selection a -> a -> Bool
forall a. Selection a -> a -> Bool
includes Selection a
s a
a Bool -> Bool -> Bool
&& Bool -> Bool
not (Selection a -> a -> Bool
forall a. Selection a -> a -> Bool
includes Selection a
t a
a)

-- | Create a classification from a list of elements
select :: Eq a => [a] -> Selection a
select :: [a] -> Selection a
select [a]
as = (a -> Bool) -> Selection a
forall a. (a -> Bool) -> Selection a
selectBy (a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [a]
as)

-- | Select all values except those in the given list
allExcept :: Eq a => [a] -> Selection a
allExcept :: [a] -> Selection a
allExcept = Selection a -> Selection a -> Selection a
forall a. Selection a -> Selection a -> Selection a
difference Selection a
forall a. Selection a
universal (Selection a -> Selection a)
-> ([a] -> Selection a) -> [a] -> Selection a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [a] -> Selection a
forall a. Eq a => [a] -> Selection a
select