a75d1a1 · project-m36 · git.iko.soy

git.iko.soy/project-m36

on master help sign in

WIP: test-tutoriald compiles

a75d1a1AgentM11 years ago

TutorialD/Interpreter.hs+12−10

compare with master

unifiedsplit

@@ -35,7 +35,7 @@ data ParsedOperation = RODatabaseContextOp RODatabaseContextOperator |

35 ROGraphOp ROTransactionGraphOperator |

36 ImportRelVarOp RelVarDataImportOperator |

37 ImportDBContextOp DatabaseContextDataImportOperator |

38− ExportOp DataExportOperator

38+ RelVarExportOp RelVarDataExportOperator

40interpreterParserP :: Parser ParsedOperation

41interpreterParserP = liftM RODatabaseContextOp (roDatabaseContextOperatorP <* eof) <|>

@@ -44,7 +44,7 @@ interpreterParserP = liftM RODatabaseContextOp (roDatabaseContextOperatorP <* eo

44 liftM DatabaseExprOp (databaseExprOpP <* eof) <|>

45 liftM ImportRelVarOp (importCSVP <* eof) <|>

46 liftM ImportDBContextOp (tutdImportP <* eof) <|>

47− liftM ExportOp (exportCSVP <* eof)

47+ liftM RelVarExportOp (exportCSVP <* eof)

49promptText :: Maybe HeadName -> StringType

50promptText mHeadName = "TutorialD (" `T.append` transInfo `T.append` "): "

@@ -99,14 +99,16 @@ evalTutorialD conn expr = case expr of

99 Left err -> barf err

100 Right dbexprs -> evalTutorialD conn (DatabaseExprOp dbexprs)

101

102− (ExportOp execOp) -> do

102+ (RelVarExportOp execOp@(RelVarDataExportOperator relExpr _ _)) -> do

103− evalDataExportOperator execOp

103+ --eval relexpr to relation and pass to export function

104−{- (DisconnectedTransaction _ context) <- disconnectedTransaction conn -- !

104+ eRel <- C.executeRelationalExpr conn relExpr

105− exprErr <- evalDataExportOperator execOp context

105+ case eRel of

106− case exprErr of

106+ Left err -> barf err

107+ Right rel -> do

108+ exportResult <- evalRelVarDataExportOperator execOp rel

109+ case exportResult of

107− Just err -> barf err

110+ Just err -> barf err

108− Nothing -> return QuietSuccessResult-}

111+ Nothing -> pure QuietSuccessResult

109−

110 where

112 where

111 barf err = return $ DisplayErrorResult (T.pack (show err))

113 barf err = return $ DisplayErrorResult (T.pack (show err))

112

114

TutorialD/Interpreter/Export/Base.hs+3−3

@@ -2,8 +2,8 @@ module TutorialD.Interpreter.Export.Base where

2import ProjectM36.Base

3import ProjectM36.Error

5−data RelVarDataExportOperator = RelVarDataExportOperator (RelationalExpr -> FilePath -> IO (Maybe RelationalError)) FilePath

5+data RelVarDataExportOperator = RelVarDataExportOperator RelationalExpr FilePath (RelVarDataExportOperator -> Relation -> IO (Maybe RelationalError))

7−evalDataExportOperator :: DataExportOperator -> DatabaseContext -> IO (Maybe RelationalError)

7+evalRelVarDataExportOperator :: RelVarDataExportOperator -> Relation -> IO (Maybe RelationalError)

8−evalDataExportOperator (DataExportOperator exportFunc pathOut) context = exportFunc context pathOut

8+evalRelVarDataExportOperator op@(RelVarDataExportOperator _ _ exportFunc) rel = exportFunc op rel

TutorialD/Interpreter/Export/CSV.hs+10−16

@@ -4,31 +4,25 @@ import TutorialD.Interpreter.Export.Base

4import TutorialD.Interpreter.RelationalExpr

5import TutorialD.Interpreter.Base

6import ProjectM36.Base

7−import ProjectM36.RelationalExpression

8import ProjectM36.Error

7import ProjectM36.Error

9−import Control.Monad.State (evalState)

10import Text.Parsec.String

8import Text.Parsec.String

11import qualified Data.ByteString.Lazy as BS

9import qualified Data.ByteString.Lazy as BS

12import Control.Exception (try)

10import Control.Exception (try)

13import qualified Data.Text as T

11import qualified Data.Text as T

15−exportCSVP :: Parser DataExportOperator

13+exportCSVP :: Parser RelVarDataExportOperator

16exportCSVP = do

14exportCSVP = do

17 reserved ":exportcsv"

15 reserved ":exportcsv"

18 exportExpr <- relExprP

16 exportExpr <- relExprP

19 path <- quotedString

17 path <- quotedString

20− return $ DataExportOperator (exportRelationCSV exportExpr) path

18+ return $ RelVarDataExportOperator exportExpr path exportRelationCSV

22−exportRelationCSV :: RelationalExpr -> DatabaseContext -> FilePath -> IO (Maybe RelationalError)

20+exportRelationCSV :: RelVarDataExportOperator -> Relation -> IO (Maybe RelationalError)

23−exportRelationCSV relExpr context pathOut = do

21+exportRelationCSV (RelVarDataExportOperator _ pathOut _) rel = do

24− let exportRel = evalState (evalRelationalExpr relExpr) context

22+ case relationAsCSV rel of

25− case exportRel of

26 Left err -> return $ Just err

23 Left err -> return $ Just err

27− Right exportRel' -> do

28− case relationAsCSV exportRel' of

29− Left err -> return $ Just err

30− Right csvData -> do

24+ Right csvData -> do

31− writeResult <- try (BS.writeFile pathOut csvData) :: IO (Either IOError ())

25+ writeResult <- try (BS.writeFile pathOut csvData) :: IO (Either IOError ())

32− case writeResult of

26+ case writeResult of

33− Left err -> return $ Just (ExportError $ T.pack (show err))

27+ Left err -> return $ Just (ExportError $ T.pack (show err))

34− Right _ -> return Nothing

28+ Right _ -> return Nothing

project-m36.cabal+1−1

@@ -197,7 +197,7 @@ Test-Suite test-tutoriald

197 Default-Language: Haskell2010

198 type: exitcode-stdio-1.0

199 main-is: test/TutorialD/Interpreter.hs

200− Build-Depends: base,HUnit,Cabal

200+ Build-Depends: base, HUnit, Cabal, containers, hashable, unordered-containers, mtl, vector, vector-binary-instances, time, hashable-time, bytestring, network-transport-tcp, distributed-process, distributed-process-extras, distributed-process-client-server, uuid, stm, deepseq, deepseq-generics, binary, unix, parallel, cassava, attoparsec, gnuplot, directory, temporary, haskeline, parsec, text, base64-bytestring, data-interval, filepath

201 GHC-Options: -Wall

202 C-sources: ProjectM36/DirectoryFsync.c

203

test/TutorialD/Interpreter.hs+22−2

@@ -9,6 +9,7 @@ import ProjectM36.Tuple

9import ProjectM36.TupleSet

10import ProjectM36.Error

11import ProjectM36.Base

12+import qualified ProjectM36.Base as Base

12import ProjectM36.TransactionGraph

13import ProjectM36.TransactionGraph

13import ProjectM36.Client

14import ProjectM36.Client

14import ProjectM36.Atom

15import ProjectM36.Atom

@@ -24,6 +25,7 @@ import Data.Text (Text)

24import Data.Time.Clock (UTCTime(..))

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

25import Data.Time.Calendar (fromGregorian)

26import Data.Time.Calendar (fromGregorian)

26import Data.Interval (interval, Interval, Extended(Finite))

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

28+import Control.Concurrent.STM

28main :: IO ()

30main :: IO ()

29main = do

31main = do

@@ -131,7 +133,7 @@ transactionGraphBasicTest = TestCase $ do

131transactionGraphAddCommitTest :: Test

133transactionGraphAddCommitTest :: Test

132transactionGraphAddCommitTest = TestCase $ do

134transactionGraphAddCommitTest = TestCase $ do

133 dbconn <- dateExamplesConnection

135 dbconn <- dateExamplesConnection

134− case parseTutorialD dbconn "x:=S" of

136+ case parseTutorialD "x:=S" of

135 Left err -> assertFailure (show err)

137 Left err -> assertFailure (show err)

136 Right parsed -> do

138 Right parsed -> do

137 result <- evalTutorialD dbconn parsed

139 result <- evalTutorialD dbconn parsed

@@ -218,17 +220,35 @@ simpleJoinTest = TestCase $ assertTutdEqual dateExamples joinedRel "x:=S join SP

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

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

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

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

220 ]

