{-# LANGUAGE CPP #-}
module ProjectM36.AttributeNames where
import ProjectM36.Base
import qualified Data.Set as S
#if MIN_VERSION_base(4,20,0)
#else
import Data.Foldable (foldl')
#endif
--AttributeNames is a data structure which can represent inverted projection attributes and attribute names derived from relational expressions

empty :: AttributeNamesBase a
empty :: forall a. AttributeNamesBase a
empty = forall a. Set AttributeName -> AttributeNamesBase a
AttributeNames forall a. Set a
S.empty

all :: AttributeNamesBase a
all :: forall a. AttributeNamesBase a
all = forall a. Set AttributeName -> AttributeNamesBase a
InvertedAttributeNames forall a. Set a
S.empty

-- | Coalesce a bunch of AttributeNames into a single AttributeNames.
some :: Eq a => [AttributeNamesBase a] -> AttributeNamesBase a
some :: forall a. Eq a => [AttributeNamesBase a] -> AttributeNamesBase a
some [] = forall a. AttributeNamesBase a
ProjectM36.AttributeNames.all
some [AttributeNamesBase a
an] = AttributeNamesBase a
an
some (AttributeNamesBase a
a:[AttributeNamesBase a]
as) = forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' forall a.
Eq a =>
AttributeNamesBase a
-> AttributeNamesBase a -> AttributeNamesBase a
folder AttributeNamesBase a
a [AttributeNamesBase a]
as
  where
    folder :: Eq a => AttributeNamesBase a -> AttributeNamesBase a -> AttributeNamesBase a
    folder :: forall a.
Eq a =>
AttributeNamesBase a
-> AttributeNamesBase a -> AttributeNamesBase a
folder AttributeNamesBase a
acc AttributeNamesBase a
names =
      case AttributeNamesBase a
acc of
        AttributeNames Set AttributeName
an | forall a. Set a -> Bool
S.null Set AttributeName
an -> AttributeNamesBase a
names
        AttributeNamesBase a
acc' -> if AttributeNamesBase a
names forall a. Eq a => a -> a -> Bool
== forall a. AttributeNamesBase a
empty then
                  AttributeNamesBase a
acc
                else
                  forall a.
AttributeNamesBase a
-> AttributeNamesBase a -> AttributeNamesBase a
UnionAttributeNames AttributeNamesBase a
acc' AttributeNamesBase a
names