aebcccd · project-m36 · git.iko.soy

examples/hair.hs+5−3

compare with master

unifiedsplit

@@ -31,11 +31,13 @@ main = do

31

32 --create a relation with the new Hair AtomType

33 let blond = NakedAtomExpr (toAtom Blond)

34− eCheck $ executeDatabaseContextExpr sessionId conn (Assign "people" (MakeRelationFromExprs Nothing [

34+ eCheck $ executeDatabaseContextExpr sessionId conn

35+ (Assign "people"

36+ (MakeRelationFromExprs Nothing $ TupleExprs () [

35− TupleExpr (M.fromList [("hair", blond), ("name", NakedAtomExpr (TextAtom "Colin"))])]))

37+ TupleExpr (M.fromList [("hair", blond), ("name", NakedAtomExpr (TextAtom "Colin"))])]))

36

38

37 let restrictionPredicate = AttributeEqualityPredicate "hair" blond

39 let restrictionPredicate = AttributeEqualityPredicate "hair" blond

38 peopleRel <- eCheck $ executeRelationalExpr sessionId conn (Restrict restrictionPredicate (RelationVariable "people" ()))

40 peopleRel <- eCheck $ executeRelationalExpr sessionId conn (Restrict restrictionPredicate (RelationVariable "people" ()))

39

41

40 TIO.putStrLn (showRelation peopleRel)

42 TIO.putStrLn (showRelation peopleRel)

41−

43+

src/bin/ProjectM36/Server/RemoteCallTypes/Json.hs+3

@@ -22,6 +22,9 @@ instance FromJSON RelationalExpr

22instance ToJSON TupleExpr

23instance FromJSON TupleExpr

24

25+instance ToJSON TupleExprs

26+instance FromJSON TupleExprs

27+

25instance ToJSON RestrictionPredicateExpr

28instance ToJSON RestrictionPredicateExpr

26instance FromJSON RestrictionPredicateExpr

29instance FromJSON RestrictionPredicateExpr

27

30

src/bin/TutorialD/Interpreter/RelationalExpr.hs+2−1

@@ -29,7 +29,8 @@ makeRelationP = do

29 reserved "relation"

30 attrExprs <- try (fmap Just makeAttributeExprsP) <|> pure Nothing

31 tupleExprs <- braces (sepBy tupleExprP comma) <|> pure []

32+ marker <- parseMarkerP

32− pure $ MakeRelationFromExprs attrExprs tupleExprs

33+ pure $ MakeRelationFromExprs attrExprs (TupleExprs marker tupleExprs)

33

34

35

35--abstract data type parser- in this context, the type constructor must not include any type arguments

36--abstract data type parser- in this context, the type constructor must not include any type arguments

src/bin/benchmark/Handles.hs+2

@@ -6,7 +6,9 @@ import Options.Applicative

6import TutorialD.Interpreter

7import TutorialD.Interpreter.Base hiding (Parser, option)

8import qualified Data.Text as T

9+#if __GLASGOW_HASKELL__ <= 802

9import Data.Monoid

10import Data.Monoid

11+#endif

10import Control.Monad

12import Control.Monad

11

13

