git.iko.soy/project-m36
on master help sign in
use errors when nonsensical attributes are passed to toUpdateExpr, toDeleteExpr,
commit91a357a9549f7c6835b1595b25e4393e5e1fb168 authorAgentM <agentm@themactionfaction.com> dateFri 22 Dec 2017, 19:34 (9 years ago) parent225331c
3 files changed+27−18
compare with master
unifiedsplit
src/lib/ProjectM36/Error.hs+1 src/lib/ProjectM36/Tupleable.hs+19−5 test/Relation/Tupleable.hs+7−13
src/lib/ProjectM36/Error.hs+1
@@ -14,6 +14,7 @@ import Control.Exception
1414
1515data RelationalError = NoSuchAttributeNamesError (S.Set AttributeName)
1616 | TupleAttributeCountMismatchError Int --attribute name
17+ | EmptyAttributesError
1718 | DuplicateAttributeNamesError (S.Set AttributeName)
1819 | TupleAttributeTypeMismatchError Attributes
1920 | AttributeCountMismatchError Int
src/lib/ProjectM36/Tupleable.hs+19−5
@@ -22,6 +22,7 @@ import ProjectM36.DataTypes.Primitive
2222import ProjectM36.Error
2323import ProjectM36.Tuple
2424import ProjectM36.TupleSet
25+import qualified Data.Set as S
2526
2627{-import Data.Binary
2728import Control.DeepSeq
@@ -90,22 +91,35 @@ partitionByAttributes attrs =
9091-- expression. This expression flushes the non-key attributes of the value to
9192-- a tuple with the matching key attributes.
9293toUpdateExpr ::
93− Tupleable a => RelVarName -> [AttributeName] -> a -> DatabaseContextExpr
94−toUpdateExpr rvName keyAttrs a = Update rvName updateMap keyRestriction
94+ forall a. Tupleable a => RelVarName -> [AttributeName] -> a -> Either RelationalError DatabaseContextExpr
95+toUpdateExpr rvName keyAttrs a = validateAttributes (S.fromList keyAttrs) expectedAttrSet (Update rvName updateMap keyRestriction)
9596 where
9697 (keyPairs, updatePairs) = partitionByAttributes keyAttrs a
9798 updateMap = Map.fromList $ fmap NakedAtomExpr <$> updatePairs
9899 keyRestriction = tupleAssocsEqualityPredicate keyPairs
100+ expectedAttrSet = attributeNameSet (toAttributes (Proxy :: Proxy a))
99101
100102-- | Convert a list of key attributes and a 'Tupleable' value to a 'Delete'
101103-- expression. This expression deletes tuples matching the key attributes from
102104-- the value.
103105toDeleteExpr ::
104− Tupleable a => RelVarName -> [AttributeName] -> a -> DatabaseContextExpr
105−toDeleteExpr rvName keyAttrs a = Delete rvName keyRestriction
106+ forall a. Tupleable a => RelVarName -> [AttributeName] -> a -> Either RelationalError DatabaseContextExpr
107+toDeleteExpr rvName keyAttrs val = validateAttributes (S.fromList keyAttrs) expectedAttrSet (Delete rvName keyRestriction)
106108 where
107− keyPairs = fst $ partitionByAttributes keyAttrs a
109+ keyPairs = fst $ partitionByAttributes keyAttrs val
108110 keyRestriction = tupleAssocsEqualityPredicate keyPairs
111+ expectedAttrSet = attributeNameSet (toAttributes (Proxy :: Proxy a))
112+
113+validateAttributes :: S.Set AttributeName -> S.Set AttributeName -> a -> Either RelationalError a
114+validateAttributes actualAttrs expectedAttrs val = if S.null actualAttrs then
115+ Left EmptyAttributesError
116+ else if not (S.null nonMatchingAttrs) then
117+ Left (NoSuchAttributeNamesError nonMatchingAttrs)
118+ else
119+ Right val
120+ where
121+ nonMatchingAttrs = attributeNamesNotContained actualAttrs expectedAttrs
122+
109123
110124class Tupleable a where
111125 toTuple :: a -> RelationTuple
test/Relation/Tupleable.hs+7−13
@@ -3,6 +3,7 @@ import Test.HUnit
33import ProjectM36.Tupleable
44import ProjectM36.Atomable
55import ProjectM36.Attribute
6+import ProjectM36.Error
67import Data.Binary
78import ProjectM36.Base
89import Control.DeepSeq (NFData)
@@ -10,6 +11,7 @@ import GHC.Generics
1011import qualified Data.Vector as V
1112import qualified Data.Map as M
1213import qualified Data.Text as T
14+import qualified Data.Set as S
1315import System.Exit
1416import Data.Proxy
1517
@@ -151,7 +153,7 @@ testDefineExpr = TestCase $ assertEqual "define expr" expected actual
151153
152154testUpdateExpr :: Test
153155testUpdateExpr = TestCase $ do
154− let expected = Update "rv" updateMap restriction
156+ let expected = Right (Update "rv" updateMap restriction)
155157 updateMap = M.fromList [("attr9B", NakedAtomExpr (TextAtom "b")),
156158 ("attr9C", NakedAtomExpr (DoubleAtom 5.5))]
157159 restriction = AttributeEqualityPredicate "attr9A" (NakedAtomExpr (IntegerAtom 5))
@@ -163,10 +165,7 @@ testUpdateExpr = TestCase $ do
163165
164166testUpdateExprEmptyAttrs :: Test
165167testUpdateExprEmptyAttrs = TestCase $ do
166− let expected = Update "rv" updateMap TruePredicate
167− updateMap = M.fromList [("attr9B", NakedAtomExpr (TextAtom "b")),
168− ("attr9C", NakedAtomExpr (DoubleAtom 5.5)),
169− ("attr9A", NakedAtomExpr (IntegerAtom 5))]
168+ let expected = Left EmptyAttributesError
170169 actual = toUpdateExpr "rv" [] (Test9C {attr9A = 5,
171170 attr9B = "b",
172171 attr9C = 5.5})
@@ -175,12 +174,7 @@ testUpdateExprEmptyAttrs = TestCase $ do
175174testUpdateExprWrongAttr :: Test
176175testUpdateExprWrongAttr = TestCase $ do
177176 --currently, passing in the wrong attribute replaces the whole relvar with a single tuple- is this what we want?
178− let expected = Update "rv" updateMap TruePredicate
179− updateMap = M.fromList [
180− ("attr9A", NakedAtomExpr (IntegerAtom 5)),
181− ("attr9B", NakedAtomExpr (TextAtom "b")),
182− ("attr9C", NakedAtomExpr (DoubleAtom 5.5))
183− ]
177+ let expected = Left (NoSuchAttributeNamesError (S.singleton "nonexistentattr"))
184178 actual = toUpdateExpr "rv" ["nonexistentattr"] (Test9C {attr9A = 5,
185179 attr9B = "b",
186180 attr9C = 5.5})
@@ -188,10 +182,10 @@ testUpdateExprWrongAttr = TestCase $ do
188182
189183testDeleteExpr :: Test
190184testDeleteExpr = TestCase $ do
191− let expected = Delete "rv" (AndPredicate (AttributeEqualityPredicate "attr9A"
185+ let expected = Right (Delete "rv" (AndPredicate (AttributeEqualityPredicate "attr9A"
192186 (NakedAtomExpr (IntegerAtom 5)))
193187 (AttributeEqualityPredicate "attr9B"
194− (NakedAtomExpr (TextAtom "b"))))
188+ (NakedAtomExpr (TextAtom "b")))))
195189 actual = toDeleteExpr "rv" ["attr9A", "attr9B"] (Test9C {attr9A = 5,
196190 attr9B = "b",
197191 attr9C = 5.5})