222 ]

223+transactionGraph :: Connection -> IO TransactionGraph

224+transactionGraph (InProcessConnection _ tvar) = atomically $ do

225+ (_, graph) <- readTVar tvar

226+ pure graph

227+transactionGraph _ = error "remote connection used"

221

228

229+disconnectedTransaction :: Connection -> IO DisconnectedTransaction

230+disconnectedTransaction (InProcessConnection _ tvar) = atomically $ do

231+ (discon, _) <- readTVar tvar

232+ pure discon

233+disconnectedTransaction _ = error "remote connection used"

234+

235+{-

236+inclusionDependencies :: Connection -> M.Map IncDepName InclusionDependency

237+inclusionDependencies (InProcessConnection (DisconnectedTransaction _ context)) = inclusionDependencies context

238+inclusionDependencies _ = error "remote connection used"

239+-}

240+

222dateExamplesConnection :: IO (Connection)

241dateExamplesConnection :: IO (Connection)

223dateExamplesConnection = do

242dateExamplesConnection = do

224 dbconn <- connectProjectM36 (InProcessConnectionInfo NoPersistence)

243 dbconn <- connectProjectM36 (InProcessConnectionInfo NoPersistence)

244+ let incDeps = Base.inclusionDependencies dateExamples

225 case dbconn of

245 case dbconn of

226 Left err -> do

246 Left err -> do

227 hPutStrLn stderr (show err)

247 hPutStrLn stderr (show err)

228 exitFailure

248 exitFailure

229 Right conn -> do

249 Right conn -> do

230 mapM_ (\(rvName,rvRel) -> executeDatabaseContextExpr conn (Assign rvName (ExistingRelation rvRel))) (M.toList (relationVariables dateExamples))

250 mapM_ (\(rvName,rvRel) -> executeDatabaseContextExpr conn (Assign rvName (ExistingRelation rvRel))) (M.toList (relationVariables dateExamples))

231− mapM_ (\(idName,incDep) -> executeDatabaseContextExpr conn (AddInclusionDependency idName incDep)) (M.toList (inclusionDependencies dateExamples))

251+ mapM_ (\(idName,incDep) -> executeDatabaseContextExpr conn (AddInclusionDependency idName incDep)) (M.toList incDeps)

232 --skipping atom functions for now- there are no atom function manipulation operators yet

252 --skipping atom functions for now- there are no atom function manipulation operators yet

233 commit conn >>= maybeFail

253 commit conn >>= maybeFail

234 return conn

254 return conn