576e02b · project-m36 · git.iko.soy

git.iko.soy/project-m36

test compilation checkpoint

commit576e02b860baa910c6587448095f8edd2a8e1dfa authorAgentM <agentm@themactionfaction.com> dateSun 20 Mar 2016, 12:42 (11 years ago) parent4038adf

15 files changed+101−79

compare with master

unifiedsplit

Database/Persist/ProjectM36.hs+3−1 ProjectM36/Client.hs+2 ProjectM36/DateExamples.hs+10−1 ProjectM36/Relation/Show/Term.hs+4−1 ProjectM36/Server.hs+1−1 ProjectM36/Server/EntryPoints.hs+1−1 test/Relation/Basic.hs+6−5 test/Relation/Export/CSV.hs+6−5 test/Relation/Import/CSV.hs+8−6 test/Relation/StaticOptimizer.hs+1 test/Server/Main.hs+6−5 test/TransactionGraph/Persist.hs+1−1 test/TutorialD/Interpreter.hs+41−48 test/TutorialD/Interpreter/Import/TutorialD.hs+3−2 test/persistent-driver/test.hs+8−2

Database/Persist/ProjectM36.hs+3−1

@@ -11,6 +11,8 @@ import Data.UUID.V4 (nextRandom)

1111import qualified Data.Vector as V

1212import ProjectM36.Error

1313import ProjectM36.Relation

14+import ProjectM36.AtomFunctions.Primitive

15+import ProjectM36.DataTypes.Primitive

1416import qualified Control.Monad.IO.Class as Trans

1517import Control.Monad.Trans.Class

1618import Control.Monad.Trans.Reader (ask, ReaderT)

@@ -53,7 +55,7 @@ recordAttributes entInfo record = do

5355 let convertAttr = uncurry fieldDefAsAttribute

5456 idDBName = unDBName $ fieldDB $ entityId (entityDef $ Just record)

5557 attrList <- mapM convertAttr entInfo

56− return $ V.fromList ([Attribute idDBName stringAtomType] ++ attrList)

58+ return $ V.fromList ([Attribute idDBName textAtomType] ++ attrList)

5759

5860fieldDefAsAttribute :: EmbedFieldDef -> PersistValue -> Either RelationalError Attribute

5961fieldDefAsAttribute fieldDef pVal = case persistValueAtomType pVal of

ProjectM36/Client.hs+2

@@ -45,6 +45,8 @@ module ProjectM36.Client

4545 emptyNotificationCallback,

4646 EvaluatedNotification(..),

4747 atomTypesAsRelation,

48+ AttributeExpr(..),

49+ TypeConstructor(..),

4850 AtomType(..)) where

4951import ProjectM36.Base hiding (inclusionDependencies) --defined in this module as well

5052import qualified ProjectM36.Base as B

ProjectM36/DateExamples.hs+10−1

@@ -1,14 +1,23 @@

1+{-# LANGUAGE OverloadedStrings #-}

12module ProjectM36.DateExamples where

23import ProjectM36.Base

4+import ProjectM36.Atom

5+import qualified ProjectM36.Attribute as A

6+import ProjectM36.Key

37import ProjectM36.AtomFunctions.Basic

48import ProjectM36.DataTypes.Basic

9+import ProjectM36.DatabaseContext

10+import ProjectM36.DataTypes.Primitive

11+import ProjectM36.Relation

12+import qualified Data.Map as M

13+import qualified Data.Set as S

514

615dateExamples :: DatabaseContext

716dateExamples = DatabaseContext { inclusionDependencies = dateIncDeps,

817 relationVariables = M.union (relationVariables basicDatabaseContext) dateRelVars,

918 notifications = M.empty,

1019 atomFunctions = basicAtomFunctions,

11− atomTypes = basicAtomTypes }

20+ typeConstructorMapping = basicTypeConstructorMapping }

1221 where