12data HandlesArgs = HandlesArgs {

14data HandlesArgs = HandlesArgs {

src/lib/ProjectM36/Base.hs+12−1

@@ -185,7 +185,7 @@ type RelationalExpr = RelationalExprBase ()

185-- | A relational expression represents query (read) operations on a database.

186data RelationalExprBase a =

187 --- | Create a relation from tuple expressions.

188− MakeRelationFromExprs (Maybe [AttributeExprBase a]) [TupleExprBase a] |

188+ MakeRelationFromExprs (Maybe [AttributeExprBase a]) (TupleExprsBase a) |

189 --- | Create and reference a relation from attributes and a tuple set.

190 MakeStaticRelation Attributes RelationTupleSet |

191 --- | Reference an existing relation in Haskell-space.

@@ -549,6 +549,15 @@ type TupleExpr = TupleExprBase ()

549

550type GraphRefTupleExpr = TupleExprBase GraphRefTransactionMarker

551

552+data TupleExprsBase a = TupleExprs a [TupleExprBase a]

553+ deriving (Eq, Show, Generic, NFData, Foldable, Functor, Traversable)

554+

555+type GraphRefTupleExprs = TupleExprsBase GraphRefTransactionMarker

556+

557+type TupleExprs = TupleExprsBase ()

558+

559+instance Binary TupleExprs

560+

552data MergeStrategy =

561data MergeStrategy =

553 -- | After a union merge, the merge transaction is a result of union'ing relvars of the same name, introducing all uniquely-named relvars, union of constraints, union of atom functions, notifications, and types (unless the names and definitions collide, e.g. two types of the same name with different definitions)

562 -- | After a union merge, the merge transaction is a result of union'ing relvars of the same name, introducing all uniquely-named relvars, union of constraints, union of atom functions, notifications, and types (unless the names and definitions collide, e.g. two types of the same name with different definitions)

554 UnionMergeStrategy |

563 UnionMergeStrategy |

@@ -624,6 +633,8 @@ unimplemented :: HasCallStack => a

624unimplemented = undefined

633unimplemented = undefined

625

634

626--for serializing GraphRefRelationalExpr as part of transaction serialization

635--for serializing GraphRefRelationalExpr as part of transaction serialization

636+instance Binary (TupleExprsBase GraphRefTransactionMarker)

637+

627instance Binary (TupleExprBase GraphRefTransactionMarker)

638instance Binary (TupleExprBase GraphRefTransactionMarker)

628

639

629instance Binary GraphRefRelationalExpr

640instance Binary GraphRefRelationalExpr

src/lib/ProjectM36/Client.hs+1

@@ -99,6 +99,7 @@ module ProjectM36.Client

99 AtomType(..),

100 Atomable(..),

101 TupleExprBase(..),

102+ TupleExprsBase(..),

102 AtomExprBase(..),

103 AtomExprBase(..),

103 RestrictionPredicateExprBase(..),

104 RestrictionPredicateExprBase(..),

104 withTransaction

105 withTransaction

src/lib/ProjectM36/NormalizeExpr.hs+7−2

@@ -21,7 +21,7 @@ processRelationalExpr (MakeRelationFromExprs mAttrs tupleExprs) = do

21 mAttrs' <- case mAttrs of

22 Nothing -> pure Nothing

23 Just mAttrs'' -> Just <$> mapM processAttributeExpr mAttrs''

24− MakeRelationFromExprs mAttrs' <$> mapM processTupleExpr tupleExprs

24+ MakeRelationFromExprs mAttrs' <$> processTupleExprs tupleExprs

25processRelationalExpr (MakeStaticRelation attrs tupSet) = pure (MakeStaticRelation attrs tupSet)

26processRelationalExpr (ExistingRelation rel) = pure (ExistingRelation rel)

27--requires current trans id and graph

@@ -115,8 +115,13 @@ processAtomExpr (FunctionAtomExpr fName atomExprs ()) =

115processAtomExpr (RelationAtomExpr expr) = RelationAtomExpr <$> processRelationalExpr expr

116processAtomExpr (ConstructedAtomExpr dConsName atomExprs ()) = ConstructedAtomExpr dConsName <$> mapM processAtomExpr atomExprs <*> askMarker

117

118+processTupleExprs :: TupleExprs -> ProcessExprM GraphRefTupleExprs

119+processTupleExprs (TupleExprs () tupleExprs) = do

120+ marker <- askMarker

121+ TupleExprs marker <$> mapM processTupleExpr tupleExprs

122+

118processTupleExpr :: TupleExpr -> ProcessExprM GraphRefTupleExpr

123processTupleExpr :: TupleExpr -> ProcessExprM GraphRefTupleExpr

119−processTupleExpr (TupleExpr tMap) =

124+processTupleExpr (TupleExpr tMap) = do

120 TupleExpr . M.fromList <$> mapM (\(k,v) -> (,) k <$> processAtomExpr v) (M.toList tMap)

125 TupleExpr . M.fromList <$> mapM (\(k,v) -> (,) k <$> processAtomExpr v) (M.toList tMap)

121

126

122--convert AttributeExpr to GraphRefAttributeExpr

127--convert AttributeExpr to GraphRefAttributeExpr

src/lib/ProjectM36/RelationalExpression.hs+7−6

@@ -1129,10 +1129,10 @@ evalGraphRefAttrExpr (AttributeAndTypeNameExpr attrName tCons transId) = do

1129evalGraphRefAttrExpr (NakedAttributeExpr attr) = pure attr

1130

1131-- for tuple type concrete resolution (Nothing ==> Maybe Int) when the attributes hint is Nothing, we need to first process all the tuples, then extract the concrete types on a per-attribute basis, then reprocess the tuples to include the concrete types

1132−evalGraphRefTupleExprs :: Maybe Attributes -> [GraphRefTupleExpr] -> GraphRefRelationalExprM [RelationTuple]

1132+evalGraphRefTupleExprs :: Maybe Attributes -> GraphRefTupleExprs -> GraphRefRelationalExprM [RelationTuple]

1133−evalGraphRefTupleExprs _ [] = pure []

1133+evalGraphRefTupleExprs _ (TupleExprs _ []) = pure []

1134−evalGraphRefTupleExprs mAttrs tupleExprs = do

1134+evalGraphRefTupleExprs mAttrs (TupleExprs fixedMarker tupleExprL) = do

1135− tuples <- mapM (evalGraphRefTupleExpr mAttrs) tupleExprs

1135+ tuples <- mapM (evalGraphRefTupleExpr mAttrs) tupleExprL

1136 finalAttrs <- case mAttrs of

1137 Just attrs -> pure attrs

1138 Nothing ->

@@ -1151,10 +1151,11 @@ evalGraphRefTupleExprs mAttrs tupleExprs = do

1151 Right val -> val) (zip (V.toList $ tupleAttributes tup) acc)) (V.toList $ tupleAttributes headTuple) tailTuples

