{-# OPTIONS_GHC -fno-warn-orphans #-}
module ProjectM36.Attribute where
import ProjectM36.Base
import ProjectM36.Error
import qualified Data.Set as S
import qualified Data.List as L
import qualified Data.Vector as V
import qualified Data.Hashable as Hash
import qualified Data.HashSet as HS
import qualified Data.Map as M
import Data.Either

arity :: Attributes -> Int
arity :: Attributes -> Int
arity Attributes
a = forall a. Vector a -> Int
V.length (Attributes -> Vector Attribute
attributesVec Attributes
a)

instance Semigroup Attributes where
  Attributes
attrsA <> :: Attributes -> Attributes -> Attributes
<> Attributes
attrsB =
    case Attributes -> Attributes -> Either RelationalError Attributes
joinAttributes Attributes
attrsA Attributes
attrsB of
      Left RelationalError
err -> forall a. HasCallStack => [Char] -> a
error (forall a. Show a => a -> [Char]
show RelationalError
err)
      Right Attributes
attrs' -> Attributes
attrs'
    
instance Monoid Attributes where
  mempty :: Attributes
mempty = Attributes {
    attributesVec :: Vector Attribute
attributesVec = forall a. Monoid a => a
mempty
    --,attributeSet = mempty
    }

emptyAttributes :: Attributes
emptyAttributes :: Attributes
emptyAttributes = forall a. Monoid a => a
mempty

null :: Attributes -> Bool
null :: Attributes -> Bool
null Attributes
a = forall a. Vector a -> Bool
V.null (Attributes -> Vector Attribute
attributesVec Attributes
a)

singleton :: Attribute -> Attributes
singleton :: Attribute -> Attributes
singleton Attribute
attr = Attributes {
  attributesVec :: Vector Attribute
attributesVec = forall a. a -> Vector a
V.singleton Attribute
attr
  --,attributesSet = HS.singleton attr
  }

toList :: Attributes -> [Attribute]
toList :: Attributes -> [Attribute]
toList Attributes
attrs = forall a. Vector a -> [a]
V.toList (Attributes -> Vector Attribute
attributesVec Attributes
attrs)

attributesFromList :: [Attribute] -> Attributes
attributesFromList :: [Attribute] -> Attributes
attributesFromList [Attribute]
attrsL = Attributes {
  attributesVec :: Vector Attribute
attributesVec = Vector Attribute
vec
  --,attributesSet = hset
  }
  where
    vec :: Vector Attribute
vec = if forall (t :: * -> *) a. Foldable t => t a -> Int
length [Attribute]
attrsL forall a. Eq a => a -> a -> Bool
== forall a. HashSet a -> Int
HS.size HashSet Attribute
hset then
      --fast path- no duplicates
      forall a. [a] -> Vector a
V.fromList [Attribute]
attrsL
      else
      --duplicate detected, uniqueify while maintaining original ordering
      forall a. [a] -> Vector a
V.fromList [Attribute]
uniquedL
    hset :: HashSet Attribute
hset = forall a. (Eq a, Hashable a) => [a] -> HashSet a
HS.fromList [Attribute]
attrsL
    uniquedL :: [Attribute]
uniquedL = forall a b. (a, b) -> a
fst forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (\Attribute
attr acc :: ([Attribute], HashSet Attribute)
acc@([Attribute]
l,HashSet Attribute
s) ->
                              if forall a. (Eq a, Hashable a) => a -> HashSet a -> Bool
HS.member Attribute
attr HashSet Attribute
s then
                                ([Attribute], HashSet Attribute)
acc
                                else
                                ([Attribute]
l forall a. [a] -> [a] -> [a]
++ [Attribute
attr], forall a. (Eq a, Hashable a) => a -> HashSet a -> HashSet a
HS.insert Attribute
attr HashSet Attribute
s))
                              ([],forall a. Monoid a => a
mempty) [Attribute]
attrsL

attributeName :: Attribute -> AttributeName
attributeName :: Attribute -> AttributeName
attributeName (Attribute AttributeName
name AtomType
_) = AttributeName
name

atomType :: Attribute -> AtomType
atomType :: Attribute -> AtomType
atomType (Attribute AttributeName
_ AtomType
atype) = AtomType
atype

atomTypes :: Attributes -> V.Vector AtomType
atomTypes :: Attributes -> Vector AtomType
atomTypes Attributes
attrs = forall a b. (a -> b) -> Vector a -> Vector b
V.map Attribute -> AtomType
atomType (Attributes -> Vector Attribute
attributesVec Attributes
attrs)

atomTypesList :: Attributes -> [AtomType]
atomTypesList :: Attributes -> [AtomType]
atomTypesList = forall a. Vector a -> [a]
V.toList forall b c a. (b -> c) -> (a -> b) -> a -> c
. Attributes -> Vector AtomType
atomTypes 

addAttribute :: Attribute -> Attributes -> Attributes
addAttribute :: Attribute -> Attributes -> Attributes
addAttribute Attribute
attr Attributes
attrs = Attributes
attrs forall a. Semigroup a => a -> a -> a
<> Attribute -> Attributes
singleton Attribute
attr

--if some attribute names overlap but the types do not, then spit back an error
{-joinAttributes :: Attributes -> Attributes -> Either RelationalError Attributes
joinAttributes attrs1 attrs2 | V.length uniqueOverlappingAttributes /= V.length overlappingAttributes = Left (TupleAttributeTypeMismatchError overlappingAttributes)
                             | V.length overlappingAttrsDifferentTypes > 0 = Left (TupleAttributeTypeMismatchError overlappingAttrsDifferentTypes)
                             | otherwise = Right $ vectorUniqueify (attrs1 V.++ attrs2)
  where
    overlappingAttrsDifferentTypes = V.filter (\attr -> V.elem (attributeName attr) attrNames2 && V.notElem attr attrs2) attrs1
    attrNames2 = V.map attributeName attrs2
    uniqueOverlappingAttributes = vectorUniqueify overlappingAttributes
    overlappingAttributes = V.filter (`V.elem` attrs2) attrs1
-}
joinAttributes :: Attributes -> Attributes -> Either RelationalError Attributes
joinAttributes :: Attributes -> Attributes -> Either RelationalError Attributes
joinAttributes Attributes
attrs1 Attributes
attrs2 
  | forall a. Set a -> Int
S.size Set AttributeName
overlappingNames forall a. Eq a => a -> a -> Bool
== Int
0 = -- fast path, no overlapping names
    forall (f :: * -> *) a. Applicative f => a -> f a
pure ((Vector Attribute -> Vector Attribute) -> Attributes
concated forall a. a -> a
id)
  | Set AttributeName -> Attributes -> Attributes
attributesForNames Set AttributeName
overlappingNames Attributes
attrs1 forall a. Eq a => a -> a -> Bool
== Set AttributeName -> Attributes -> Attributes
attributesForNames Set AttributeName
overlappingNames Attributes
attrs2 = -- that atomtypes match
    forall (f :: * -> *) a. Applicative f => a -> f a
pure ((Vector Attribute -> Vector Attribute) -> Attributes
concated forall a. (Hashable a, Eq a) => Vector a -> Vector a
vectorUniqueify)
  | Bool
otherwise =
    --special handling to validate that overlapping names have the same atom types
    forall a b. a -> Either a b
Left (Attributes -> RelationalError
TupleAttributeTypeMismatchError (Set AttributeName -> Attributes -> Attributes
attributesForNames Set AttributeName
overlappingNames Attributes
attrs1))
  where
    nameSet1 :: Set AttributeName
nameSet1 = Attributes -> Set AttributeName
attributeNameSet Attributes
attrs1
    nameSet2 :: Set AttributeName
nameSet2 = Attributes -> Set AttributeName
attributeNameSet Attributes
attrs2
    overlappingNames :: Set AttributeName
overlappingNames = forall a. Ord a => Set a -> Set a -> Set a
S.intersection Set AttributeName
nameSet1 Set AttributeName
nameSet2
    concated :: (Vector Attribute -> Vector Attribute) -> Attributes
concated Vector Attribute -> Vector Attribute
f = Attributes {
      attributesVec :: Vector Attribute
attributesVec = Vector Attribute -> Vector Attribute
f (Attributes -> Vector Attribute
attributesVec Attributes
attrs1 forall a. Semigroup a => a -> a -> a
<> Attributes -> Vector Attribute
attributesVec Attributes
attrs2)
      --,attributesSet = attributesSet attrs1 <> attributesSet attrs2
      }

addAttributes :: Attributes -> Attributes -> Attributes
addAttributes :: Attributes -> Attributes -> Attributes
addAttributes = forall a. Semigroup a => a -> a -> a
(<>)

member :: Attribute -> Attributes -> Bool
member :: Attribute -> Attributes -> Bool
member Attribute
attr Attributes
attrs = forall a. (Eq a, Hashable a) => a -> HashSet a -> Bool
HS.member Attribute
attr (Attributes -> HashSet Attribute
attributesSet Attributes
attrs)

deleteAttributeName :: AttributeName -> Attributes -> Attributes
deleteAttributeName :: AttributeName -> Attributes -> Attributes
deleteAttributeName AttributeName
attrName = Set AttributeName -> Attributes -> Attributes
deleteAttributeNames (forall a. a -> Set a
S.singleton AttributeName
attrName)

deleteAttributeNames :: S.Set AttributeName -> Attributes -> Attributes
deleteAttributeNames :: Set AttributeName -> Attributes -> Attributes
deleteAttributeNames Set AttributeName
attrNames Attributes
attrs = Attributes {
  attributesVec :: Vector Attribute
attributesVec = Vector Attribute
vec
  }
  where
    vec :: Vector Attribute
vec = forall a. (a -> Bool) -> Vector a -> Vector a
V.filter Attribute -> Bool
attrFilter (Attributes -> Vector Attribute
attributesVec Attributes
attrs)
    attrFilter :: Attribute -> Bool
attrFilter Attribute
attr = forall a. Ord a => a -> Set a -> Bool
S.notMember (Attribute -> AttributeName
attributeName Attribute
attr) Set AttributeName
attrNames

renameAttribute :: AttributeName -> Attribute -> Attribute
renameAttribute :: AttributeName -> Attribute -> Attribute
renameAttribute AttributeName
newAttrName (Attribute AttributeName
_ AtomType
typeo) = AttributeName -> AtomType -> Attribute
Attribute AttributeName
newAttrName AtomType
typeo

renameAttributes :: AttributeName -> AttributeName -> Attributes -> Attributes
renameAttributes :: AttributeName -> AttributeName -> Attributes -> Attributes
renameAttributes AttributeName
oldAttrName AttributeName
newAttrName Attributes
attrs = Attributes {
  attributesVec :: Vector Attribute
attributesVec = Vector Attribute
vec
  }
  where
  vec :: Vector Attribute
vec = forall a b. (a -> b) -> Vector a -> Vector b
V.map Attribute -> Attribute
renamer (Attributes -> Vector Attribute
attributesVec Attributes
attrs)
  renamer :: Attribute -> Attribute
renamer Attribute
attr = if Attribute -> AttributeName
attributeName Attribute
attr forall a. Eq a => a -> a -> Bool
== AttributeName
oldAttrName then
                     AttributeName -> Attribute -> Attribute
renameAttribute AttributeName
newAttrName Attribute
attr
                   else
                     Attribute
attr

renameAttributes' :: S.Set (AttributeName, AttributeName) -> Attributes -> Attributes
renameAttributes' :: Set (AttributeName, AttributeName) -> Attributes -> Attributes
renameAttributes' Set (AttributeName, AttributeName)
renameSet Attributes
attrs = 
  forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (\(AttributeName
old, AttributeName
new) Attributes
acc -> AttributeName -> AttributeName -> Attributes -> Attributes
renameAttributes AttributeName
old AttributeName
new Attributes
acc) Attributes
attrs Set (AttributeName, AttributeName)
renameSet
    

atomTypeForAttributeName :: AttributeName -> Attributes -> Either RelationalError AtomType
atomTypeForAttributeName :: AttributeName -> Attributes -> Either RelationalError AtomType
atomTypeForAttributeName AttributeName
attrName Attributes
attrs = do
  (Attribute AttributeName
_ AtomType
atype) <- AttributeName -> Attributes -> Either RelationalError Attribute
attributeForName AttributeName
attrName Attributes
attrs
  forall (m :: * -> *) a. Monad m => a -> m a
return AtomType
atype

attributeForName :: AttributeName -> Attributes -> Either RelationalError Attribute
attributeForName :: AttributeName -> Attributes -> Either RelationalError Attribute
attributeForName AttributeName
attrName Attributes
attrs = case forall a. (a -> Bool) -> Vector a -> Maybe a
V.find (\Attribute
attr -> Attribute -> AttributeName
attributeName Attribute
attr forall a. Eq a => a -> a -> Bool
== AttributeName
attrName) (Attributes -> Vector Attribute
attributesVec Attributes
attrs) of
  Maybe Attribute
Nothing -> forall a b. a -> Either a b
Left (Set AttributeName -> RelationalError
NoSuchAttributeNamesError (forall a. a -> Set a
S.singleton AttributeName
attrName))
  Just Attribute
attr -> forall a b. b -> Either a b
Right Attribute
attr

isAttributeNameContained :: AttributeName -> Attributes -> Bool
isAttributeNameContained :: AttributeName -> Attributes -> Bool
isAttributeNameContained AttributeName
nam Attributes
attrs = forall a b. Either a b -> Bool
isRight (AttributeName -> Attributes -> Either RelationalError Attribute
attributeForName AttributeName
nam Attributes
attrs)

--similar to attributesForNames, but returns error if some names are missing  
projectionAttributesForNames :: S.Set AttributeName -> Attributes -> Either RelationalError Attributes
projectionAttributesForNames :: Set AttributeName
-> Attributes -> Either RelationalError Attributes
projectionAttributesForNames Set AttributeName
names Attributes
attrsIn = 
  if Bool -> Bool
not (forall a. Set a -> Bool
S.null Set AttributeName
missingNames) then
    forall a b. a -> Either a b
Left (Set AttributeName -> RelationalError
NoSuchAttributeNamesError Set AttributeName
missingNames)
  else
    forall a b. b -> Either a b
Right (Set AttributeName -> Attributes -> Attributes
attributesForNames Set AttributeName
names Attributes
attrsIn)
  where
    missingNames :: Set AttributeName
missingNames = Set AttributeName -> Set AttributeName -> Set AttributeName
attributeNamesNotContained Set AttributeName
names (forall a. Ord a => [a] -> Set a
S.fromList (forall a. Vector a -> [a]
V.toList (Attributes -> Vector AttributeName
attributeNames Attributes
attrsIn)))

attributesForNames :: S.Set AttributeName -> Attributes -> Attributes
attributesForNames :: Set AttributeName -> Attributes -> Attributes
attributesForNames Set AttributeName
attrNameSet Attributes
attrs = Attributes {
  attributesVec :: Vector Attribute
attributesVec = Vector Attribute
vec
  }
  where
    vec :: Vector Attribute
vec = forall a. (a -> Bool) -> Vector a -> Vector a
V.filter Attribute -> Bool
filt (Attributes -> Vector Attribute
attributesVec Attributes
attrs)
    filt :: Attribute -> Bool
filt Attribute
attr = forall a. Ord a => a -> Set a -> Bool
S.member (Attribute -> AttributeName
attributeName Attribute
attr) Set AttributeName
attrNameSet

attributeNameSet :: Attributes -> S.Set AttributeName
attributeNameSet :: Attributes -> Set AttributeName
attributeNameSet Attributes
attrs = forall a. Ord a => [a] -> Set a
S.fromList forall a b. (a -> b) -> a -> b
$ forall a. Vector a -> [a]
V.toList forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> Vector a -> Vector b
V.map (\(Attribute AttributeName
name AtomType
_) -> AttributeName
name) (Attributes -> Vector Attribute
attributesVec Attributes
attrs)

attributeNames :: Attributes -> V.Vector AttributeName
attributeNames :: Attributes -> Vector AttributeName
attributeNames Attributes
attrs = forall a b. (a -> b) -> Vector a -> Vector b
V.map Attribute -> AttributeName
attributeName (Attributes -> Vector Attribute
attributesVec Attributes
attrs)

attributeNamesList :: Attributes -> [AttributeName]
attributeNamesList :: Attributes -> [AttributeName]
attributeNamesList = forall a. Vector a -> [a]
V.toList forall b c a. (b -> c) -> (a -> b) -> a -> c
. Attributes -> Vector AttributeName
attributeNames

--checks if set s1 is wholly contained in the set s2
attributesContained :: Attributes -> Attributes -> Bool
attributesContained :: Attributes -> Attributes -> Bool
attributesContained Attributes
attrs1 Attributes
attrs2 = Set AttributeName -> Set AttributeName -> Bool
attributeNamesContained (Attributes -> Set AttributeName
attributeNameSet Attributes
attrs1) (Attributes -> Set AttributeName
attributeNameSet Attributes
attrs2)

attributeNamesContained :: S.Set AttributeName -> S.Set AttributeName -> Bool
attributeNamesContained :: Set AttributeName -> Set AttributeName -> Bool
attributeNamesContained = forall a. Ord a => Set a -> Set a -> Bool
S.isSubsetOf

--returns the disjunction of the AttributeNameSets
nonMatchingAttributeNameSet :: S.Set AttributeName -> S.Set AttributeName -> S.Set AttributeName
nonMatchingAttributeNameSet :: Set AttributeName -> Set AttributeName -> Set AttributeName
nonMatchingAttributeNameSet Set AttributeName
a1 Set AttributeName
a2 = forall a. Ord a => Set a -> Set a -> Set a
S.difference (forall a. Ord a => Set a -> Set a -> Set a
S.union Set AttributeName
a1 Set AttributeName
a2) (forall a. Ord a => Set a -> Set a -> Set a
S.intersection Set AttributeName
a1 Set AttributeName
a2)

matchingAttributeNameSet :: S.Set AttributeName -> S.Set AttributeName -> S.Set AttributeName
matchingAttributeNameSet :: Set AttributeName -> Set AttributeName -> Set AttributeName
matchingAttributeNameSet = forall a. Ord a => Set a -> Set a -> Set a
S.intersection

attributeNamesNotContained :: S.Set AttributeName -> S.Set AttributeName -> S.Set AttributeName
attributeNamesNotContained :: Set AttributeName -> Set AttributeName -> Set AttributeName
attributeNamesNotContained Set AttributeName
subset Set AttributeName
superset = forall a. (a -> Bool) -> Set a -> Set a
S.filter (forall a. Ord a => a -> Set a -> Bool
`S.notMember` Set AttributeName
superset) Set AttributeName
subset

-- useful for display
orderedAttributes :: Attributes -> [Attribute]
orderedAttributes :: Attributes -> [Attribute]
orderedAttributes Attributes
attrs = forall a. (a -> a -> Ordering) -> [a] -> [a]
L.sortBy (\Attribute
a Attribute
b -> Attribute -> AttributeName
attributeName Attribute
a forall a. Ord a => a -> a -> Ordering
`compare` Attribute -> AttributeName
attributeName Attribute
b) (forall a. Vector a -> [a]
V.toList (Attributes -> Vector Attribute
attributesVec Attributes
attrs))

orderedAttributeNames :: Attributes -> [AttributeName]
orderedAttributeNames :: Attributes -> [AttributeName]
orderedAttributeNames Attributes
attrs = forall a b. (a -> b) -> [a] -> [b]
map Attribute -> AttributeName
attributeName (Attributes -> [Attribute]
orderedAttributes Attributes
attrs)

-- take two attribute sets and return an attribute set with the attributes which do not match
--this is the function which benefits the most from the HashSet representation- this turned up in the insert performance test
attributesDifference :: Attributes -> Attributes -> Attributes
{-attributesDifference attrsA attrsB = V.fromList $ diff (V.toList attrsA) (V.toList attrsB)
  where
    diff a b = (a L.\\ b)  ++ (b L.\\ a)
-}
attributesDifference :: Attributes -> Attributes -> Attributes
attributesDifference Attributes
attrsA Attributes
attrsB =
  if Attributes -> HashSet Attribute
attributesSet Attributes
attrsA forall a. Eq a => a -> a -> Bool
== Attributes -> HashSet Attribute
attributesSet Attributes
attrsB then
    forall a. Monoid a => a
mempty
    else
    Attributes {
    attributesVec :: Vector Attribute
attributesVec = Vector Attribute
vec
    --,attributesSet = hset
    }
  where
    hset :: HashSet Attribute
hset = forall a. (Eq a, Hashable a) => HashSet a -> HashSet a -> HashSet a
HS.difference HashSet Attribute
setA HashSet Attribute
setB forall a. Semigroup a => a -> a -> a
<> forall a. (Eq a, Hashable a) => HashSet a -> HashSet a -> HashSet a
HS.difference HashSet Attribute
setB HashSet Attribute
setA
    setA :: HashSet Attribute
setA = Attributes -> HashSet Attribute
attributesSet Attributes
attrsA
    setB :: HashSet Attribute
setB = Attributes -> HashSet Attribute
attributesSet Attributes
attrsB
    vec :: Vector Attribute
vec = forall a. (a -> Bool) -> Vector a -> Vector a
V.filter (forall a. (Eq a, Hashable a) => a -> HashSet a -> Bool
`HS.member` HashSet Attribute
hset) (Attributes -> Vector Attribute
attributesVec Attributes
attrsA forall a. Semigroup a => a -> a -> a
<> Attributes -> Vector Attribute
attributesVec Attributes
attrsB)

vectorUniqueify :: (Hash.Hashable a, Eq a) => V.Vector a -> V.Vector a
vectorUniqueify :: forall a. (Hashable a, Eq a) => Vector a -> Vector a
vectorUniqueify Vector a
vecIn = forall a. [a] -> Vector a
V.fromList forall a b. (a -> b) -> a -> b
$ forall a. HashSet a -> [a]
HS.toList forall a b. (a -> b) -> a -> b
$ forall a. (Eq a, Hashable a) => [a] -> HashSet a
HS.fromList forall a b. (a -> b) -> a -> b
$ forall a. Vector a -> [a]
V.toList Vector a
vecIn

--check that each attribute only appears once
verifyAttributes :: Attributes -> Either RelationalError Attributes
verifyAttributes :: Attributes -> Either RelationalError Attributes
verifyAttributes Attributes
attrs =
  if HashSet Attribute
vecSet forall a. Eq a => a -> a -> Bool
== Attributes -> HashSet Attribute
attributesSet Attributes
attrs then
    forall (f :: * -> *) a. Applicative f => a -> f a
pure Attributes
attrs
  else do
    forall a b. a -> Either a b
Left (Attributes -> RelationalError
TupleAttributeTypeMismatchError Attributes
diffAttrs)
  where
    vecSet :: HashSet Attribute
vecSet = forall a b. (a -> b -> b) -> b -> Vector a -> b
V.foldr' forall a. (Eq a, Hashable a) => a -> HashSet a -> HashSet a
HS.insert forall a. HashSet a
HS.empty (Attributes -> Vector Attribute
attributesVec Attributes
attrs)
    diffSet :: HashSet Attribute
diffSet = forall a. (Eq a, Hashable a) => HashSet a -> HashSet a -> HashSet a
HS.difference HashSet Attribute
vecSet (Attributes -> HashSet Attribute
attributesSet Attributes
attrs) forall a. Semigroup a => a -> a -> a
<> forall a. (Eq a, Hashable a) => HashSet a -> HashSet a -> HashSet a
HS.difference (Attributes -> HashSet Attribute
attributesSet Attributes
attrs) HashSet Attribute
vecSet
    diffAttrs :: Attributes
diffAttrs = Attributes {
      attributesVec :: Vector Attribute
attributesVec = forall a. [a] -> Vector a
V.fromList (forall a. HashSet a -> [a]
HS.toList HashSet Attribute
diffSet)
      --,attributesSet = diffSet
      }

--used in Generics derivation for ADTs without named attributes- not to be used elsewhere
--drop first n attributes from vector representation
drop :: Int -> Attributes -> Attributes
drop :: Int -> Attributes -> Attributes
drop Int
c Attributes
attrs = Attributes { attributesVec :: Vector Attribute
attributesVec = Vector Attribute
vec
                          }
  where
    vec :: Vector Attribute
vec = forall a. Int -> Vector a -> Vector a
V.drop Int
c (Attributes -> Vector Attribute
attributesVec Attributes
attrs)

    
-- use this in preference to attributesEqual when the attribute ordering matters such as during tuple unions
attributesAndOrderEqual :: Attributes -> Attributes -> Bool
attributesAndOrderEqual :: Attributes -> Attributes -> Bool
attributesAndOrderEqual Attributes
a Attributes
b = Attributes -> Vector Attribute
attributesVec Attributes
a forall a. Eq a => a -> a -> Bool
== Attributes -> Vector Attribute
attributesVec Attributes
b

-- use to determine if the same attributes are contained (but ordering is irrelevant)
attributesEqual :: Attributes -> Attributes -> Bool
attributesEqual :: Attributes -> Attributes -> Bool
attributesEqual Attributes
attrsA Attributes
attrsB =
  Attributes -> Vector Attribute
attributesVec Attributes
attrsA forall a. Eq a => a -> a -> Bool
== Attributes -> Vector Attribute
attributesVec Attributes
attrsB Bool -> Bool -> Bool
|| 
  Attributes -> HashSet Attribute
attributesSet Attributes
attrsA forall a. Eq a => a -> a -> Bool
== Attributes -> HashSet Attribute
attributesSet Attributes
attrsB

attributesAsMap :: Attributes -> M.Map AttributeName Attribute
attributesAsMap :: Attributes -> Map AttributeName Attribute
attributesAsMap Attributes
attrs = forall a b. (a -> b -> b) -> b -> Vector a -> b
V.foldr' (\Attribute
attr Map AttributeName Attribute
acc -> forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert (Attribute -> AttributeName
attributeName Attribute
attr) Attribute
attr Map AttributeName Attribute
acc) forall a. Monoid a => a
mempty (Attributes -> Vector Attribute
attributesVec Attributes
attrs)