1322 dateRelVars = M.fromList [("S", suppliers),

1423 ("P", products),

ProjectM36/Relation/Show/Term.hs+4−1

@@ -88,7 +88,10 @@ attributeAsCell attr = attributeName attr `T.append` "::" `T.append` prettyAtomT

8888prettyAtomType :: AtomType -> T.Text

8989prettyAtomType (AtomType primitiveType) = T.pack (tyConName (fst (splitTyConApp (unCTR primitiveType))))

9090prettyAtomType (RelationAtomType attrs) = "relation {" `T.append` T.intercalate "," (map attributeAsCell (V.toList attrs)) `T.append` "}"

91−prettyAtomType (ConstructedAtomType tConsName typeVarMap) = tConsName `T.append` " " `T.append` T.pack (show (M.toList typeVarMap)) -- it would be nice to have the original ordering, but we don't have access to the type constructor here- maybe the typevarmap should be also positional (ordered map?)

91+prettyAtomType (ConstructedAtomType tConsName typeVarMap) = tConsName `T.append` T.concat (map showTypeVars (M.toList typeVarMap))

92+ where

93+ showTypeVars (tyVarName, aType) = " (" `T.append` tyVarName `T.append` "::" `T.append` prettyAtomType aType `T.append` ")"

94+-- it would be nice to have the original ordering, but we don't have access to the type constructor here- maybe the typevarmap should be also positional (ordered map?)

9295prettyAtomType AnyAtomType = "?AnyAtomType?"

9396

9497relationAsTable :: Relation -> Table

ProjectM36/Server.hs+1−1

@@ -33,7 +33,7 @@ serverDefinition = defaultProcess {

3333 handleCall (\conn (CreateSessionAtHead headn) -> handleCreateSessionAtHead headn conn),

3434 handleCall (\conn (CreateSessionAtCommit commitId) -> handleCreateSessionAtCommit commitId conn),

3535 handleCall (\conn (CloseSession sessionId) -> handleCloseSession sessionId conn),

36− handleCall (\conn (RetrieveAtomTypesAsRelation sessionId) -> handleAtomTypesAsRelation sessionId conn),

36+ handleCall (\conn (RetrieveAtomTypesAsRelation sessionId) -> handleRetrieveAtomTypesAsRelation sessionId conn)

3737 ],

3838 unhandledMessagePolicy = Log

3939 }

ProjectM36/Server/EntryPoints.hs+1−1

@@ -75,6 +75,6 @@ handleCloseSession sessionId conn = do

7575 reply () conn

7676

7777handleRetrieveAtomTypesAsRelation :: SessionId -> Connection -> Process (ProcessReply (Either RelationalError Relation) Connection)

78−handleRetrieveAtomTypesAsRelation = do

78+handleRetrieveAtomTypesAsRelation sessionId conn = do

7979 ret <- liftIO $ atomTypesAsRelation sessionId conn

8080 reply ret conn

test/Relation/Basic.hs+6−5

@@ -3,13 +3,14 @@ import Test.HUnit

33import ProjectM36.Base

44import ProjectM36.Relation

55import ProjectM36.Error

6+import ProjectM36.DateExamples

7+import ProjectM36.DataTypes.Primitive

68import ProjectM36.Tuple

79import ProjectM36.Atom

810import qualified ProjectM36.Attribute as A

911import qualified Data.Vector as V

1012import qualified Data.Set as S

1113import System.Exit

12−import ProjectM36.RelationalExpression

1314

1415testList :: Test