1152 pure (A.attributesFromList mostResolvedTypes)

1153 --strategy: if all the tuple expr transaction markers refer to one location, then we can pass the type constructor mapping from that location, otherwise, we cannot assume that the types are the same

1154− tConsMap <- case singularTransactions tupleExprs of

1154+ tConsMap <- case singularTransactions tupleExprL of

1155 SingularTransactionRef commonTransId -> do

1156 typeConstructorMapping <$> gfDatabaseContextForMarker commonTransId

1157− NoTransactionsRef -> pure [] --no custom type constructors are referenced, so no tConsMap is needed

1157+ NoTransactionsRef -> do

1158+ typeConstructorMapping <$> gfDatabaseContextForMarker fixedMarker

1158 -- if there are multiple transaction markers in the TupleExprs, then we can't assume a single type constructor mapping- this could be improved in the future, but if all the tuples are fully resolved, then we don't need further resolution

1159 -- if there are multiple transaction markers in the TupleExprs, then we can't assume a single type constructor mapping- this could be improved in the future, but if all the tuples are fully resolved, then we don't need further resolution

1159 _ -> throwError TupleExprsReferenceMultipleMarkersError

1160 _ -> throwError TupleExprsReferenceMultipleMarkersError

1160 lift $ except $ validateAttributes tConsMap finalAttrs

1161 lift $ except $ validateAttributes tConsMap finalAttrs

src/lib/ProjectM36/StaticOptimizer.hs+1−1

@@ -393,7 +393,7 @@ isFalseExpr _ = False

393

394-- determine if the created relation can statically be determined to be empty

395isEmptyRelationExpr :: RelationalExprBase a -> Bool

396−isEmptyRelationExpr (MakeRelationFromExprs _ []) = True