-- | Left-biased union of attributes.
union :: Attributes -> Attributes -> Attributes
union :: Attributes -> Attributes -> Attributes
union Attributes
attrsA Attributes
attrsB = Attributes {
  attributesVec :: Vector Attribute
attributesVec = Vector Attribute
vec
  --,attributesSet = hset
  }
  where
    hset :: HashSet Attribute
hset = forall a. Eq a => HashSet a -> HashSet a -> HashSet a
HS.union (Attributes -> HashSet Attribute
attributesSet Attributes
attrsA) (Attributes -> HashSet Attribute
attributesSet Attributes
attrsB)
    vec :: Vector Attribute
vec = forall b a. (b -> a -> a) -> a -> HashSet b -> a
HS.foldr (forall a b c. (a -> b -> c) -> b -> a -> c
flip forall a. Vector a -> a -> Vector a
V.snoc) forall a. Monoid a => a
mempty HashSet Attribute
hset
                      
intersection :: Attributes -> Attributes -> Attributes
intersection :: Attributes -> Attributes -> Attributes
intersection Attributes
attrsA Attributes
attrsB = Attributes {
  attributesVec :: Vector Attribute
attributesVec = Vector Attribute
vec
  --,attributesSet = hset
  }
  where
    hset :: HashSet Attribute
hset = forall a. Eq a => HashSet a -> HashSet a -> HashSet a
HS.intersection (Attributes -> HashSet Attribute
attributesSet Attributes
attrsA) (Attributes -> HashSet Attribute
attributesSet Attributes
attrsB)
    vec :: Vector Attribute
vec = forall b a. (b -> a -> a) -> a -> HashSet b -> a
HS.foldr (forall a b c. (a -> b -> c) -> b -> a -> c
flip forall a. Vector a -> a -> Vector a
V.snoc) forall a. Monoid a => a
mempty HashSet Attribute
hset