1516testList = TestList [testRelation "relationTrue" relationTrue, testRelation "relationFalse" relationFalse,

@@ -62,8 +63,8 @@ simpleRel = case mkRelation attrs tupleSet of

6263 Right rel -> rel

6364 Left _ -> undefined

6465 where

65− attrs = A.attributesFromList [Attribute "a" stringAtomType, Attribute "b" stringAtomType]

66− tupleSet = RelationTupleSet [mkRelationTuple attrs (V.fromList [stringAtom "spam", stringAtom "spam2"])]

66+ attrs = A.attributesFromList [Attribute "a" textAtomType, Attribute "b" textAtomType]

67+ tupleSet = RelationTupleSet [mkRelationTuple attrs (V.fromList [textAtom "spam", textAtom "spam2"])]

6768

6869--rename tests

6970testRename1 :: Test

@@ -77,7 +78,7 @@ testRename2 = TestCase $ assertEqual "attribute in use" (rename "b" "a" simpleRe

7778testMkRelation1 :: Test

7879testMkRelation1 = TestCase $ assertEqual "key mismatch" (Left $ TupleAttributeTypeMismatchError A.emptyAttributes) (mkRelation testAttrs testTupSet) -- the error attribute set is empty due to an optimization- the tuple attrs do not match the atoms' types

7980 where

80− testAttrs = A.attributesFromList [Attribute "a" stringAtomType]

81− testTupSet = RelationTupleSet [mkRelationTuple testAttrs $ V.fromList [stringAtom "v"],

81+ testAttrs = A.attributesFromList [Attribute "a" textAtomType]

82+ testTupSet = RelationTupleSet [mkRelationTuple testAttrs $ V.fromList [textAtom "v"],

8283 mkRelationTuple testAttrs $ V.fromList [intAtom 2]]

8384

test/Relation/Export/CSV.hs+6−5

@@ -7,6 +7,7 @@ import ProjectM36.Relation.Parse.CSV

77import qualified ProjectM36.Attribute as A

88import ProjectM36.Relation

99import ProjectM36.Atom

10+import ProjectM36.DataTypes.Primitive

1011

1112main :: IO ()

1213main = do

@@ -16,13 +17,13 @@ main = do

1617--round-trip a basic relation through CSV

1718testCSVExport :: Test

1819testCSVExport = TestCase $ do

19− let attrs = A.attributesFromList [Attribute "S#" stringAtomType,

20− Attribute "SNAME" stringAtomType,

20+ let attrs = A.attributesFromList [Attribute "S#" textAtomType,

21+ Attribute "SNAME" textAtomType,

2122 Attribute "STATUS" intAtomType,

22− Attribute "CITY" stringAtomType]

23+ Attribute "CITY" textAtomType]

2324 relOrErr = mkRelationFromList attrs [

24− [stringAtom "S9", stringAtom "Perry", intAtom 170, stringAtom "Londonderry"],

25− [stringAtom "S8", stringAtom "Mike", intAtom 150, stringAtom "Boston"]]

25+ [textAtom "S9", textAtom "Perry", intAtom 170, textAtom "Londonderry"],

26+ [textAtom "S8", textAtom "Mike", intAtom 150, textAtom "Boston"]]

2627 case relOrErr of

2728 Left err -> assertFailure $ "export relation creation failure: " ++ (show err)

2829 Right rel -> do

test/Relation/Import/CSV.hs+8−6

@@ -3,11 +3,13 @@ import Test.HUnit

33import ProjectM36.Base

44import ProjectM36.Relation.Parse.CSV

55import ProjectM36.Relation

6+import ProjectM36.Atom

7+import ProjectM36.DataTypes.Primitive

68import qualified ProjectM36.Attribute as A

79import System.Exit

810import qualified Data.Text.Lazy as T

911import Data.Text.Lazy.Encoding

10−import ProjectM36.Atom

12+

1113

1214main :: IO ()

1315main = do

@@ -17,13 +19,13 @@ main = do

1719testCSVSuccess :: Test

1820testCSVSuccess = TestCase $ do

1921 let sampleCSV = (encodeUtf8 . T.pack) "S#,CITY,STATUS,SNAME\n\"S8\",\"Boston\",150,\"Mike\"\nS9,Londonderry,170,Perry"

20− expectedAttrs = A.attributesFromList [Attribute "S#" stringAtomType,

21− Attribute "SNAME" stringAtomType,

22+ expectedAttrs = A.attributesFromList [Attribute "S#" textAtomType,

23+ Attribute "SNAME" textAtomType,

2224 Attribute "STATUS" intAtomType,

23− Attribute "CITY" stringAtomType]

25+ Attribute "CITY" textAtomType]

2426 expectedRel = mkRelationFromList expectedAttrs [

25− [stringAtom "S9", stringAtom "Perry", intAtom 170, stringAtom "Londonderry"],

26− [stringAtom "S8", stringAtom "Mike", intAtom 150, stringAtom "Boston"]]

27+ [textAtom "S9", textAtom "Perry", intAtom 170, textAtom "Londonderry"],

28+ [textAtom "S8", textAtom "Mike", intAtom 150, textAtom "Boston"]]

2729 case csvAsRelation sampleCSV expectedAttrs of

2830 Left err -> assertFailure $ show err

2931 Right csvRel -> assertEqual "csv->relation" expectedRel (Right csvRel)

test/Relation/StaticOptimizer.hs+1

@@ -2,6 +2,7 @@

22import ProjectM36.Base

33import ProjectM36.Relation

44import ProjectM36.RelationalExpression

5+import ProjectM36.DateExamples

56import ProjectM36.TupleSet

67import ProjectM36.StaticOptimizer

78import System.Exit

test/Server/Main.hs+6−5

@@ -7,7 +7,7 @@ import ProjectM36.Client

77import ProjectM36.Server

88import ProjectM36.Server.Config

99import ProjectM36.Relation

10−import ProjectM36.Atom

10+import ProjectM36.DataTypes.Primitive

1111import ProjectM36.TupleSet

1212

1313import System.Exit

@@ -70,9 +70,10 @@ testRelationalExpr sessionId conn = TestCase $ do

7070

7171testDatabaseContextExpr :: SessionId -> Connection -> Test

7272testDatabaseContextExpr sessionId conn = TestCase $ do

73− let attrs = attributesFromList [Attribute "x" intAtomType]

73+ let attrExprs = [AttributeAndTypeNameExpr "x" (PrimitiveTypeConstructor "Text" textAtomType)]

74+ attrs = attributesFromList [Attribute "x" textAtomType]

7475 testrv = "testrv"

75− dbResult <- executeDatabaseContextExpr sessionId conn (Define testrv attrs)

76+ dbResult <- executeDatabaseContextExpr sessionId conn (Define testrv attrExprs)

7677 case dbResult of

7778 Just err -> assertFailure (show err)

7879 Nothing -> do

@@ -98,9 +99,9 @@ testTypeForRelationalExpr sessionId conn = TestCase $ do

9899

99100testPlanForDatabaseContextExpr :: SessionId -> Connection -> Test

100101testPlanForDatabaseContextExpr sessionId conn = TestCase $ do

101− let attrs = attributesFromList [Attribute "x" intAtomType]

102+ let attrExprs = [AttributeAndTypeNameExpr "x" (PrimitiveTypeConstructor "Int" intAtomType)]

102103 testrv = "testrv"

103− dbExpr = Define testrv attrs

104+ dbExpr = Define testrv attrExprs

104105 planResult <- planForDatabaseContextExpr sessionId conn dbExpr

105106 case planResult of

106107 Left err -> assertFailure (show err)

test/TransactionGraph/Persist.hs+1−1

@@ -4,8 +4,8 @@ import ProjectM36.Base

44import ProjectM36.Persist (DiskSync(NoDiskSync))

55import ProjectM36.TransactionGraph.Persist

66import ProjectM36.TransactionGraph

7−import ProjectM36.RelationalExpression

87import ProjectM36.Transaction

8+import ProjectM36.DateExamples

99import System.IO.Temp

1010import System.Exit

1111import Data.Either

test/TutorialD/Interpreter.hs+41−48

@@ -3,11 +3,13 @@ import TutorialD.Interpreter.DatabaseExpr

33import TutorialD.Interpreter

44import TutorialD.Interpreter.Base

55import Test.HUnit

6−import ProjectM36.RelationalExpression

76import ProjectM36.Relation

87import ProjectM36.Tuple

98import ProjectM36.TupleSet

109import ProjectM36.Error

10+import ProjectM36.DatabaseContext

11+import ProjectM36.DataTypes.Primitive

12+import ProjectM36.DateExamples

1113import ProjectM36.Base hiding (Finite)

1214import qualified ProjectM36.Base as Base

1315import ProjectM36.TransactionGraph

@@ -22,9 +24,6 @@ import qualified Data.Vector as V

2224import Data.Text.Encoding as TE

2325import Data.Typeable (Proxy(..))

2426import Data.Text (Text)

25−import Data.Time.Clock (UTCTime(..))

26−import Data.Time.Calendar (fromGregorian)

27−import Data.Interval (interval, Interval, Extended(Finite))

2827import Control.Concurrent.STM

2928import Control.Concurrent

3029import qualified STMContainers.Map as STMMap

@@ -39,13 +38,13 @@ main = do

3938 ("x:=false", Right relationFalse),

4039 ("x:=true union false", Right relationTrue),

4140 ("x:=true; x:=false", Right relationFalse),

42− ("x:=relation{a int}", mkRelation simpleAAttributes emptyTupleSet),

43− ("x:=relation{c int} rename {c as d}", mkRelation simpleBAttributes emptyTupleSet),

44− ("y:=relation{b int, c int}; x:=y{c}", mkRelation simpleProjectionAttributes emptyTupleSet),

45− ("x:=relation{tuple{a \"spam\", b 5}}", mkRelation simpleCAttributes $ RelationTupleSet [(RelationTuple simpleCAttributes) (V.fromList [stringAtom "spam", intAtom 5])]),

41+ ("x:=relation{a Int}{}", mkRelation simpleAAttributes emptyTupleSet),

42+ ("x:=relation{c Int}{} rename {c as d}", mkRelation simpleBAttributes emptyTupleSet),

43+ ("y:=relation{b Int, c Int}{}; x:=y{c}", mkRelation simpleProjectionAttributes emptyTupleSet),

44+ ("x:=relation{tuple{a \"spam\", b 5}}", mkRelation simpleCAttributes $ RelationTupleSet [(RelationTuple simpleCAttributes) (V.fromList [textAtom "spam", intAtom 5])]),

4645 ("constraint failc true in false; x:=true", Left $ InclusionDependencyCheckError "failc"),

4746 ("x:=y; x:=true", Left $ RelVarNotDefinedError "y"),

48− ("x:=relation{}", Right relationFalse),

47+ ("x:=relation{}{}", Right relationFalse),

4948 ("x:=relation{tuple{}}", Right relationTrue),

5049 ("x:=true where true", Right relationTrue),

5150 ("x:=true where false", Right relationFalse),

@@ -56,50 +55,49 @@ main = do

5655 ("x:=true=true", Right relationTrue),

5756 ("x:=true=false", Right relationFalse),

5857 ("x:=true; undefine x", Left (RelVarNotDefinedError "x")),

59− ("x:=relation {b int, a char}; insert x relation{tuple{b 5, a \"spam\"}}", mkRelationFromTuples simpleCAttributes [RelationTuple simpleCAttributes $ V.fromList[stringAtom "spam", intAtom 5]]),

58+ ("x:=relation {b Int, a Text}{}; insert x relation{tuple{b 5, a \"spam\"}}", mkRelationFromTuples simpleCAttributes [RelationTuple simpleCAttributes $ V.fromList[textAtom "spam", intAtom 5]]),

6059 -- test nested relation constructor

6160 ("x:=relation{tuple{a 5, b relation{tuple{a 6}}}}", mkRelation nestedRelationAttributes $ RelationTupleSet [RelationTuple nestedRelationAttributes (V.fromList [intAtom 5, Atom (Relation simpleAAttributes $ RelationTupleSet [RelationTuple simpleAAttributes $ V.fromList [intAtom 6]])])]),

62− ("x:=relation{tuple{b 5,a \"spam\"},tuple{b 6,a \"sam\"}}; delete x where b=6", mkRelation simpleCAttributes $ RelationTupleSet [RelationTuple simpleCAttributes (V.fromList [stringAtom "spam", intAtom 5])]),

61+ ("x:=relation{tuple{b 5,a \"spam\"},tuple{b 6,a \"sam\"}}; delete x where b=6", mkRelation simpleCAttributes $ RelationTupleSet [RelationTuple simpleCAttributes (V.fromList [textAtom "spam", intAtom 5])]),

6362 ("x:=relation{tuple{a 5}} : {b:=@a}", mkRelation simpleDAttributes $ RelationTupleSet [RelationTuple simpleDAttributes (V.fromList [intAtom 5, intAtom 5])]),

6463 ("x:=relation{tuple{a 5}} : {b:=6}", mkRelationFromTuples simpleDAttributes [RelationTuple simpleDAttributes (V.fromList [intAtom 5, intAtom 6])]),

6564 ("x:=relation{tuple{a 5}} : {b:=add(@a,5)}", mkRelationFromTuples simpleDAttributes [RelationTuple simpleDAttributes (V.fromList [intAtom 5, intAtom 10])]),

66− ("x:=relation{tuple{a 5}} : {b:=add(@a,\"spam\")}", Left (AtomFunctionTypeError "add" 2 intAtomType stringAtomType)),

65+ ("x:=relation{tuple{a 5}} : {b:=add(@a,\"spam\")}", Left (AtomFunctionTypeError "add" 2 intAtomType textAtomType)),

6766 ("x:=relation{tuple{a 5}} : {b:=add(add(@a,2),5)}", mkRelationFromTuples simpleDAttributes [RelationTuple simpleDAttributes (V.fromList [intAtom 5, intAtom 12])])

6867 ]

