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

git.iko.soy/project-m36

on master help sign in

test compilation checkpoint

576e02bAgentM11 years ago

Database/Persist/ProjectM36.hs+3−1

compare with master

unifiedsplit

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

11import qualified Data.Vector as V

12import ProjectM36.Error

13import ProjectM36.Relation

14+import ProjectM36.AtomFunctions.Primitive

15+import ProjectM36.DataTypes.Primitive

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

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

15import Control.Monad.Trans.Class

17import Control.Monad.Trans.Class

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

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

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

53 let convertAttr = uncurry fieldDefAsAttribute

55 let convertAttr = uncurry fieldDefAsAttribute

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

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

55 attrList <- mapM convertAttr entInfo

57 attrList <- mapM convertAttr entInfo

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

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

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

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

59fieldDefAsAttribute fieldDef pVal = case persistValueAtomType pVal of

61fieldDefAsAttribute fieldDef pVal = case persistValueAtomType pVal of

ProjectM36/Client.hs+2

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

45 emptyNotificationCallback,

46 EvaluatedNotification(..),

47 atomTypesAsRelation,

48+ AttributeExpr(..),

49+ TypeConstructor(..),

48 AtomType(..)) where

50 AtomType(..)) where

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

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

50import qualified ProjectM36.Base as B

52import qualified ProjectM36.Base as B

ProjectM36/DateExamples.hs+10−1

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

