module ProjectM36.Tuple where
import ProjectM36.Base
import ProjectM36.Error
import ProjectM36.Attribute as A
import ProjectM36.Atom
import ProjectM36.AtomType
import ProjectM36.DataTypes.Primitive
import qualified Data.Map as M
import qualified Data.Set as S
import qualified Data.Vector as V
import Data.Either (rights)
import Control.Monad
import Control.Arrow
import Data.Maybe
emptyTuple :: RelationTuple
emptyTuple :: RelationTuple
emptyTuple = Attributes -> Vector Atom -> RelationTuple
RelationTuple Attributes
forall a. Monoid a => a
mempty Vector Atom
forall a. Monoid a => a
mempty
tupleSize :: RelationTuple -> Int
tupleSize :: RelationTuple -> Int
tupleSize (RelationTuple Attributes
tupAttrs Vector Atom
_) = Attributes -> Int
arity Attributes
tupAttrs
tupleAttributeNameSet :: RelationTuple -> S.Set AttributeName
tupleAttributeNameSet :: RelationTuple -> Set AttributeName
tupleAttributeNameSet (RelationTuple Attributes
tupAttrs Vector Atom
_) = Attributes -> Set AttributeName
attributeNameSet Attributes
tupAttrs
tupleAttributes :: RelationTuple -> Attributes
tupleAttributes :: RelationTuple -> Attributes
tupleAttributes (RelationTuple Attributes
tupAttrs Vector Atom
_) = Attributes
tupAttrs
tupleAssocs :: RelationTuple -> [(AttributeName, Atom)]
tupleAssocs :: RelationTuple -> [(AttributeName, Atom)]
tupleAssocs (RelationTuple Attributes
attrs Vector Atom
tupVec) = Vector (AttributeName, Atom) -> [(AttributeName, Atom)]
forall a. Vector a -> [a]
V.toList (Vector (AttributeName, Atom) -> [(AttributeName, Atom)])
-> Vector (AttributeName, Atom) -> [(AttributeName, Atom)]
forall a b. (a -> b) -> a -> b
$ ((Attribute, Atom) -> (AttributeName, Atom))
-> Vector (Attribute, Atom) -> Vector (AttributeName, Atom)
forall a b. (a -> b) -> Vector a -> Vector b
V.map ((Attribute -> AttributeName)
-> (Attribute, Atom) -> (AttributeName, Atom)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
first Attribute -> AttributeName
attributeName) (Vector Attribute -> Vector Atom -> Vector (Attribute, Atom)
forall a b. Vector a -> Vector b -> Vector (a, b)
V.zip (Attributes -> Vector Attribute
attributesVec Attributes
attrs) Vector Atom
tupVec)
orderedTupleAssocs :: RelationTuple -> [(AttributeName, Atom)]
orderedTupleAssocs :: RelationTuple -> [(AttributeName, Atom)]
orderedTupleAssocs tup :: RelationTuple
tup@(RelationTuple Attributes
attrVec Vector Atom
_) = (Attribute -> (AttributeName, Atom))
-> [Attribute] -> [(AttributeName, Atom)]
forall a b. (a -> b) -> [a] -> [b]
map (\Attribute
attr -> (Attribute -> AttributeName
attributeName Attribute
attr, AttributeName -> Atom
atomForAttr (Attribute -> AttributeName
attributeName Attribute
attr))) [Attribute]
oAttrs
where
oAttrs :: [Attribute]
oAttrs = Attributes -> [Attribute]
orderedAttributes Attributes
attrVec
atomForAttr :: AttributeName -> Atom
atomForAttr AttributeName
nam = case AttributeName -> RelationTuple -> Either RelationalError Atom
atomForAttributeName AttributeName
nam RelationTuple
tup of
Left RelationalError
_ -> AttributeName -> Atom
TextAtom AttributeName
"<?>"
Right Atom
val -> Atom
val
tupleAtoms :: RelationTuple -> V.Vector Atom
tupleAtoms :: RelationTuple -> Vector Atom
tupleAtoms (RelationTuple Attributes
_ Vector Atom
tupVec) = Vector Atom
tupVec
atomForAttributeName :: AttributeName -> RelationTuple -> Either RelationalError Atom
atomForAttributeName :: AttributeName -> RelationTuple -> Either RelationalError Atom
atomForAttributeName AttributeName
attrName (RelationTuple Attributes
tupAttrs Vector Atom
tupVec) = case (Attribute -> Bool) -> Vector Attribute -> Maybe Int
forall a. (a -> Bool) -> Vector a -> Maybe Int
V.findIndex (\Attribute
attr -> Attribute -> AttributeName
attributeName Attribute
attr AttributeName -> AttributeName -> Bool
forall a. Eq a => a -> a -> Bool
== AttributeName
attrName) (Attributes -> Vector Attribute
attributesVec Attributes
tupAttrs) of
Maybe Int
Nothing -> RelationalError -> Either RelationalError Atom
forall a b. a -> Either a b
Left (Set AttributeName -> RelationalError
NoSuchAttributeNamesError (AttributeName -> Set AttributeName
forall a. a -> Set a
S.singleton AttributeName
attrName))
Just Int
index -> case Vector Atom
tupVec Vector Atom -> Int -> Maybe Atom
forall a. Vector a -> Int -> Maybe a
V.!? Int
index of
Maybe Atom
Nothing -> RelationalError -> Either RelationalError Atom
forall a b. a -> Either a b
Left (Set AttributeName -> RelationalError
NoSuchAttributeNamesError (AttributeName -> Set AttributeName
forall a. a -> Set a
S.singleton AttributeName
attrName))
Just Atom
atom -> Atom -> Either RelationalError Atom
forall a b. b -> Either a b
Right Atom
atom
atomsForAttributeNames :: V.Vector AttributeName -> RelationTuple -> Either RelationalError (V.Vector Atom)
atomsForAttributeNames :: Vector AttributeName
-> RelationTuple -> Either RelationalError (Vector Atom)
atomsForAttributeNames Vector AttributeName
attrNames RelationTuple
tuple =
(Int -> Atom) -> Vector Int -> Vector Atom
forall a b. (a -> b) -> Vector a -> Vector b
V.map (\Int
index -> RelationTuple -> Vector Atom
tupleAtoms RelationTuple
tuple Vector Atom -> Int -> Atom
forall a. Vector a -> Int -> a
V.! Int
index) (Vector Int -> Vector Atom)
-> Either RelationalError (Vector Int)
-> Either RelationalError (Vector Atom)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Vector AttributeName
-> Attributes -> Either RelationalError (Vector Int)
vectorIndicesForAttributeNames Vector AttributeName
attrNames (RelationTuple -> Attributes
tupleAttributes RelationTuple
tuple)
vectorIndicesForAttributeNames :: V.Vector AttributeName -> Attributes -> Either RelationalError (V.Vector Int)
vectorIndicesForAttributeNames :: Vector AttributeName
-> Attributes -> Either RelationalError (Vector Int)
vectorIndicesForAttributeNames Vector AttributeName
attrNameVec Attributes
attrs = if Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ Vector AttributeName -> Bool
forall a. Vector a -> Bool
V.null Vector AttributeName
unknownAttrNames then
RelationalError -> Either RelationalError (Vector Int)
forall a b. a -> Either a b
Left (RelationalError -> Either RelationalError (Vector Int))
-> RelationalError -> Either RelationalError (Vector Int)
forall a b. (a -> b) -> a -> b
$ Set AttributeName -> RelationalError
NoSuchAttributeNamesError ([AttributeName] -> Set AttributeName
forall a. Ord a => [a] -> Set a
S.fromList (Vector AttributeName -> [AttributeName]
forall a. Vector a -> [a]
V.toList Vector AttributeName
unknownAttrNames))
else
Vector Int -> Either RelationalError (Vector Int)
forall a b. b -> Either a b
Right (Vector Int -> Either RelationalError (Vector Int))
-> Vector Int -> Either RelationalError (Vector Int)
forall a b. (a -> b) -> a -> b
$ (AttributeName -> Int) -> Vector AttributeName -> Vector Int
forall a b. (a -> b) -> Vector a -> Vector b
V.map AttributeName -> Int
mapper Vector AttributeName
attrNameVec
where
unknownAttrNames :: Vector AttributeName
unknownAttrNames = (AttributeName -> Bool)
-> Vector AttributeName -> Vector AttributeName
forall a. (a -> Bool) -> Vector a -> Vector a
V.filter (AttributeName -> Vector AttributeName -> Bool
forall a. Eq a => a -> Vector a -> Bool
`V.notElem` Attributes -> Vector AttributeName
attributeNames Attributes
attrs) Vector AttributeName
attrNameVec
mapper :: AttributeName -> Int
mapper AttributeName
attrName = Int -> Maybe Int -> Int
forall a. a -> Maybe a -> a
fromMaybe ([Char] -> Int
forall a. HasCallStack => [Char] -> a
error [Char]
"logic failure in vectorIndicesForAttributeNames") (AttributeName -> Vector AttributeName -> Maybe Int
forall a. Eq a => a -> Vector a -> Maybe Int
V.elemIndex AttributeName
attrName (Attributes -> Vector AttributeName
attributeNames Attributes
attrs))
relationForAttributeName :: AttributeName -> RelationTuple -> Either RelationalError Relation
relationForAttributeName :: AttributeName -> RelationTuple -> Either RelationalError Relation
relationForAttributeName AttributeName
attrName RelationTuple
tuple = do
AtomType
aType <- AttributeName -> Attributes -> Either RelationalError AtomType
atomTypeForAttributeName AttributeName
attrName (RelationTuple -> Attributes
tupleAttributes RelationTuple
tuple)
if Bool -> Bool
not (AtomType -> Bool
isRelationAtomType AtomType
aType) then
RelationalError -> Either RelationalError Relation
forall a b. a -> Either a b
Left (RelationalError -> Either RelationalError Relation)
-> RelationalError -> Either RelationalError Relation
forall a b. (a -> b) -> a -> b
$ AttributeName -> RelationalError
AttributeIsNotRelationValuedError AttributeName
attrName
else do
Atom
atomVal <- AttributeName -> RelationTuple -> Either RelationalError Atom
atomForAttributeName AttributeName
attrName RelationTuple
tuple
Atom -> Either RelationalError Relation
relationForAtom Atom
atomVal
tupleRenameAttribute :: AttributeName -> AttributeName -> RelationTuple -> RelationTuple
tupleRenameAttribute :: AttributeName -> AttributeName -> RelationTuple -> RelationTuple
tupleRenameAttribute AttributeName
oldattr AttributeName
newattr (RelationTuple Attributes
tupAttrs Vector Atom
tupVec) = Attributes -> Vector Atom -> RelationTuple
RelationTuple Attributes
newAttrs Vector Atom
tupVec
where
newAttrs :: Attributes
newAttrs = AttributeName -> AttributeName -> Attributes -> Attributes
renameAttributes AttributeName
oldattr AttributeName
newattr Attributes
tupAttrs
mkRelationTuple :: Attributes -> V.Vector Atom -> RelationTuple
mkRelationTuple :: Attributes -> Vector Atom -> RelationTuple
mkRelationTuple = Attributes -> Vector Atom -> RelationTuple
RelationTuple
mkRelationTuples :: Attributes -> [V.Vector Atom] -> [RelationTuple]
mkRelationTuples :: Attributes -> [Vector Atom] -> [RelationTuple]
mkRelationTuples Attributes
attrs = (Vector Atom -> RelationTuple) -> [Vector Atom] -> [RelationTuple]
forall a b. (a -> b) -> [a] -> [b]
map Vector Atom -> RelationTuple
mapper
where
mapper :: Vector Atom -> RelationTuple
mapper = Attributes -> Vector Atom -> RelationTuple
mkRelationTuple Attributes
attrs
mkRelationTupleFromMap :: M.Map AttributeName Atom -> RelationTuple
mkRelationTupleFromMap :: Map AttributeName Atom -> RelationTuple
mkRelationTupleFromMap Map AttributeName Atom
attrMap = Attributes -> Vector Atom -> RelationTuple
RelationTuple ([Attribute] -> Attributes
attributesFromList [Attribute]
attrs) ((AttributeName -> Atom) -> Vector AttributeName -> Vector Atom
forall a b. (a -> b) -> Vector a -> Vector b
V.map (Map AttributeName Atom
attrMap Map AttributeName Atom -> AttributeName -> Atom
forall k a. Ord k => Map k a -> k -> a
M.!) ([AttributeName] -> Vector AttributeName
forall a. [a] -> Vector a
V.fromList [AttributeName]
attrNames))
where
attrNames :: [AttributeName]
attrNames = Map AttributeName Atom -> [AttributeName]
forall k a. Map k a -> [k]
M.keys Map AttributeName Atom
attrMap
attrs :: [Attribute]
attrs = (AttributeName -> Attribute) -> [AttributeName] -> [Attribute]
forall a b. (a -> b) -> [a] -> [b]
map (\AttributeName
attrName -> AttributeName -> AtomType -> Attribute
Attribute AttributeName
attrName (Atom -> AtomType
atomTypeForAtom (Map AttributeName Atom
attrMap Map AttributeName Atom -> AttributeName -> Atom
forall k a. Ord k => Map k a -> k -> a
M.! AttributeName
attrName))) [AttributeName]
attrNames
singleTupleSetJoin :: Attributes -> RelationTuple -> RelationTupleSet -> Either RelationalError [RelationTuple]
singleTupleSetJoin :: Attributes
-> RelationTuple
-> RelationTupleSet
-> Either RelationalError [RelationTuple]
singleTupleSetJoin Attributes
joinAttrs RelationTuple
tup RelationTupleSet
tupSet =
([RelationTuple]
-> RelationTuple -> Either RelationalError [RelationTuple])
-> [RelationTuple]
-> [RelationTuple]
-> Either RelationalError [RelationTuple]
forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldM [RelationTuple]
-> RelationTuple -> Either RelationalError [RelationTuple]
tupleJoiner [] (RelationTupleSet -> [RelationTuple]
asList RelationTupleSet
tupSet)
where
tupleJoiner :: [RelationTuple] -> RelationTuple -> Either RelationalError [RelationTuple]
tupleJoiner :: [RelationTuple]
-> RelationTuple -> Either RelationalError [RelationTuple]
tupleJoiner [RelationTuple]
accumulator RelationTuple
tuple2 = case Attributes
-> RelationTuple
-> RelationTuple
-> Either RelationalError (Maybe RelationTuple)
singleTupleJoin Attributes
joinAttrs RelationTuple
tup RelationTuple
tuple2 of
Right Maybe RelationTuple
Nothing -> [RelationTuple] -> Either RelationalError [RelationTuple]
forall a b. b -> Either a b
Right [RelationTuple]
accumulator
Right (Just RelationTuple
relTuple) -> [RelationTuple] -> Either RelationalError [RelationTuple]
forall a b. b -> Either a b
Right ([RelationTuple] -> Either RelationalError [RelationTuple])
-> [RelationTuple] -> Either RelationalError [RelationTuple]
forall a b. (a -> b) -> a -> b
$ RelationTuple
relTuple RelationTuple -> [RelationTuple] -> [RelationTuple]
forall a. a -> [a] -> [a]
: [RelationTuple]
accumulator
Left RelationalError
err -> RelationalError -> Either RelationalError [RelationTuple]
forall a b. a -> Either a b
Left RelationalError
err
singleTupleJoin :: Attributes -> RelationTuple -> RelationTuple -> Either RelationalError (Maybe RelationTuple)
singleTupleJoin :: Attributes
-> RelationTuple
-> RelationTuple
-> Either RelationalError (Maybe RelationTuple)
singleTupleJoin Attributes
joinedAttrs tup1 :: RelationTuple
tup1@(RelationTuple Attributes
tupAttrs1 Vector Atom
_) tup2 :: RelationTuple
tup2@(RelationTuple Attributes
tupAttrs2 Vector Atom
_) = if
Vector AttributeName -> Bool
forall a. Vector a -> Bool
V.null Vector AttributeName
keysIntersection Bool -> Bool -> Bool
|| Vector AttributeName
-> RelationTuple -> Either RelationalError (Vector Atom)
atomsForAttributeNames Vector AttributeName
keysIntersection RelationTuple
tup1 Either RelationalError (Vector Atom)
-> Either RelationalError (Vector Atom) -> Bool
forall a. Eq a => a -> a -> Bool
/= Vector AttributeName
-> RelationTuple -> Either RelationalError (Vector Atom)
atomsForAttributeNames Vector AttributeName
keysIntersection RelationTuple
tup2
then
Maybe RelationTuple -> Either RelationalError (Maybe RelationTuple)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe RelationTuple
forall a. Maybe a
Nothing
else
Maybe RelationTuple -> Either RelationalError (Maybe RelationTuple)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe RelationTuple
-> Either RelationalError (Maybe RelationTuple))
-> Maybe RelationTuple
-> Either RelationalError (Maybe RelationTuple)
forall a b. (a -> b) -> a -> b
$ RelationTuple -> Maybe RelationTuple
forall a. a -> Maybe a
Just (RelationTuple -> Maybe RelationTuple)
-> RelationTuple -> Maybe RelationTuple
forall a b. (a -> b) -> a -> b
$ Attributes -> Vector Atom -> RelationTuple
RelationTuple Attributes
joinedAttrs Vector Atom
newVec
where
keysIntersection :: Vector AttributeName
keysIntersection = (Attribute -> AttributeName)
-> Vector Attribute -> Vector AttributeName
forall a b. (a -> b) -> Vector a -> Vector b
V.map Attribute -> AttributeName
attributeName Vector Attribute
attrsIntersection
attrsIntersection :: Vector Attribute
attrsIntersection = (Attribute -> Bool) -> Vector Attribute -> Vector Attribute
forall a. (a -> Bool) -> Vector a -> Vector a
V.filter (Attribute -> Vector Attribute -> Bool
forall a. Eq a => a -> Vector a -> Bool
`V.elem` Attributes -> Vector Attribute
attributesVec Attributes
tupAttrs1) (Attributes -> Vector Attribute
attributesVec Attributes
tupAttrs2)
newVec :: Vector Atom
newVec = (Attribute -> Atom) -> Vector Attribute -> Vector Atom
forall a b. (a -> b) -> Vector a -> Vector b
V.map (AttributeName -> Atom
findAtomForAttributeName (AttributeName -> Atom)
-> (Attribute -> AttributeName) -> Attribute -> Atom
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Attribute -> AttributeName
attributeName) (Attributes -> Vector Attribute
attributesVec Attributes
joinedAttrs)
findAtomForAttributeName :: AttributeName -> Atom
findAtomForAttributeName AttributeName
attrName = [Atom] -> Atom
forall a. [a] -> a
head ([Atom] -> Atom) -> [Atom] -> Atom
forall a b. (a -> b) -> a -> b
$ [Either RelationalError Atom] -> [Atom]
forall a b. [Either a b] -> [b]
rights ([Either RelationalError Atom] -> [Atom])
-> [Either RelationalError Atom] -> [Atom]
forall a b. (a -> b) -> a -> b
$ (RelationTuple -> Either RelationalError Atom)
-> [RelationTuple] -> [Either RelationalError Atom]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (AttributeName -> RelationTuple -> Either RelationalError Atom
atomForAttributeName AttributeName
attrName) [RelationTuple
tup1, RelationTuple
tup2]
vectorUnion :: (Eq a) => V.Vector a -> V.Vector a -> V.Vector a
vectorUnion :: Vector a -> Vector a -> Vector a
vectorUnion Vector a
v1 Vector a
v2 = (a -> Vector a -> Vector a) -> Vector a -> Vector a -> Vector a
forall a b. (a -> b -> b) -> b -> Vector a -> b
V.foldr a -> Vector a -> Vector a
folder Vector a
v1 Vector a
v2
where
folder :: a -> Vector a -> Vector a
folder a
e Vector a
acc = if a -> Vector a -> Bool
forall a. Eq a => a -> Vector a -> Bool
V.elem a
e Vector a
v1 then
Vector a
acc
else
Vector a -> a -> Vector a
forall a. Vector a -> a -> Vector a
V.snoc Vector a
acc a
e
tupleExtend :: RelationTuple -> RelationTuple -> RelationTuple
tupleExtend :: RelationTuple -> RelationTuple -> RelationTuple
tupleExtend (RelationTuple Attributes
tupAttrs1 Vector Atom
tupVec1) (RelationTuple Attributes
tupAttrs2 Vector Atom
tupVec2) = Attributes -> Vector Atom -> RelationTuple
RelationTuple Attributes
newAttrs Vector Atom
newVec
where
newAttrs :: Attributes
newAttrs = Attributes
tupAttrs1 Attributes -> Attributes -> Attributes
forall a. Semigroup a => a -> a -> a
<> Attributes
tupAttrs2
newVec :: Vector Atom
newVec = Vector Atom
tupVec1 Vector Atom -> Vector Atom -> Vector Atom
forall a. Semigroup a => a -> a -> a
<> Vector Atom
tupVec2
tupleAtomExtend :: AttributeName -> Atom -> RelationTuple -> RelationTuple
tupleAtomExtend :: AttributeName -> Atom -> RelationTuple -> RelationTuple
tupleAtomExtend AttributeName
newAttrName Atom
atom RelationTuple
tupIn = RelationTuple -> RelationTuple -> RelationTuple
tupleExtend RelationTuple
tupIn RelationTuple
newTup
where
newTup :: RelationTuple
newTup = Attributes -> Vector Atom -> RelationTuple
RelationTuple (Attribute -> Attributes
A.singleton (Attribute -> Attributes) -> Attribute -> Attributes
forall a b. (a -> b) -> a -> b
$ AttributeName -> AtomType -> Attribute
Attribute AttributeName
newAttrName (Atom -> AtomType
atomTypeForAtom Atom
atom)) (Atom -> Vector Atom
forall a. a -> Vector a
V.singleton Atom
atom)
tupleProject :: Attributes -> RelationTuple -> Either RelationalError RelationTuple
tupleProject :: Attributes -> RelationTuple -> Either RelationalError RelationTuple
tupleProject Attributes
projectAttrs RelationTuple
tup = do
Vector Atom
newTupVec <- (Vector Atom -> Attribute -> Either RelationalError (Vector Atom))
-> Vector Atom
-> Vector Attribute
-> Either RelationalError (Vector Atom)
forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldM (\Vector Atom
acc Attribute
attr ->
Vector Atom -> Atom -> Vector Atom
forall a. Vector a -> a -> Vector a
V.snoc Vector Atom
acc (Atom -> Vector Atom)
-> Either RelationalError Atom
-> Either RelationalError (Vector Atom)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> AttributeName -> RelationTuple -> Either RelationalError Atom
atomForAttributeName (Attribute -> AttributeName
attributeName Attribute
attr) RelationTuple
tup
) Vector Atom
forall a. Vector a
V.empty (Attributes -> Vector Attribute
attributesVec Attributes
projectAttrs)
RelationTuple -> Either RelationalError RelationTuple
forall (f :: * -> *) a. Applicative f => a -> f a
pure (RelationTuple -> Either RelationalError RelationTuple)
-> RelationTuple -> Either RelationalError RelationTuple
forall a b. (a -> b) -> a -> b
$ Attributes -> RelationTuple -> RelationTuple
reorderTuple Attributes
projectAttrs (Attributes -> Vector Atom -> RelationTuple
RelationTuple Attributes
projectAttrs Vector Atom
newTupVec)
tupleIntersection :: RelationTuple -> RelationTuple -> RelationTuple
tupleIntersection :: RelationTuple -> RelationTuple -> RelationTuple
tupleIntersection RelationTuple
tuple1 RelationTuple
tuple2 = Attributes -> Vector Atom -> RelationTuple
RelationTuple Attributes
newAttrs Vector Atom
newTupVec
where
attrs1 :: Attributes
attrs1 = RelationTuple -> Attributes
tupleAttributes RelationTuple
tuple1
attrs2 :: Attributes
attrs2 = RelationTuple -> Attributes
tupleAttributes RelationTuple
tuple2
intersectAttrs :: Attributes
intersectAttrs = Attributes -> Attributes -> Attributes
A.intersection Attributes
attrs1 Attributes
attrs2
matchingIndices :: Vector Int
matchingIndices = (Attribute -> Bool) -> Vector Attribute -> Vector Int
forall a. (a -> Bool) -> Vector a -> Vector Int
V.findIndices (\Attribute
attr -> Attribute -> Attributes -> Bool
A.member Attribute
attr Attributes
intersectAttrs Bool -> Bool -> Bool
&&
AttributeName -> RelationTuple -> Either RelationalError Atom
atomForAttributeName (Attribute -> AttributeName
attributeName Attribute
attr) RelationTuple
tuple1 Either RelationalError Atom -> Either RelationalError Atom -> Bool
forall a. Eq a => a -> a -> Bool
==
AttributeName -> RelationTuple -> Either RelationalError Atom
atomForAttributeName (Attribute -> AttributeName
attributeName Attribute
attr) RelationTuple
tuple2) (Attributes -> Vector Attribute
attributesVec Attributes
attrs1)
indexFilter :: Vector a -> Vector a
indexFilter = (Int -> a -> Bool) -> Vector a -> Vector a
forall a. (Int -> a -> Bool) -> Vector a -> Vector a
V.ifilter (\Int
index a
_ -> Int -> Vector Int -> Bool
forall a. Eq a => a -> Vector a -> Bool
V.elem Int
index Vector Int
matchingIndices)
newAttrs :: Attributes
newAttrs = case Set AttributeName
-> Attributes -> Either RelationalError Attributes
A.projectionAttributesForNames (Attributes -> Set AttributeName
A.attributeNameSet Attributes
intersectAttrs) Attributes
attrs1 of
Left RelationalError
_ -> Attributes
forall a. Monoid a => a
mempty
Right Attributes
attrs' -> Attributes
attrs'
newTupVec :: Vector Atom
newTupVec = Vector Atom -> Vector Atom
forall a. Vector a -> Vector a
indexFilter (RelationTuple -> Vector Atom
tupleAtoms RelationTuple
tuple1)
updateTupleWithAtoms :: M.Map AttributeName Atom -> RelationTuple -> RelationTuple
updateTupleWithAtoms :: Map AttributeName Atom -> RelationTuple -> RelationTuple
updateTupleWithAtoms Map AttributeName Atom
updateMap (RelationTuple Attributes
attrs Vector Atom
tupVec) = Attributes -> Vector Atom -> RelationTuple
RelationTuple Attributes
attrs Vector Atom
newVec
where
updateKeysSet :: Set AttributeName
updateKeysSet = Map AttributeName Atom -> Set AttributeName
forall k a. Map k a -> Set k
M.keysSet Map AttributeName Atom
updateMap
updateKeysIVec :: Vector (Int, Attribute)
updateKeysIVec = ((Int, Attribute) -> Bool)
-> Vector (Int, Attribute) -> Vector (Int, Attribute)
forall a. (a -> Bool) -> Vector a -> Vector a
V.filter (\(Int
_,Attribute
attr) -> AttributeName -> Set AttributeName -> Bool
forall a. Ord a => a -> Set a -> Bool
S.member (Attribute -> AttributeName
attributeName Attribute
attr) Set AttributeName
updateKeysSet) (Vector Attribute -> Vector (Int, Attribute)
forall a. Vector a -> Vector (Int, a)
V.indexed (Attributes -> Vector Attribute
attributesVec Attributes
attrs))
newVec :: Vector Atom
newVec = Vector Atom -> Vector (Int, Atom) -> Vector Atom
forall a. Vector a -> Vector (Int, a) -> Vector a
V.update Vector Atom
tupVec Vector (Int, Atom)
updateVec
updateVec :: Vector (Int, Atom)
updateVec = ((Int, Attribute) -> (Int, Atom))
-> Vector (Int, Attribute) -> Vector (Int, Atom)
forall a b. (a -> b) -> Vector a -> Vector b
V.map (\(Int
index, Attribute
attr) -> (Int
index, Map AttributeName Atom
updateMap Map AttributeName Atom -> AttributeName -> Atom
forall k a. Ord k => Map k a -> k -> a
M.! Attribute -> AttributeName
attributeName Attribute
attr)) Vector (Int, Attribute)
updateKeysIVec
tupleToMap :: RelationTuple -> M.Map AttributeName Atom
tupleToMap :: RelationTuple -> Map AttributeName Atom
tupleToMap (RelationTuple Attributes
attrs Vector Atom
tupVec) = [(AttributeName, Atom)] -> Map AttributeName Atom
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList [(AttributeName, Atom)]
assocList
where
assocList :: [(AttributeName, Atom)]
assocList = Vector (AttributeName, Atom) -> [(AttributeName, Atom)]
forall a. Vector a -> [a]
V.toList (Vector (AttributeName, Atom) -> [(AttributeName, Atom)])
-> Vector (AttributeName, Atom) -> [(AttributeName, Atom)]
forall a b. (a -> b) -> a -> b
$ ((Int, Attribute) -> (AttributeName, Atom))
-> Vector (Int, Attribute) -> Vector (AttributeName, Atom)
forall a b. (a -> b) -> Vector a -> Vector b
V.map (\(Int
index, Attribute
attr) -> (Attribute -> AttributeName
attributeName Attribute
attr, Vector Atom
tupVec Vector Atom -> Int -> Atom
forall a. Vector a -> Int -> a
V.! Int
index)) (Vector Attribute -> Vector (Int, Attribute)
forall a. Vector a -> Vector (Int, a)
V.indexed (Attributes -> Vector Attribute
attributesVec Attributes
attrs))
verifyTuple :: Attributes -> RelationTuple -> Either RelationalError RelationTuple
verifyTuple :: Attributes -> RelationTuple -> Either RelationalError RelationTuple
verifyTuple Attributes
attrs RelationTuple
tuple = let attrsTypes :: Vector AtomType
attrsTypes = Attributes -> Vector AtomType
A.atomTypes Attributes
attrs
tupleTypes :: Vector AtomType
tupleTypes = (Atom -> AtomType) -> Vector Atom -> Vector AtomType
forall a b. (a -> b) -> Vector a -> Vector b
V.map Atom -> AtomType
atomTypeForAtom (RelationTuple -> Vector Atom
tupleAtoms RelationTuple
tuple) in
if Attributes -> Int
A.arity Attributes
attrs Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Vector AtomType -> Int
forall a. Vector a -> Int
V.length Vector AtomType
tupleTypes then
RelationalError -> Either RelationalError RelationTuple
forall a b. a -> Either a b
Left (RelationalError -> Either RelationalError RelationTuple)
-> RelationalError -> Either RelationalError RelationTuple
forall a b. (a -> b) -> a -> b
$ Int -> RelationalError
TupleAttributeCountMismatchError Int
0
else do
((AtomType, AtomType) -> Either RelationalError AtomType)
-> Vector (AtomType, AtomType) -> Either RelationalError ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ ((AtomType -> AtomType -> Either RelationalError AtomType)
-> (AtomType, AtomType) -> Either RelationalError AtomType
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry AtomType -> AtomType -> Either RelationalError AtomType
atomTypeVerify) (Vector AtomType -> Vector AtomType -> Vector (AtomType, AtomType)
forall a b. Vector a -> Vector b -> Vector (a, b)
V.zip Vector AtomType
attrsTypes Vector AtomType
tupleTypes)
RelationTuple -> Either RelationalError RelationTuple
forall a b. b -> Either a b
Right RelationTuple
tuple
reorderTuple :: Attributes -> RelationTuple -> RelationTuple
reorderTuple :: Attributes -> RelationTuple -> RelationTuple
reorderTuple Attributes
attrs RelationTuple
tupIn = if Attributes -> Attributes -> Bool
attributesAndOrderEqual (RelationTuple -> Attributes
tupleAttributes RelationTuple
tupIn) Attributes
attrs then
RelationTuple
tupIn
else
Attributes -> Vector Atom -> RelationTuple
RelationTuple Attributes
attrs ((Attribute -> Atom) -> Vector Attribute -> Vector Atom
forall a b. (a -> b) -> Vector a -> Vector b
V.map Attribute -> Atom
mapper (Attributes -> Vector Attribute
attributesVec Attributes
attrs))
where
mapper :: Attribute -> Atom
mapper Attribute
attr = case AttributeName -> RelationTuple -> Either RelationalError Atom
atomForAttributeName (Attribute -> AttributeName
attributeName Attribute
attr) RelationTuple
tupIn of
Left RelationalError
err -> [Char] -> Atom
forall a. HasCallStack => [Char] -> a
error ([Char]
"logic bug in reorderTuple: " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ RelationalError -> [Char]
forall a. Show a => a -> [Char]
show RelationalError
err [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> RelationTuple -> [Char]
forall a. Show a => a -> [Char]
show RelationTuple
tupIn)
Right Atom
atom -> Atom
atom
trimTuple :: Int -> RelationTuple -> RelationTuple
trimTuple :: Int -> RelationTuple -> RelationTuple
trimTuple Int
index (RelationTuple Attributes
attrs Vector Atom
vals) =
Attributes -> Vector Atom -> RelationTuple
RelationTuple Attributes
newAttrs (Int -> Vector Atom -> Vector Atom
forall a. Int -> Vector a -> Vector a
V.drop Int
index Vector Atom
vals)
where
newAttrs :: Attributes
newAttrs = Int -> Attributes -> Attributes
A.drop Int
index Attributes
attrs