git.iko.soy/project-m36
on master help sign in
WIP: test-tutoriald compiles
commita75d1a16b3d195ee8cfe7226bb2ba02b32439618 authorAgentM <agentm@themactionfaction.com> dateSun 15 Nov 2015, 14:01 (11 years ago) parent3a76afa
5 files changed+48−32
compare with master
unifiedsplit
TutorialD/Interpreter.hs+12−10 TutorialD/Interpreter/Export/Base.hs+3−3 TutorialD/Interpreter/Export/CSV.hs+10−16 project-m36.cabal+1−1 test/TutorialD/Interpreter.hs+22−2
TutorialD/Interpreter.hs+12−10
@@ -35,7 +35,7 @@ data ParsedOperation = RODatabaseContextOp RODatabaseContextOperator |
3535 ROGraphOp ROTransactionGraphOperator |
3636 ImportRelVarOp RelVarDataImportOperator |
3737 ImportDBContextOp DatabaseContextDataImportOperator |
38− ExportOp DataExportOperator
38+ RelVarExportOp RelVarDataExportOperator
3939
4040interpreterParserP :: Parser ParsedOperation
4141interpreterParserP = liftM RODatabaseContextOp (roDatabaseContextOperatorP <* eof) <|>
@@ -44,7 +44,7 @@ interpreterParserP = liftM RODatabaseContextOp (roDatabaseContextOperatorP <* eo
4444 liftM DatabaseExprOp (databaseExprOpP <* eof) <|>
4545 liftM ImportRelVarOp (importCSVP <* eof) <|>
4646 liftM ImportDBContextOp (tutdImportP <* eof) <|>
47− liftM ExportOp (exportCSVP <* eof)
47+ liftM RelVarExportOp (exportCSVP <* eof)
4848
4949promptText :: Maybe HeadName -> StringType
5050promptText mHeadName = "TutorialD (" `T.append` transInfo `T.append` "): "
@@ -99,14 +99,16 @@ evalTutorialD conn expr = case expr of
9999 Left err -> barf err
100100 Right dbexprs -> evalTutorialD conn (DatabaseExprOp dbexprs)
101101
102− (ExportOp execOp) -> do
103− evalDataExportOperator execOp
104−{- (DisconnectedTransaction _ context) <- disconnectedTransaction conn -- !
105− exprErr <- evalDataExportOperator execOp context
106− case exprErr of
107− Just err -> barf err
108− Nothing -> return QuietSuccessResult-}
109−
102+ (RelVarExportOp execOp@(RelVarDataExportOperator relExpr _ _)) -> do
103+ --eval relexpr to relation and pass to export function
104+ eRel <- C.executeRelationalExpr conn relExpr
105+ case eRel of
106+ Left err -> barf err
107+ Right rel -> do
108+ exportResult <- evalRelVarDataExportOperator execOp rel
109+ case exportResult of
110+ Just err -> barf err
111+ Nothing -> pure QuietSuccessResult
110112 where
111113 barf err = return $ DisplayErrorResult (T.pack (show err))
112114
TutorialD/Interpreter/Export/Base.hs+3−3
@@ -2,8 +2,8 @@ module TutorialD.Interpreter.Export.Base where
22import ProjectM36.Base
33import ProjectM36.Error
44
5−data RelVarDataExportOperator = RelVarDataExportOperator (RelationalExpr -> FilePath -> IO (Maybe RelationalError)) FilePath
5+data RelVarDataExportOperator = RelVarDataExportOperator RelationalExpr FilePath (RelVarDataExportOperator -> Relation -> IO (Maybe RelationalError))
66
7−evalDataExportOperator :: DataExportOperator -> DatabaseContext -> IO (Maybe RelationalError)
8−evalDataExportOperator (DataExportOperator exportFunc pathOut) context = exportFunc context pathOut
7+evalRelVarDataExportOperator :: RelVarDataExportOperator -> Relation -> IO (Maybe RelationalError)
8+evalRelVarDataExportOperator op@(RelVarDataExportOperator _ _ exportFunc) rel = exportFunc op rel
99
TutorialD/Interpreter/Export/CSV.hs+10−16
@@ -4,31 +4,25 @@ import TutorialD.Interpreter.Export.Base
44import TutorialD.Interpreter.RelationalExpr
55import TutorialD.Interpreter.Base
66import ProjectM36.Base
7−import ProjectM36.RelationalExpression
87import ProjectM36.Error
9−import Control.Monad.State (evalState)
108import Text.Parsec.String
119import qualified Data.ByteString.Lazy as BS
1210import Control.Exception (try)
1311import qualified Data.Text as T
1412
15−exportCSVP :: Parser DataExportOperator
13+exportCSVP :: Parser RelVarDataExportOperator
1614exportCSVP = do
1715 reserved ":exportcsv"
1816 exportExpr <- relExprP
1917 path <- quotedString
20− return $ DataExportOperator (exportRelationCSV exportExpr) path
18+ return $ RelVarDataExportOperator exportExpr path exportRelationCSV
2119
22−exportRelationCSV :: RelationalExpr -> DatabaseContext -> FilePath -> IO (Maybe RelationalError)
23−exportRelationCSV relExpr context pathOut = do
24− let exportRel = evalState (evalRelationalExpr relExpr) context
25− case exportRel of
20+exportRelationCSV :: RelVarDataExportOperator -> Relation -> IO (Maybe RelationalError)
21+exportRelationCSV (RelVarDataExportOperator _ pathOut _) rel = do
22+ case relationAsCSV rel of
2623 Left err -> return $ Just err
27− Right exportRel' -> do
28− case relationAsCSV exportRel' of
29− Left err -> return $ Just err
30− Right csvData -> do
31− writeResult <- try (BS.writeFile pathOut csvData) :: IO (Either IOError ())
32− case writeResult of
33− Left err -> return $ Just (ExportError $ T.pack (show err))
34− Right _ -> return Nothing
24+ Right csvData -> do
25+ writeResult <- try (BS.writeFile pathOut csvData) :: IO (Either IOError ())
26+ case writeResult of
27+ Left err -> return $ Just (ExportError $ T.pack (show err))
28+ Right _ -> return Nothing
project-m36.cabal+1−1
@@ -197,7 +197,7 @@ Test-Suite test-tutoriald
197197 Default-Language: Haskell2010
198198 type: exitcode-stdio-1.0
199199 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
201201 GHC-Options: -Wall
202202 C-sources: ProjectM36/DirectoryFsync.c
203203
test/TutorialD/Interpreter.hs+22−2
@@ -9,6 +9,7 @@ import ProjectM36.Tuple
99import ProjectM36.TupleSet
1010import ProjectM36.Error
1111import ProjectM36.Base
12+import qualified ProjectM36.Base as Base
1213import ProjectM36.TransactionGraph
1314import ProjectM36.Client
1415import ProjectM36.Atom
@@ -24,6 +25,7 @@ import Data.Text (Text)
2425import Data.Time.Clock (UTCTime(..))
2526import Data.Time.Calendar (fromGregorian)
2627import Data.Interval (interval, Interval, Extended(Finite))
28+import Control.Concurrent.STM
2729
2830main :: IO ()
2931main = do
@@ -131,7 +133,7 @@ transactionGraphBasicTest = TestCase $ do
131133transactionGraphAddCommitTest :: Test
132134transactionGraphAddCommitTest = TestCase $ do
133135 dbconn <- dateExamplesConnection
134− case parseTutorialD dbconn "x:=S" of
136+ case parseTutorialD "x:=S" of
135137 Left err -> assertFailure (show err)
136138 Right parsed -> do
137139 result <- evalTutorialD dbconn parsed
@@ -218,17 +220,35 @@ simpleJoinTest = TestCase $ assertTutdEqual dateExamples joinedRel "x:=S join SP
218220 [stringAtom "London", intAtom 200, stringAtom "P4", stringAtom "S1", stringAtom "Smith", intAtom 20],
219221 [stringAtom "London", intAtom 200, stringAtom "P2", stringAtom "S4", stringAtom "Clark", intAtom 20]
220222 ]
223+transactionGraph :: Connection -> IO TransactionGraph
224+transactionGraph (InProcessConnection _ tvar) = atomically $ do
225+ (_, graph) <- readTVar tvar
226+ pure graph
227+transactionGraph _ = error "remote connection used"
221228
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+
222241dateExamplesConnection :: IO (Connection)
223242dateExamplesConnection = do
224243 dbconn <- connectProjectM36 (InProcessConnectionInfo NoPersistence)
244+ let incDeps = Base.inclusionDependencies dateExamples
225245 case dbconn of
226246 Left err -> do
227247 hPutStrLn stderr (show err)
228248 exitFailure
229249 Right conn -> do
230250 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)
232252 --skipping atom functions for now- there are no atom function manipulation operators yet
233253 commit conn >>= maybeFail
234254 return conn