6968 simpleAAttributes = A.attributesFromList [Attribute "a" intAtomType]

7069 simpleBAttributes = A.attributesFromList [Attribute "d" intAtomType]

71− simpleCAttributes = A.attributesFromList [Attribute "a" stringAtomType, Attribute "b" intAtomType]

70+ simpleCAttributes = A.attributesFromList [Attribute "a" textAtomType, Attribute "b" intAtomType]

7271 simpleDAttributes = A.attributesFromList [Attribute "a" intAtomType, Attribute "b" intAtomType]

7372 simpleMaybeTextAttributes = A.attributesFromList [Attribute "a" $ atomTypeForProxy (Proxy :: Proxy (Maybe Text))]

7473 simpleMaybeIntAttributes = A.attributesFromList [Attribute "a" $ atomTypeForProxy (Proxy :: Proxy (Maybe Int))]

75− simpleIntervalDateTimeAttributes = A.attributesFromList [Attribute "a" $ atomTypeForProxy (Proxy :: Proxy (Interval UTCTime))]

7674 simpleProjectionAttributes = A.attributesFromList [Attribute "c" intAtomType]

7775 nestedRelationAttributes = A.attributesFromList [Attribute "a" intAtomType, Attribute "b" (RelationAtomType $ A.attributesFromList [Attribute "a" intAtomType])]