396+isEmptyRelationExpr (MakeRelationFromExprs _ (TupleExprs _ [])) = True

397isEmptyRelationExpr (MakeStaticRelation _ tupSet) = null (asList tupSet)

398isEmptyRelationExpr (ExistingRelation rel) = rel == emptyRelationWithAttrs (attributes rel)

399isEmptyRelationExpr _ = False

src/lib/ProjectM36/TransGraphRelationalExpression.hs+10−2

@@ -29,6 +29,10 @@ type TransGraphTupleExpr = TupleExprBase TransactionIdLookup

29

30instance Binary TransGraphTupleExpr

31

32+type TransGraphTupleExprs = TupleExprsBase TransactionIdLookup

33+

34+instance Binary TransGraphTupleExprs

35+

32type TransGraphRestrictionPredicateExpr = RestrictionPredicateExprBase TransactionIdLookup

36type TransGraphRestrictionPredicateExpr = RestrictionPredicateExprBase TransactionIdLookup

33

37

34instance Binary TransGraphRestrictionPredicateExpr

38instance Binary TransGraphRestrictionPredicateExpr

@@ -69,7 +73,7 @@ findTrans tlook = do

69-- OUTDATED a previous attempt at this function attempted to convert TransGraphRelationalExpr to RelationalExpr by resolving the transaction lookups. However, there is no way to resolve a FunctionAtomExpr to an Atom without fully evaluating the higher levels (TupleExpr, etc.). An anonymous function expression cannot be serialized, so that workaround is out. Still, I suspect we can reuse the existing static optimizer logic to work on both structures. The current conversion reduces the chance of whole-query optimization due to full-evaluation on top of full-evaluation, so this function would benefit from some re-design.

73-- OUTDATED a previous attempt at this function attempted to convert TransGraphRelationalExpr to RelationalExpr by resolving the transaction lookups. However, there is no way to resolve a FunctionAtomExpr to an Atom without fully evaluating the higher levels (TupleExpr, etc.). An anonymous function expression cannot be serialized, so that workaround is out. Still, I suspect we can reuse the existing static optimizer logic to work on both structures. The current conversion reduces the chance of whole-query optimization due to full-evaluation on top of full-evaluation, so this function would benefit from some re-design.

70processTransGraphRelationalExpr :: TransGraphRelationalExpr -> TransGraphEvalMonad GraphRefRelationalExpr

74processTransGraphRelationalExpr :: TransGraphRelationalExpr -> TransGraphEvalMonad GraphRefRelationalExpr

71processTransGraphRelationalExpr (MakeRelationFromExprs mAttrExprs tupleExprs) = do

75processTransGraphRelationalExpr (MakeRelationFromExprs mAttrExprs tupleExprs) = do

72− tupleExprs' <- mapM processTransGraphTupleExpr tupleExprs

76+ tupleExprs' <- processTransGraphTupleExprs tupleExprs

73 case mAttrExprs of

77 case mAttrExprs of

74 Nothing -> pure (MakeRelationFromExprs Nothing tupleExprs')

78 Nothing -> pure (MakeRelationFromExprs Nothing tupleExprs')

75 Just attrExprs -> do

79 Just attrExprs -> do

@@ -119,7 +123,11 @@ processTransGraphRelationalExpr (With views expr) = do

119 ) views

123 ) views

120 expr' <- processTransGraphRelationalExpr expr

124 expr' <- processTransGraphRelationalExpr expr

