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

-- return atoms in some arbitrary but consistent key order
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

--in case the oldattr does not exist in the tuple, then return the old tuple
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

--return error if attribute names match but their types do not
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
            
{-            
singleTupleSetJoin :: RelationTuple -> RelationTupleSet -> RelationTupleSet
singleTupleSetJoin tup1 tupSet = HS.union 
  where
    mapper tup2 = singleTupleJoin tup1 tup2
-}
            
-- if the keys share some keys and values, then merge the tuples
-- if there are shared attributes, if they match, create a new tuple from the atoms of both tuples based on the attribute ordering argument
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)
    --search both tuples for the attribute
    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]

--same consideration as Data.List.union- duplicates in v1 are not de-duped
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

--precondition- no overlap in attributes
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 :: S.Set AttributeName -> RelationTuple -> RelationTuple
tupleProject projectAttrs (RelationTuple attrs tupVec) = RelationTuple newAttrs newTupVec
  where
    deleteIndices = V.findIndices (\attr -> S.notMember (attributeName attr) projectAttrs) (attributesVec attrs)
    indexDeleter = V.ifilter (\index _ -> V.notElem index deleteIndices)
    newAttrs = case A.projectionAttributesForNames projectAttrs attrs of
                 Left err -> error (show (err, projectAttrs, attrs))
                 Right attrs' ->  attrs'
    newTupVec = indexDeleter tupVec
-}
-- remember that the attributes order matters
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)
--return the attributes and atoms which are equal in both vectors
--semi-join
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)

-- | An optimized form of tuple update which updates vectors efficiently.
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))

-- | Validate that the tuple has the correct attributes in the correct order
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

--two tuples can be equal but the vectors of attributes could be out-of-order
--reorder if necessary- this is useful during relMogrify so that all the relation's tuples have identical atom/attribute ordering
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

--used in Generics derivation for ADTs without named attributes
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