7876 extendTestAttributes = A.attributesFromList [Attribute "a" intAtomType, Attribute "b" $ RelationAtomType (attributes suppliersRel)]

7977 byteStringAttributes = A.attributesFromList [Attribute "y" byteStringAtomType]

8078 groupCountAttrs = A.attributesFromList [Attribute "z" intAtomType]

81− minMaxAttrs = A.attributesFromList [Attribute "S#" stringAtomType, Attribute "z" intAtomType]

79+ minMaxAttrs = A.attributesFromList [Attribute "S#" textAtomType, Attribute "z" intAtomType]

8280 dateExampleRelTests = [("x:=S where true", Right suppliersRel),

83− ("x:=S where CITY = \"London\"", restrict (\tuple -> atomForAttributeName "CITY" tuple == (Right $ stringAtom "London")) suppliersRel),

81+ ("x:=S where CITY = \"London\"", restrict (\tuple -> atomForAttributeName "CITY" tuple == (Right $ textAtom "London")) suppliersRel),

8482 ("x:=S where false", Right $ Relation (attributes suppliersRel) emptyTupleSet),

85− ("x:=P where COLOR=\"Blue\" and CITY=\"Paris\"", mkRelationFromList (attributes productsRel) [[stringAtom "P5", stringAtom "Cam", stringAtom "Blue", intAtom 12, stringAtom "Paris"]]),

83+ ("x:=P where COLOR=\"Blue\" and CITY=\"Paris\"", mkRelationFromList (attributes productsRel) [[textAtom "P5", textAtom "Cam", textAtom "Blue", intAtom 12, textAtom "Paris"]]),

8684 ("a:=S; update a (STATUS:=50); x:=a{STATUS}", mkRelation (A.attributesFromList [Attribute "STATUS" intAtomType]) (RelationTupleSet [mkRelationTuple (A.attributesFromList [Attribute "STATUS" intAtomType]) (V.fromList [intAtom 50])])),

8785 --atom function tests

8886 ("x:=((S : {STATUS2 := add(10,@STATUS)}) where STATUS2=add(10,@STATUS)){CITY,S#,SNAME,STATUS}", Right suppliersRel),

89− ("x:=S; update x where SNAME=\"Blake\" (CITY:=\"Boston\")", relMap (\tuple -> if atomForAttributeName "SNAME" tuple == (Right $ stringAtom "Blake") then updateTuple (M.singleton "CITY" (stringAtom "Boston")) tuple else tuple) suppliersRel),

87+ ("x:=S; update x where SNAME=\"Blake\" (CITY:=\"Boston\")", relMap (\tuple -> if atomForAttributeName "SNAME" tuple == (Right $ textAtom "Blake") then updateTuple (M.singleton "CITY" (textAtom "Boston")) tuple else tuple) suppliersRel),

9088 ("x:=relation{tuple{a 5}} : {b:=S}", mkRelation extendTestAttributes (RelationTupleSet [mkRelationTuple extendTestAttributes (V.fromList [intAtom 5, Atom suppliersRel])])),

9189 --relatom function tests

9290 ("x:=((S group ({CITY} as y)):{z:=count(@y)}){z}", mkRelation groupCountAttrs (RelationTupleSet [mkRelationTuple groupCountAttrs (V.singleton $ intAtom 1)])),

9391 ("x:=(SP group ({S#} as y)) ungroup y", Right supplierProductsRel),

94− ("x:=((SP{S#,QTY}) group ({QTY} as x):{z:=max(@x)}){S#,z}", mkRelationFromList minMaxAttrs (map (\(s,i) -> [stringAtom s,intAtom i]) [("S1", 400), ("S2", 400), ("S3", 200), ("S4", 400)])),

95− ("x:=((SP{S#,QTY}) group ({QTY} as x):{z:=min(@x)}){S#,z}", mkRelationFromList minMaxAttrs (map (\(s,i) -> [stringAtom s,intAtom i]) [("S1", 100), ("S2", 300), ("S3", 200), ("S4", 200)])),

96− ("x:=((SP{S#,QTY}) group ({QTY} as x):{z:=sum(@x)}){S#,z}", mkRelationFromList minMaxAttrs (map (\(s,i) -> [stringAtom s,intAtom i]) [("S1", 1000), ("S2", 700), ("S3", 200), ("S4", 900)])),

92+ ("x:=((SP{S#,QTY}) group ({QTY} as x):{z:=max(@x)}){S#,z}", mkRelationFromList minMaxAttrs (map (\(s,i) -> [textAtom s,intAtom i]) [("S1", 400), ("S2", 400), ("S3", 200), ("S4", 400)])),

93+ ("x:=((SP{S#,QTY}) group ({QTY} as x):{z:=min(@x)}){S#,z}", mkRelationFromList minMaxAttrs (map (\(s,i) -> [textAtom s,intAtom i]) [("S1", 100), ("S2", 300), ("S3", 200), ("S4", 200)])),

94+ ("x:=((SP{S#,QTY}) group ({QTY} as x):{z:=sum(@x)}){S#,z}", mkRelationFromList minMaxAttrs (map (\(s,i) -> [textAtom s,intAtom i]) [("S1", 1000), ("S2", 700), ("S3", 200), ("S4", 900)])),

9795 --boolean function restriction

98− ("x:=S where ^lt(@STATUS,20)", mkRelationFromList (attributes suppliersRel) [[stringAtom "S2", stringAtom "Jones", intAtom 10, stringAtom "Paris"]]),

99− ("x:=S where ^gt(@STATUS,20)", mkRelationFromList (attributes suppliersRel) [[stringAtom "S3", stringAtom "Blake", intAtom 30, stringAtom "Paris"],

100− [stringAtom "S5", stringAtom "Adams", intAtom 30, stringAtom "Athens"]]),

96+ ("x:=S where ^lt(@STATUS,20)", mkRelationFromList (attributes suppliersRel) [[textAtom "S2", textAtom "Jones", intAtom 10, textAtom "Paris"]]),

97+ ("x:=S where ^gt(@STATUS,20)", mkRelationFromList (attributes suppliersRel) [[textAtom "S3", textAtom "Blake", intAtom 30, textAtom "Paris"],

98+ [textAtom "S5", textAtom "Adams", intAtom 30, textAtom "Athens"]]),

10199 ("x:=S where ^sum(@STATUS)", Left $ AtomTypeMismatchError intAtomType boolAtomType),

102− ("x:=S where ^not(gte(@STATUS,20))", mkRelationFromList (attributes suppliersRel) [[stringAtom "S2", stringAtom "Jones", intAtom 10, stringAtom "Paris"]]),

100+ ("x:=S where ^not(gte(@STATUS,20))", mkRelationFromList (attributes suppliersRel) [[textAtom "S2", textAtom "Jones", intAtom 10, textAtom "Paris"]]),

103101 --test "all but" attribute inversion syntax

104102 ("x:=S{all but S#} = S{CITY,SNAME,STATUS}", Right $ relationTrue),

105103 --test key syntax

@@ -108,14 +106,9 @@ main = do

108106 --test binary bytestring data type

109107 ("x:=relation{tuple{y \"dGVzdGRhdGE=\"::bytestring}}", mkRelationFromList byteStringAttributes [[Atom (TE.encodeUtf8 "testdata")]]),

110108 --test Maybe Text

111− ("x:=relation{tuple{a Just \"spam\"::maybe char}}", mkRelationFromList simpleMaybeTextAttributes [[Atom (Just "spam" :: Maybe Text)]]),

109+ ("x:=relation{tuple{a Just \"spam\"}}", mkRelationFromList simpleMaybeTextAttributes [[ConstructedAtom "Just" (ConstructedAtomType "Maybe" (M.singleton "a" textAtomType)) [textAtom "spam"]]]),

112110 --test Maybe Int

113− ("x:=relation{tuple{a Just 3::maybe int}}", mkRelationFromList simpleMaybeIntAttributes [[Atom (Just 3 :: Maybe Int)]]),

114− --test datetime interval

115− ("x:=relation{tuple{a interval_datetime((\"2015-01-01 00:00:00\",\"2016-01-01 00:00:00\"])}}", mkRelationFromList simpleIntervalDateTimeAttributes [

116− [Atom $ interval (Finite (UTCTime (fromGregorian 2015 1 1) 0), False)

117− (Finite (UTCTime (fromGregorian 2016 1 1) 0), True)]

118− ])

111+ ("x:=relation{tuple{a Just 3}}", mkRelationFromList simpleMaybeIntAttributes [[Atom (Just 3 :: Maybe Int)]])

119112 ]