121 pure (With evaldViews expr')

125 pure (With evaldViews expr')

122−

126+

127+processTransGraphTupleExprs :: TransGraphTupleExprs -> TransGraphEvalMonad GraphRefTupleExprs

128+processTransGraphTupleExprs (TupleExprs marker texprs) =

129+ TupleExprs <$> findTransId marker <*> mapM processTransGraphTupleExpr texprs

130+

123processTransGraphTupleExpr :: TransGraphTupleExpr -> TransGraphEvalMonad GraphRefTupleExpr

131processTransGraphTupleExpr :: TransGraphTupleExpr -> TransGraphEvalMonad GraphRefTupleExpr

124processTransGraphTupleExpr (TupleExpr attrMap) = do

132processTransGraphTupleExpr (TupleExpr attrMap) = do

125 let attrAssoc = mapM (\(attrName, atomExpr) -> do

133 let attrAssoc = mapM (\(attrName, atomExpr) -> do

test/Relation/Atomable.hs+1−1

@@ -101,7 +101,7 @@ testHaskell2DB = TestCase $ do

101 let createRelExpr = Assign "x" rel

102

103 rel = MakeRelationFromExprs Nothing

104− [TupleExpr (M.singleton "a1" (NakedAtomExpr atomVal))]

104+ (TupleExprs () [TupleExpr (M.singleton "a1" (NakedAtomExpr atomVal))])

105 atomVal = toAtom exampleVal

106 exampleVal = Test1C 10

107 checkExecuteDatabaseContextExpr sessionId dbconn createRelExpr

test/Relation/Basic.hs+1−1

@@ -97,7 +97,7 @@ testMkRelationFromExprsBadAttrs = TestCase $ do

97 let context = DBC.empty

98 (graph,_) <- freshTransactionGraph context

99 let reenv = mkRelationalExprEnv context graph

100− reExpr = MakeRelationFromExprs (Just [AttributeAndTypeNameExpr "badAttr1" (PrimitiveTypeConstructor "Int" IntAtomType) ()]) [TupleExpr (M.singleton "badAttr2" (NakedAtomExpr (IntAtom 1)))]

100+ reExpr = MakeRelationFromExprs (Just [AttributeAndTypeNameExpr "badAttr1" (PrimitiveTypeConstructor "Int" IntAtomType) ()]) (TupleExprs () [TupleExpr (M.singleton "badAttr2" (NakedAtomExpr (IntAtom 1)))])

101 evald = runRelationalExprM reenv (evalRelationalExpr reExpr)

102 case evald of

103 Left err -> assertEqual "tuple type mismatch" (TupleAttributeTypeMismatchError (A.attributesFromList [Attribute "badAttr2" IntAtomType])) err

test/Server/WebSocket.hs+3−2

@@ -56,13 +56,14 @@ waitForListenSocket secondsToTry port =

56 if secondsToTry <= 0 then

57 throw WaitForSocketListenException

58 else do

59− hostaddr <- inet_addr "127.0.0.1"

59+ --hostaddr <- inet_addr "127.0.0.1"

60+ hostaddr:_ <- getAddrInfo Nothing (Just "127.0.0.1") (Just (show port))

60 sock <- socket AF_INET Stream defaultProtocol

61 sock <- socket AF_INET Stream defaultProtocol

61 let handler :: IOException -> IO ()

62 let handler :: IOException -> IO ()

62 handler _ = do

63 handler _ = do

63 threadDelay 1000000

64 threadDelay 1000000

64 waitForListenSocket (secondsToTry - 1) port

65 waitForListenSocket (secondsToTry - 1) port

65− catch (connect sock (SockAddrInet port hostaddr)) handler

66+ catch (connect sock (addrAddress hostaddr)) handler

66

67

67main :: IO ()

68main :: IO ()

68main = do

69main = do

test/TransactionGraph/Persist.hs+1−1

@@ -93,7 +93,7 @@ testFunctionPersistence = TestCase $

93 conn2 <- assertIOEither $ connectProjectM36 connInfo

94 sess2 <- assertIOEither $ createSessionAtHead conn2 "master"

95

96− res <- executeRelationalExpr sess2 conn2 (MakeRelationFromExprs Nothing [TupleExpr (M.singleton "a" (FunctionAtomExpr "testdisk" [NakedAtomExpr (IntAtom 3)] ()))])

96+ res <- executeRelationalExpr sess2 conn2 (MakeRelationFromExprs Nothing (TupleExprs () [TupleExpr (M.singleton "a" (FunctionAtomExpr "testdisk" [NakedAtomExpr (IntAtom 3)] ()))]))

97 let expectedRel = mkRelationFromList (attributesFromList [Attribute "a" IntAtomType]) [[IntAtom 3]]

98 assertEqual "testdisk dbc function run" expectedRel res

99

test/TutorialD/Interpreter/AtomFunctionScript.hs+8−8

@@ -29,7 +29,7 @@ testBasicAtomFunction = TestCase $ do

29 funcAtomExpr = FunctionAtomExpr "mkTest" [NakedAtomExpr (IntegerAtom 3)] ()

30 tupleExprs = [TupleExpr (M.singleton "x" funcAtomExpr)]

31 expectedResult = mkRelationFromList (V.fromList attrs) [[IntegerAtom 3]]

32− result <- executeRelationalExpr sess conn (MakeRelationFromExprs (Just (map NakedAttributeExpr attrs)) tupleExprs)

32+ result <- executeRelationalExpr sess conn (MakeRelationFromExprs (Just (map NakedAttributeExpr attrs)) (TupleExprs () tupleExprs))

33

34 assertEqual "simple atom function equality" expectedResult result

35

@@ -40,7 +40,7 @@ testExceptionAtomFunction = TestCase $ do

40 executeTutorialD sess conn "addatomfunction \"mkTest\" Integer -> Either AtomFunctionError Integer \"\"\"(\\(IntegerAtom x:xs) -> (error (show 1))) :: [Atom] -> Either AtomFunctionError Atom\"\"\""

41 let attrs = [Attribute "x" IntegerAtomType]

42 funcAtomExpr = FunctionAtomExpr "mkTest" [NakedAtomExpr (IntegerAtom 3)] ()

43− tupleExprs = [TupleExpr (M.singleton "x" funcAtomExpr)]

43+ tupleExprs = TupleExprs () [TupleExpr (M.singleton "x" funcAtomExpr)]

44 result <- executeRelationalExpr sess conn (MakeRelationFromExprs (Just (map NakedAttributeExpr attrs)) tupleExprs)

45 assertBool "catch error exception from script" (case result of

46 Left (UnhandledExceptionError _) -> True

@@ -57,7 +57,7 @@ testNoArgumentAtomFunction = TestCase $ do

57 executeTutorialD sess conn "addatomfunction \"mkTest\" Either AtomFunctionError Integer \"\"\"(\\x -> pure (IntegerAtom 5)) :: [Atom] -> Either AtomFunctionError Atom\"\"\""

58 let attrs = [Attribute "x" IntegerAtomType]

59 funcAtomExpr = FunctionAtomExpr "mkTest" [] ()

60− tupleExprs = [TupleExpr (M.singleton "x" funcAtomExpr)]

60+ tupleExprs = TupleExprs () [TupleExpr (M.singleton "x" funcAtomExpr)]

61 expectedResult = mkRelationFromList (V.fromList attrs) [[IntegerAtom 5]]

62 result <- executeRelationalExpr sess conn (MakeRelationFromExprs (Just (map NakedAttributeExpr attrs)) tupleExprs)

63 assertEqual "no argument scripted function" expectedResult result

@@ -66,7 +66,7 @@ testArgumentTypeMismatch :: Test

66testArgumentTypeMismatch = TestCase $ do

67 (sess, conn) <- dateExamplesConnection emptyNotificationCallback

68 executeTutorialD sess conn "addatomfunction \"mkTest\" Integer -> Either AtomFunctionError Integer \"\"\"(\\(IntegerAtom x:_) -> pure $ TextAtom \"wrong type\") :: [Atom] -> Either AtomFunctionError Atom\"\"\""

69− let tupleExprs = [TupleExpr (M.singleton "x" funcAtomExpr)]

69+ let tupleExprs = TupleExprs () [TupleExpr (M.singleton "x" funcAtomExpr)]

70 funcAtomExpr = FunctionAtomExpr "mkTest" [NakedAtomExpr (IntegerAtom 3)] ()

71 attrs = [Attribute "x" IntegerAtomType]

72 expectedResult = Left (AtomTypeMismatchError IntegerAtomType TextAtomType)

@@ -80,7 +80,7 @@ testPolymorphicReturnType = TestCase $ do

80 let funcAtomExpr = FunctionAtomExpr "fromMaybe" [NakedAtomExpr (IntegerAtom 5),

81 NakedAtomExpr maybeAtom] ()

82 maybeAtom = ConstructedAtom "Just" (maybeAtomType IntegerAtomType) [IntegerAtom 3]

83− relExpr = MakeRelationFromExprs Nothing [TupleExpr (M.singleton "x" funcAtomExpr)]

83+ relExpr = MakeRelationFromExprs Nothing (TupleExprs () [TupleExpr (M.singleton "x" funcAtomExpr)])

84 mRelType <- typeForRelationalExpr sess conn relExpr

85 case mRelType of

86 Left err -> assertFailure (show err)

@@ -94,7 +94,7 @@ testPolymorphicReturnType = TestCase $ do

94 let failFuncAtomExpr = FunctionAtomExpr "fromMaybe" [NakedAtomExpr (IntegerAtom 5),

95 NakedAtomExpr mismatchAtom] ()

96 mismatchAtom = ConstructedAtom "Just" (maybeAtomType TextAtomType) [TextAtom "fail"]

97− failRelExpr = MakeRelationFromExprs Nothing [TupleExpr (M.singleton "x" failFuncAtomExpr)]

97+ failRelExpr = MakeRelationFromExprs Nothing (TupleExprs () [TupleExpr (M.singleton "x" failFuncAtomExpr)])

98 mFailRes <- executeRelationalExpr sess conn failRelExpr

99 let expectedErr = Left (AtomFunctionTypeVariableMismatch "a" IntegerAtomType TextAtomType)

100 assertEqual "expected type variable mismatch" expectedErr mFailRes

@@ -106,9 +106,9 @@ testScriptedTypeVariable = TestCase $ do

106 executeTutorialD sess conn "addatomfunction \"idTest\" a -> Either AtomFunctionError a \"(\\\\(x:_) -> pure x) :: [Atom] -> Either AtomFunctionError Atom\""

107 let attrs = [Attribute "x" IntegerAtomType]

108 funcAtomExpr = FunctionAtomExpr "idTest" [NakedAtomExpr (IntegerAtom 3)] ()

109− tupleExprs = [TupleExpr (M.singleton "x" funcAtomExpr)]

109+ tupleExprs = TupleExprs () [TupleExpr (M.singleton "x" funcAtomExpr)]

110 expectedResult = mkRelationFromList (V.fromList attrs) [[IntegerAtom 3]]

111 result <- executeRelationalExpr sess conn (MakeRelationFromExprs (Just (map NakedAttributeExpr attrs)) tupleExprs)

112

113 assertEqual "id function equality" expectedResult result

114−

114+

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

@@ -20,10 +20,10 @@ testTutdImport = TestCase $

20 hClose handle

21 let expectedExpr = MultipleExpr [

22 Assign "x" (MakeRelationFromExprs Nothing

23− [TupleExpr (M.fromList [("a", NakedAtomExpr $ IntegerAtom 5),

23+ $ TupleExprs () [TupleExpr (M.fromList [("a", NakedAtomExpr $ IntegerAtom 5),

24 ("b", NakedAtomExpr $ TextAtom "spam")])]),

25 Assign "y" (MakeRelationFromExprs Nothing

26− [TupleExpr (M.fromList [("b", NakedAtomExpr (TextAtom "漢字"))])])]

26+ $ TupleExprs () [TupleExpr (M.fromList [("b", NakedAtomExpr (TextAtom "漢字"))])])]

27 imported <- importTutorialD tempPath

28 assertEqual "import tutd" (Right expectedExpr) imported

29