1+{-# LANGUAGE OverloadedStrings #-}

1module ProjectM36.DateExamples where

2module ProjectM36.DateExamples where

2import ProjectM36.Base

3import ProjectM36.Base

4+import ProjectM36.Atom

5+import qualified ProjectM36.Attribute as A

6+import ProjectM36.Key

3import ProjectM36.AtomFunctions.Basic

7import ProjectM36.AtomFunctions.Basic

4import ProjectM36.DataTypes.Basic

8import 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

6dateExamples :: DatabaseContext

15dateExamples :: DatabaseContext

7dateExamples = DatabaseContext { inclusionDependencies = dateIncDeps,

16dateExamples = DatabaseContext { inclusionDependencies = dateIncDeps,

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

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

9 notifications = M.empty,

18 notifications = M.empty,

10 atomFunctions = basicAtomFunctions,

19 atomFunctions = basicAtomFunctions,

11− atomTypes = basicAtomTypes }

20+ typeConstructorMapping = basicTypeConstructorMapping }

12 where

21 where

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

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

14 ("P", products),

23 ("P", products),

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

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

88prettyAtomType :: AtomType -> T.Text

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

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

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` ")"

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?)

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?)

92prettyAtomType AnyAtomType = "?AnyAtomType?"

95prettyAtomType AnyAtomType = "?AnyAtomType?"

94relationAsTable :: Relation -> Table

97relationAsTable :: Relation -> Table

ProjectM36/Server.hs+1−1

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

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

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

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

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

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

37 ],

38 unhandledMessagePolicy = Log

39 }

ProjectM36/Server/EntryPoints.hs+1−1

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

75 reply () conn

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

78−handleRetrieveAtomTypesAsRelation = do

78+handleRetrieveAtomTypesAsRelation sessionId conn = do

79 ret <- liftIO $ atomTypesAsRelation sessionId conn

80 reply ret conn

test/Relation/Basic.hs+6−5

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

3import ProjectM36.Base

4import ProjectM36.Relation

5import ProjectM36.Error

6+import ProjectM36.DateExamples

7+import ProjectM36.DataTypes.Primitive

6import ProjectM36.Tuple

8import ProjectM36.Tuple

7import ProjectM36.Atom

9import ProjectM36.Atom

8import qualified ProjectM36.Attribute as A

10import qualified ProjectM36.Attribute as A

9import qualified Data.Vector as V

11import qualified Data.Vector as V

10import qualified Data.Set as S

12import qualified Data.Set as S

11import System.Exit

13import System.Exit

12−import ProjectM36.RelationalExpression

14testList :: Test

15testList :: Test

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

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

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

62 Right rel -> rel

63 Right rel -> rel

63 Left _ -> undefined

64 Left _ -> undefined

64 where

65 where

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

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

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

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

68--rename tests

69--rename tests

69testRename1 :: Test

70testRename1 :: Test

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

77testMkRelation1 :: Test

78testMkRelation1 :: Test

78testMkRelation1 = 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

79testMkRelation1 = 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

79 where

80 where

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

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

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

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

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

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

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

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

7import qualified ProjectM36.Attribute as A

8import ProjectM36.Relation

9import ProjectM36.Atom

10+import ProjectM36.DataTypes.Primitive

11main :: IO ()

12main :: IO ()

12main = do

13main = do

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

16--round-trip a basic relation through CSV

17--round-trip a basic relation through CSV

17testCSVExport :: Test

18testCSVExport :: Test

18testCSVExport = TestCase $ do

19testCSVExport = TestCase $ do

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

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

20− Attribute "SNAME" stringAtomType,

21+ Attribute "SNAME" textAtomType,

21 Attribute "STATUS" intAtomType,

22 Attribute "STATUS" intAtomType,

22− Attribute "CITY" stringAtomType]

23+ Attribute "CITY" textAtomType]

23 relOrErr = mkRelationFromList attrs [

24 relOrErr = mkRelationFromList attrs [

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

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

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

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

26 case relOrErr of

27 case relOrErr of

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

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

28 Right rel -> do

29 Right rel -> do

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

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

3import ProjectM36.Base

4import ProjectM36.Relation.Parse.CSV

5import ProjectM36.Relation

6+import ProjectM36.Atom

7+import ProjectM36.DataTypes.Primitive

6import qualified ProjectM36.Attribute as A

8import qualified ProjectM36.Attribute as A

7import System.Exit

9import System.Exit

8import qualified Data.Text.Lazy as T

10import qualified Data.Text.Lazy as T

9import Data.Text.Lazy.Encoding

11import Data.Text.Lazy.Encoding

10−import ProjectM36.Atom

12+

12main :: IO ()

14main :: IO ()

13main = do

15main = do

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

17testCSVSuccess :: Test

19testCSVSuccess :: Test

18testCSVSuccess = TestCase $ do

20testCSVSuccess = TestCase $ do

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

21 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,

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

21− Attribute "SNAME" stringAtomType,

23+ Attribute "SNAME" textAtomType,

22 Attribute "STATUS" intAtomType,

24 Attribute "STATUS" intAtomType,

23− Attribute "CITY" stringAtomType]

25+ Attribute "CITY" textAtomType]

24 expectedRel = mkRelationFromList expectedAttrs [

26 expectedRel = mkRelationFromList expectedAttrs [

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

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

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

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

27 case csvAsRelation sampleCSV expectedAttrs of

29 case csvAsRelation sampleCSV expectedAttrs of

28 Left err -> assertFailure $ show err

30 Left err -> assertFailure $ show err

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

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

test/Relation/StaticOptimizer.hs+1

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

2import ProjectM36.Base

3import ProjectM36.Relation

4import ProjectM36.RelationalExpression

5+import ProjectM36.DateExamples

5import ProjectM36.TupleSet

6import ProjectM36.TupleSet

6import ProjectM36.StaticOptimizer

7import ProjectM36.StaticOptimizer

7import System.Exit

8import System.Exit

test/Server/Main.hs+6−5

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

7import ProjectM36.Server

8import ProjectM36.Server.Config

9import ProjectM36.Relation

10−import ProjectM36.Atom

10+import ProjectM36.DataTypes.Primitive

11import ProjectM36.TupleSet

13import System.Exit

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

71testDatabaseContextExpr :: SessionId -> Connection -> Test

72testDatabaseContextExpr sessionId conn = TestCase $ do

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

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

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

74 testrv = "testrv"

75 testrv = "testrv"

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

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

76 case dbResult of

77 case dbResult of

77 Just err -> assertFailure (show err)

78 Just err -> assertFailure (show err)

78 Nothing -> do

79 Nothing -> do

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

99testPlanForDatabaseContextExpr :: SessionId -> Connection -> Test

100testPlanForDatabaseContextExpr :: SessionId -> Connection -> Test

100testPlanForDatabaseContextExpr sessionId conn = TestCase $ do

101testPlanForDatabaseContextExpr sessionId conn = TestCase $ do

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

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

102 testrv = "testrv"

103 testrv = "testrv"

103− dbExpr = Define testrv attrs

104+ dbExpr = Define testrv attrExprs

104 planResult <- planForDatabaseContextExpr sessionId conn dbExpr

105 planResult <- planForDatabaseContextExpr sessionId conn dbExpr

105 case planResult of

106 case planResult of

106 Left err -> assertFailure (show err)

107 Left err -> assertFailure (show err)

test/TransactionGraph/Persist.hs+1−1

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

4import ProjectM36.Persist (DiskSync(NoDiskSync))

5import ProjectM36.TransactionGraph.Persist

6import ProjectM36.TransactionGraph

7−import ProjectM36.RelationalExpression

8import ProjectM36.Transaction

7import ProjectM36.Transaction

8+import ProjectM36.DateExamples

9import System.IO.Temp

10import System.Exit

11import Data.Either

test/TutorialD/Interpreter.hs+41−48

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

3import TutorialD.Interpreter

4import TutorialD.Interpreter.Base

5import Test.HUnit

6−import ProjectM36.RelationalExpression

7import ProjectM36.Relation

6import ProjectM36.Relation

8import ProjectM36.Tuple

7import ProjectM36.Tuple

9import ProjectM36.TupleSet

8import ProjectM36.TupleSet

10import ProjectM36.Error

9import ProjectM36.Error

10+import ProjectM36.DatabaseContext

11+import ProjectM36.DataTypes.Primitive

12+import ProjectM36.DateExamples

11import ProjectM36.Base hiding (Finite)

13import ProjectM36.Base hiding (Finite)

12import qualified ProjectM36.Base as Base

14import qualified ProjectM36.Base as Base

13import ProjectM36.TransactionGraph

15import ProjectM36.TransactionGraph

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

22import Data.Text.Encoding as TE

24import Data.Text.Encoding as TE

23import Data.Typeable (Proxy(..))

25import Data.Typeable (Proxy(..))

24import Data.Text (Text)

26import Data.Text (Text)

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

26−import Data.Time.Calendar (fromGregorian)

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

28import Control.Concurrent.STM

27import Control.Concurrent.STM

29import Control.Concurrent

28import Control.Concurrent

30import qualified STMContainers.Map as STMMap

29import qualified STMContainers.Map as STMMap

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

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

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

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

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

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

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

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

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

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

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

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

43+ ("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])]),

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

57 ("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]]),

60 -- test nested relation constructor

59 -- test nested relation constructor

61 ("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]])])]),

60 ("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])]),

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

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

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

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

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

64 ("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)),

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

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

68 ]

67 ]

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

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

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

69 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]

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

78 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]

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

80 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),

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

82 ("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"]]),

86 ("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])])),

84 ("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])])),

87 --atom function tests

85 --atom function tests

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

86 ("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),

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

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

91 --relatom function tests

89 --relatom function tests

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

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

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

91 ("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)])),

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)])),

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)])),

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)])),

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)])),

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)])),

97 --boolean function restriction

95 --boolean function restriction

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

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

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

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

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

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

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

99 ("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"]]),

103 --test "all but" attribute inversion syntax

101 --test "all but" attribute inversion syntax

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

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

105 --test key syntax

103 --test key syntax

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

108 --test binary bytestring data type

106 --test binary bytestring data type

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

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

110 --test Maybe Text

108 --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"]]]),

112 --test Maybe Int

110 --test Maybe Int

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

111+ ("x:=relation{tuple{a Just 3}}", 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− ])

119 ]

112 ]

120

113

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

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

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

205simpleJoinTest :: Test

198simpleJoinTest :: Test

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

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

207 where

200 where

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

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

209 Attribute "QTY" intAtomType,

202 Attribute "QTY" intAtomType,

210− Attribute "P#" stringAtomType,

203+ Attribute "P#" textAtomType,

211− Attribute "S#" stringAtomType,

204+ Attribute "S#" textAtomType,

212− Attribute "SNAME" stringAtomType,

205+ Attribute "SNAME" textAtomType,

213 Attribute "STATUS" intAtomType]

206 Attribute "STATUS" intAtomType]

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

226 ]

219 ]

227transactionGraph :: Connection -> IO TransactionGraph

220transactionGraph :: Connection -> IO TransactionGraph

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

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

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

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

2import Test.HUnit

3import ProjectM36.Base

4import ProjectM36.Atom

5+import ProjectM36.DataTypes.Primitive

5import qualified ProjectM36.Attribute as A

6import qualified ProjectM36.Attribute as A

6import TutorialD.Interpreter.Import.TutorialD

7import TutorialD.Interpreter.Import.TutorialD

7import System.Exit

8import System.Exit

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

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

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

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

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

21 hClose handle

22 hClose handle

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

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

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

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

24 imported <- importTutorialD tempPath

25 imported <- importTutorialD tempPath

25 assertEqual "import tutd" (Right expectedExpr) imported

26 assertEqual "import tutd" (Right expectedExpr) imported

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

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

11import Test.HUnit

12import Database.Persist.ProjectM36

13import ProjectM36.Client

14−import ProjectM36.Atom

14+import ProjectM36.DataTypes.Primitive

15import qualified ProjectM36.Client as C

16import System.Exit

17import Database.Persist

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

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

45defPersonRel sessionId conn = do

46+ let textTypCons = PrimitiveTypeConstructor "Text" textAtomType

47+ intTypCons = PrimitiveTypeConstructor "Int" intAtomType

48+

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

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

50+ AttributeAndTypeNameExpr "name" textTypCons,

51+ AttributeAndTypeNameExpr "age" intTypCons,

52+ AttributeAndTypeNameExpr "id" textTypCons])

47 case maybeErr of

53 case maybeErr of

48 Nothing -> return ()

54 Nothing -> return ()

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

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