120113

121114assertTutdEqual :: DatabaseContext -> Either RelationalError Relation -> String -> Assertion

@@ -205,24 +198,24 @@ transactionBranchTest = TestCase $ do

205198simpleJoinTest :: Test

206199simpleJoinTest = TestCase $ assertTutdEqual dateExamples joinedRel "x:=S join SP"

207200 where

208− attrs = A.attributesFromList [Attribute "CITY" stringAtomType,

201+ attrs = A.attributesFromList [Attribute "CITY" textAtomType,

209202 Attribute "QTY" intAtomType,

210− Attribute "P#" stringAtomType,

211− Attribute "S#" stringAtomType,

212− Attribute "SNAME" stringAtomType,

203+ Attribute "P#" textAtomType,

204+ Attribute "S#" textAtomType,

205+ Attribute "SNAME" textAtomType,

213206 Attribute "STATUS" intAtomType]

214− joinedRel = mkRelationFromList attrs [[stringAtom "London", intAtom 100, stringAtom "P6", stringAtom "S1", stringAtom "Smith", intAtom 20],

215− [stringAtom "London", intAtom 400, stringAtom "P3", stringAtom "S1", stringAtom "Smith", intAtom 20],

216− [stringAtom "London", intAtom 400, stringAtom "P5", stringAtom "S4", stringAtom "Clark", intAtom 20],

217− [stringAtom "London", intAtom 300, stringAtom "P1", stringAtom "S1", stringAtom "Smith", intAtom 20],

218− [stringAtom "Paris", intAtom 200, stringAtom "P2", stringAtom "S3", stringAtom "Blake", intAtom 30],

219− [stringAtom "Paris", intAtom 300, stringAtom "P1", stringAtom "S2", stringAtom "Jones", intAtom 10],

220− [stringAtom "London", intAtom 100, stringAtom "P5", stringAtom "S1", stringAtom "Smith", intAtom 20],

221− [stringAtom "London", intAtom 300, stringAtom "P4", stringAtom "S4", stringAtom "Clark", intAtom 20],

222− [stringAtom "Paris", intAtom 400, stringAtom "P2", stringAtom "S2", stringAtom "Jones", intAtom 10],

223− [stringAtom "London", intAtom 200, stringAtom "P2", stringAtom "S1", stringAtom "Smith", intAtom 20],

224− [stringAtom "London", intAtom 200, stringAtom "P4", stringAtom "S1", stringAtom "Smith", intAtom 20],

225− [stringAtom "London", intAtom 200, stringAtom "P2", stringAtom "S4", stringAtom "Clark", intAtom 20]

207+ joinedRel = mkRelationFromList attrs [[textAtom "London", intAtom 100, textAtom "P6", textAtom "S1", textAtom "Smith", intAtom 20],

208+ [textAtom "London", intAtom 400, textAtom "P3", textAtom "S1", textAtom "Smith", intAtom 20],

209+ [textAtom "London", intAtom 400, textAtom "P5", textAtom "S4", textAtom "Clark", intAtom 20],

210+ [textAtom "London", intAtom 300, textAtom "P1", textAtom "S1", textAtom "Smith", intAtom 20],

211+ [textAtom "Paris", intAtom 200, textAtom "P2", textAtom "S3", textAtom "Blake", intAtom 30],

212+ [textAtom "Paris", intAtom 300, textAtom "P1", textAtom "S2", textAtom "Jones", intAtom 10],

213+ [textAtom "London", intAtom 100, textAtom "P5", textAtom "S1", textAtom "Smith", intAtom 20],

214+ [textAtom "London", intAtom 300, textAtom "P4", textAtom "S4", textAtom "Clark", intAtom 20],

215+ [textAtom "Paris", intAtom 400, textAtom "P2", textAtom "S2", textAtom "Jones", intAtom 10],

216+ [textAtom "London", intAtom 200, textAtom "P2", textAtom "S1", textAtom "Smith", intAtom 20],

217+ [textAtom "London", intAtom 200, textAtom "P4", textAtom "S1", textAtom "Smith", intAtom 20],

218+ [textAtom "London", intAtom 200, textAtom "P2", textAtom "S4", textAtom "Clark", intAtom 20]

226219 ]

227220transactionGraph :: Connection -> IO TransactionGraph

228221transactionGraph (InProcessConnection _ _ _ tvar) = atomically $ readTVar tvar

test/TutorialD/Interpreter/Import/TutorialD.hs+3−2

@@ -2,6 +2,7 @@

22import Test.HUnit

33import ProjectM36.Base

44import ProjectM36.Atom

5+import ProjectM36.DataTypes.Primitive

56import qualified ProjectM36.Attribute as A

67import TutorialD.Interpreter.Import.TutorialD

78import System.Exit

@@ -19,7 +20,7 @@ testTutdImport = TestCase $ do

1920 withSystemTempFile "m.tutd" $ \tempPath handle -> do

2021 hPutStrLn handle "x:=relation{tuple{a 5,b \"spam\"}}"

2122 hClose handle

22− let expectedExpr = MultipleExpr [Assign "x" (ExistingRelation (Relation expectedAttrs $ RelationTupleSet [RelationTuple expectedAttrs $ V.fromList [intAtom 5, stringAtom "spam"]]))]

23− expectedAttrs = A.attributesFromList [Attribute "a" intAtomType, Attribute "b" stringAtomType]

23+ let expectedExpr = MultipleExpr [Assign "x" (ExistingRelation (Relation expectedAttrs $ RelationTupleSet [RelationTuple expectedAttrs $ V.fromList [intAtom 5, textAtom "spam"]]))]

24+ expectedAttrs = A.attributesFromList [Attribute "a" intAtomType, Attribute "b" textAtomType]

2425 imported <- importTutorialD tempPath

2526 assertEqual "import tutd" (Right expectedExpr) imported

test/persistent-driver/test.hs+8−2

@@ -11,7 +11,7 @@

1111import Test.HUnit

1212import Database.Persist.ProjectM36

1313import ProjectM36.Client

14−import ProjectM36.Atom

14+import ProjectM36.DataTypes.Primitive

1515import qualified ProjectM36.Client as C

1616import System.Exit

1717import Database.Persist

@@ -43,7 +43,13 @@ inProcSettings = InProcessConnectionInfo NoPersistence emptyNotificationCallback

4343

4444defPersonRel :: SessionId -> Connection -> IO ()

4545defPersonRel sessionId conn = do

46− maybeErr <- C.executeDatabaseContextExpr sessionId conn (Define "person" (attributesFromList [Attribute "name" stringAtomType, Attribute "age" intAtomType, Attribute "id" stringAtomType]))

46+ let textTypCons = PrimitiveTypeConstructor "Text" textAtomType

47+ intTypCons = PrimitiveTypeConstructor "Int" intAtomType

48+

49+ maybeErr <- C.executeDatabaseContextExpr sessionId conn (Define "person" [

50+ AttributeAndTypeNameExpr "name" textTypCons,

51+ AttributeAndTypeNameExpr "age" intTypCons,

52+ AttributeAndTypeNameExpr "id" textTypCons])

4753 case maybeErr of

4854 Nothing -> return ()

4955 Just err -> assertFailure $ "defPersonRel" ++ show err