git.iko.soy/project-m36
on master help sign in
properly handle more than two fields in product types

resolves #237

commita3402fc9a8e1ddbd23f24881d0efdf9384ac2581 authorAgentM <agentm@themactionfaction.com> dateThu 9 May 2019, 01:11 (7 years ago) parent001a674
2 files changed+33−8
compare with master
unifiedsplit
src/lib/ProjectM36/Atomable.hs+5−6 test/Relation/Atomable.hs+28−2
src/lib/ProjectM36/Atomable.hs+5−6
@@ -271,12 +271,11 @@ instance AtomableG U1 where
271271
272272-- product types
273273instance (AtomableG a, AtomableG b) => AtomableG (a :*: b) where
274− toAtomG = error "invalid toAtomG in :*:"
275− fromAtomG atom args = (:*:) <$> fromAtomG atom [headatom args] <*> fromAtomG atom (tailatoms args)
276− where headatom (x:_) = x
277− headatom [] = error "no more atoms in head for product!"
278− tailatoms (_:xs) = xs
279− tailatoms [] = error "no more atoms in tail for product!"
274+ toAtomG = undefined
275+ fromAtomG atom args = (:*:) <$> fromAtomG atom splitargs1 <*> fromAtomG atom splitargs2
276+ where splitargs1 = take splitpoint args
277+ splitargs2 = drop splitpoint args
278+ splitpoint = length args `div` 2
280279 toAtomTypeG = error "invalid toAtomTypeG in :*:"
281280 toAtomsG (x :*: y) = toAtomsG x ++ toAtomsG y
282281 toAddTypeExprG = error "invalid toAddTypeExprG in :*:"
test/Relation/Atomable.hs+28−2
@@ -52,14 +52,30 @@ data User = User
5252 { userFirstName :: Text
5353 , userLastName :: Text
5454 } deriving (Eq, Ord, Show, Generic, NFData, Binary, Atomable)
55−
55+
56+data Test9_4T = Test9_4C {
57+ f9_41 :: Int,
58+ f9_42 :: Int,
59+ f9_43 :: Int,
60+ f9_44 :: Int }
61+ deriving (Show, Generic, Eq, Binary, NFData, Atomable)
62+
63+data Test9_5T = Test9_5C {
64+ f9_51 :: Int,
65+ f9_52 :: Int,
66+ f9_53 :: Int,
67+ f9_54 :: Int,
68+ f9_55 :: Int
69+ }
70+ deriving (Show, Generic, Eq, Binary, NFData, Atomable)
71+
5672main :: IO ()
5773main = do
5874 tcounts <- runTestTT testList
5975 if errors tcounts + failures tcounts > 0 then exitFailure else exitSuccess
6076
6177testList :: Test
62−testList = TestList [testHaskell2DB, testADT1, testADT2, testADT3, testADT4, testADT5, testBasicMarshaling, testListInstance, testNonEmptyInstance, testADT6Maybe, testADT7Either, testNonPrimitiveValues, testRecordType]
78+testList = TestList [testHaskell2DB, testADT1, testADT2, testADT3, testADT4, testADT5, testBasicMarshaling, testListInstance, testNonEmptyInstance, testADT6Maybe, testADT7Either, testNonPrimitiveValues, testRecordType, testManyFields]
6379
6480-- test some basic data types like int, day, etc.
6581testBasicMarshaling :: Test
@@ -163,3 +179,13 @@ testRecordType = TestCase $ do
163179 let expected = AddTypeConstructor (ADTypeConstructorDef "User" []) [DataConstructorDef "User" [DataConstructorDefTypeConstructorArg (PrimitiveTypeConstructor "Text" TextAtomType),DataConstructorDefTypeConstructorArg (PrimitiveTypeConstructor "Text" TextAtomType)]]
164180
165181 assertEqual "User record to database context expr" expected (toAddTypeExpr (Proxy :: Proxy User))
182+
183+--test both odd and even product types with more than 2 fields
184+testManyFields :: Test
185+testManyFields = TestCase $ do
186+ let example4 = Test9_4C 1 2 3 4
187+ assertEqual "four fields product type" example4 (fromAtom (toAtom example4))
188+
189+ let example5 = Test9_5C 1 2 3 4 5
190+ assertEqual "five fields product type" example5 (fromAtom (toAtom example5))
191+