git.iko.soy/project-m36
on master help sign in
Merge branch 'websocket-server'

Conflicts: TutorialD/Interpreter/Base.hs

commit7ccb7de396eb60d7ab5087de6774f1f859679367 authorAgentM <agentm@themactionfaction.com> dateSat 6 Aug 2016, 10:16 (10 years ago) parent12d5296b9658fe
26 files changed+1032−59
compare with master
unifiedsplit
ProjectM36/Atom.hs+9 ProjectM36/Client.hs+1−1 ProjectM36/Client/Json.hs+14 ProjectM36/ConcreteTypeRep.hs+4−3 ProjectM36/DataTypes/Day.hs+4 ProjectM36/DatabaseContext.hs+1−1 ProjectM36/Error.hs+1−1 ProjectM36/Server/RemoteCallTypes/Json.hs+159 ProjectM36/Server/WebSocket.hs+73 ProjectM36/Server/WebSocket/Main.hs+19 ProjectM36/Server/WebSocket/project-m36.js+202 ProjectM36/Server/WebSocket/websocket-client.html+118 ProjectM36/Server/WebSocket/websocket-client.js+157 README.markdown+1 TutorialD/Interpreter.hs+65−34 TutorialD/Interpreter/Base.hs+6 TutorialD/Interpreter/Import/BasicExamples.hs+22 TutorialD/Interpreter/RODatabaseContextOperator.hs+2−4 docs/15_minute_tutorial.markdown+9−1 docs/reaching_out_of_the_tarpit.markdown+2−2 docs/tutd_tutorial.markdown+1−1 docs/websocket_server.markdown+23 project-m36.cabal+46−9 stack.yaml+1 test/Server/WebSocket.hs+88 test/TutorialD/Interpreter.hs+4−2
ProjectM36/Atom.hs+9
@@ -42,6 +42,15 @@ textAtom t = Atom t
4242intAtom :: Int -> Atom
4343intAtom i = Atom i
4444
45+doubleAtom :: Double -> Atom
46+doubleAtom d = Atom d
47+
48+byteStringAtom :: ByteString -> Atom
49+byteStringAtom b = Atom b
50+
51+boolAtom :: Bool -> Atom
52+boolAtom b = Atom b
53+
4554--not safe to use without upfront type-checking
4655castRelation :: Atom -> Relation
4756castRelation (ConstructedAtom _ _ _) = error "castRelation attempt on ConstructedAtom"
ProjectM36/Client.hs+1−1
@@ -145,7 +145,7 @@ data ConnectionError = SetupDatabaseDirectoryError PersistenceError |
145145 IOExceptionError IOException |
146146 NoSuchDatabaseByNameError DatabaseName |
147147 LoginError
148− deriving (Show, Eq)
148+ deriving (Show, Eq, Generic)
149149
150150remoteDBLookupName :: DatabaseName -> String
151151remoteDBLookupName = (++) "db-"
ProjectM36/Client/Json.hsnew file+14
@@ -0,0 +1,14 @@
1+{-# OPTIONS_GHC -fno-warn-orphans #-}
2+module ProjectM36.Client.Json where
3+import Data.Aeson
4+import ProjectM36.Server.RemoteCallTypes.Json ()
5+import ProjectM36.Client
6+import Control.Exception (IOException)
7+
8+instance ToJSON EvaluatedNotification
9+instance FromJSON EvaluatedNotification
10+
11+instance ToJSON ConnectionError
12+
13+instance ToJSON IOException where
14+ toJSON err = object ["IOException" .= show err]
ProjectM36/ConcreteTypeRep.hs+4−3
@@ -1,14 +1,15 @@
1−{-# LANGUAGE GeneralizedNewtypeDeriving #-}
1+{-# LANGUAGE GeneralizedNewtypeDeriving, DeriveGeneric #-}
22-- adapted from https://hackage.haskell.org/package/concrete-typerep
33module ProjectM36.ConcreteTypeRep where
44import Data.Binary
55import Data.Typeable
66import Data.Typeable.Internal
77import Control.DeepSeq (NFData)
8+import GHC.Generics
89
910newtype ConcreteTypeRep = CTR { unCTR :: TypeRep } deriving (Eq, Typeable, NFData)
1011
11−newtype SerialRep = SR (TyConRep, [SerialRep]) deriving (Binary)
12+newtype SerialRep = SR (TyConRep, [SerialRep]) deriving (Binary, Generic)
1213
1314instance Show ConcreteTypeRep where
1415 show (CTR tRep) = show tRep
@@ -17,8 +18,8 @@ type TyConRep = (String, String, String)
1718toTyConRep :: TyCon -> TyConRep
1819toTyConRep (TyCon _ pack modul name) = (pack, modul, name)
1920
20−fromTyConRep (pack, modul, name) = mkTyCon3 pack modul name
2121fromTyConRep :: TyConRep -> TyCon
22+fromTyConRep (pack, modul, name) = mkTyCon3 pack modul name
2223
2324toSerial :: ConcreteTypeRep -> SerialRep
2425toSerial (CTR t) = case splitTyConApp t of
ProjectM36/DataTypes/Day.hs+4
@@ -6,6 +6,10 @@ import qualified Data.HashSet as HS
66import Data.Time.Calendar
77import qualified Data.Map as M
88
9+
10+dayAtom :: Day -> Atom
11+dayAtom d = Atom d
12+
913dayAtomType :: AtomType
1014dayAtomType = ConstructedAtomType "Day" M.empty
1115
ProjectM36/DatabaseContext.hs+1−1
@@ -15,7 +15,7 @@ empty = DatabaseContext { inclusionDependencies = M.empty,
1515
1616-- | convert an existing database context into its constituent expression.
1717databaseContextAsDatabaseContextExpr :: DatabaseContext -> DatabaseContextExpr
18−databaseContextAsDatabaseContextExpr context = MultipleExpr $ incDepsExprs ++ relVarsExprs ++ funcsExprs
18+databaseContextAsDatabaseContextExpr context = MultipleExpr $ relVarsExprs ++ incDepsExprs ++ funcsExprs
1919 where
2020 relVarsExprs = map (\(name, rel) -> Assign name (ExistingRelation rel)) (M.toList (relationVariables context))
2121 incDepsExprs :: [DatabaseContextExpr]
ProjectM36/Error.hs+1−1
@@ -74,7 +74,7 @@ instance NFData RelationalError where rnf = genericRnf
7474
7575data PersistenceError = InvalidDirectoryError FilePath |
7676 MissingTransactionError TransactionId
77− deriving (Show, Eq)
77+ deriving (Show, Eq, Generic)
7878
7979--collapse list of errors into normal error- if there is just one, just return one
8080someErrors :: [RelationalError] -> RelationalError
ProjectM36/Server/RemoteCallTypes/Json.hsnew file+159
@@ -0,0 +1,159 @@
1+--create a bunch of orphan instances for use with the websocket server
2+{-# OPTIONS_GHC -fno-warn-orphans #-}
3+module ProjectM36.Server.RemoteCallTypes.Json where
4+import ProjectM36.Server.RemoteCallTypes
5+import ProjectM36.Base
6+import ProjectM36.ConcreteTypeRep
7+import ProjectM36.Error
8+
9+import Data.Aeson
10+import Data.UUID.Aeson ()
11+import Data.Proxy
12+import Data.Typeable
13+import Data.Text
14+import Data.Time.Calendar
15+import ProjectM36.Atom
16+import ProjectM36.DataTypes.Primitive
17+import ProjectM36.AtomFunctions.Primitive
18+import ProjectM36.DataTypes.Day
19+import Data.ByteString
20+
21+instance ToJSON RelationalExpr
22+instance FromJSON RelationalExpr
23+
24+instance ToJSON TupleExpr
25+instance FromJSON TupleExpr
26+
27+instance ToJSON RestrictionPredicateExpr
28+instance FromJSON RestrictionPredicateExpr
29+
30+instance ToJSON AtomExpr
31+instance FromJSON AtomExpr
32+
33+instance ToJSON RelationTupleSet
34+instance FromJSON RelationTupleSet
35+
36+instance ToJSON RelationTuple
37+instance FromJSON RelationTuple
38+
39+instance ToJSON ExecuteRelationalExpr
40+instance FromJSON ExecuteRelationalExpr
41+
42+instance ToJSON Relation
43+instance FromJSON Relation
44+
45+instance ToJSON Attribute
46+instance FromJSON Attribute
47+
48+instance ToJSON ExtendTupleExpr
49+instance FromJSON ExtendTupleExpr
50+
51+instance ToJSON AttributeNames
52+instance FromJSON AttributeNames
53+
54+instance ToJSON AttributeExpr
55+instance FromJSON AttributeExpr
56+
57+instance ToJSON AtomType
58+instance FromJSON AtomType
59+
60+instance ToJSON TypeConstructor
61+instance FromJSON TypeConstructor
62+
63+instance ToJSON TypeConstructorArg
64+instance FromJSON TypeConstructorArg
65+
66+instance ToJSON SerialRep
67+instance FromJSON SerialRep
68+
69+instance FromJSON ConcreteTypeRep where
70+ parseJSON = withObject "ctr" $ \o -> do
71+ serialRep <- o .: "serialrep"
72+ pure $ fromSerial serialRep
73+
74+instance ToJSON ConcreteTypeRep where
75+ toJSON ctr = object [
76+ "serialrep" .= toSerial ctr
77+ ]
78+
79+instance ToJSON Atom where
80+ toJSON atom@(Atom _) = let atype = atomTypeForAtom atom
81+ in
82+ if atype == intAtomType then
83+ object [
84+ "type" .= atype,
85+ "val" .= ((unsafeCast atom) :: Int)]
86+ else if atype == textAtomType then
87+ object [
88+ "type" .= atype,
89+ "val" .= ((unsafeCast atom) :: Text)]
90+ else if atype == doubleAtomType then
91+ object [
92+ "type" .= atype,
93+ "val" .= ((unsafeCast atom) :: Double)]
94+ else if atype == dayAtomType then
95+ object [
96+ "type" .= atype,
97+ "val" .= ((unsafeCast atom) :: Day)]
98+ else if atype == byteStringAtomType then
99+ object [
100+ "type" .= atype,
101+ "val" .= toText ((unsafeCast atom) :: ByteString)]
102+ else if atype == boolAtomType then
103+ object [
104+ "type" .= atype,
105+ "val" .= ((unsafeCast atom) :: Bool)]
106+ else if isRelationAtomType atype then
107+ object [
108+ "type" .= atype,
109+ "val" .= castRelation atom ]
110+ else error "invalid primitive in ToJSON implementation"
111+
112+ toJSON (ConstructedAtom dConsName atomtype atomlist) = object [
113+ "dataconstructorname" .= dConsName,
114+ "type" .= toJSON atomtype,
115+ "atomlist" .= toJSON atomlist
116+ ]
117+
118+instance FromJSON Atom where
119+ parseJSON = withObject "atom" $ \o -> do
120+ atype <- o .: "type"
121+ case atype of
122+ AnyAtomType -> fail "cannot pass AnyAtomType over the wire"
123+ caType@(ConstructedAtomType _ _) -> ConstructedAtom <$> o .: "dataconstructorname" <*> pure caType <*> o .: "atom"
124+ RelationAtomType _ -> do
125+ rel <- o .: "val"
126+ pure $ Atom (rel :: Relation)
127+ AtomType cTypeRep -> if unCTR cTypeRep == typeRep (Proxy :: Proxy Int) then
128+ intAtom <$> o .: "val"
129+ else if unCTR cTypeRep == typeRep (Proxy :: Proxy Text) then
130+ textAtom <$> o .: "val"
131+ else if unCTR cTypeRep == typeRep (Proxy :: Proxy Double) then
132+ doubleAtom <$> o .: "val"
133+ else if unCTR cTypeRep == typeRep (Proxy :: Proxy Day) then
134+ dayAtom <$> o .: "val"
135+ else if unCTR cTypeRep == typeRep (Proxy :: Proxy ByteString) then do
136+ txt <- (o .: "val")
137+ case (fromText txt) :: Either String ByteString of
138+ Left err -> fail $ "bytestring parse failure: " ++ show err
139+ Right bs -> pure $ byteStringAtom bs
140+ else if unCTR cTypeRep == typeRep (Proxy :: Proxy Bool) then
141+ boolAtom <$> o .: "val"
142+ else
143+ error "unsupported typerep serialization"
144+
145+
146+instance ToJSON Notification
147+instance FromJSON Notification
148+
149+instance ToJSON RelationalError
150+instance FromJSON RelationalError
151+
152+instance ToJSON MergeError
153+instance FromJSON MergeError
154+
155+instance ToJSON MergeStrategy
156+instance FromJSON MergeStrategy
157+
158+instance ToJSON PersistenceError
159+
ProjectM36/Server/WebSocket.hsnew file+73
@@ -0,0 +1,73 @@
1+module ProjectM36.Server.WebSocket where
2+-- while the tutd client performs TutorialD parsing on the client, the websocket server will pass tutd to be parsed and executed on the server- otherwise I have to pull in ghcjs as a dependency to allow client-side parsing- that's not appealing because then the frontend is not language-agnostic, but this could change in the future, perhaps by sending different messages over the websocket
3+-- ideally, the wire protocol should not be exposed to a straight string-based API ala SQL, so we could make perhaps a javascript DSL which compiles to the necessary JSON- anaylyze tradeoffs
4+
5+-- launch the project-m36-server
6+-- proxy all connections to it through ProjectM36.Client
7+import Control.Monad (forever)
8+import qualified Data.Text as T
9+import qualified Network.WebSockets as WS
10+import ProjectM36.Server.RemoteCallTypes.Json ()
11+import ProjectM36.Client.Json ()
12+import Data.Aeson
13+import TutorialD.Interpreter
14+import TutorialD.Interpreter.Base
15+import ProjectM36.Client
16+import Control.Exception
17+
18+-- | Called when the project-m36-server exits.
19+failureHandler :: Either SomeException Bool -> IO ()
20+failureHandler = error "project-m36-server exited unexpectedly"
21+
22+websocketProxyServer :: Port -> Hostname -> WS.ServerApp
23+websocketProxyServer port host pending = do
24+ conn <- WS.acceptRequest pending
25+ let unexpectedMsg = WS.sendTextData conn ("messagenotexpected" :: T.Text)
26+ --phase 1- accept database name for connection
27+ dbmsg <- (WS.receiveData conn) :: IO T.Text
28+ let connectdbmsg = "connectdb:"
29+ if not (connectdbmsg `T.isPrefixOf` dbmsg) then unexpectedMsg >> WS.sendClose conn ("" :: T.Text)
30+ else do
31+ let dbname = T.unpack $ T.drop (T.length connectdbmsg) dbmsg
32+ eDbconn <- createConnection conn dbname port host
33+ case eDbconn of
34+ Left err -> sendError conn err
35+ Right dbconn -> do
36+ eSessionId <- createSessionAtHead "master" dbconn
37+ case eSessionId of
38+ Left err -> sendError conn err
39+ Right sessionId -> do
40+ --phase 2- accept tutoriald commands
41+ _ <- forever $ do
42+ msg <- (WS.receiveData conn) :: IO T.Text
43+ let tutdprefix = "executetutd:"
44+ case msg of
45+ _ | tutdprefix `T.isPrefixOf` msg -> do
46+ let tutdString = T.drop (T.length tutdprefix) msg
47+ case parseTutorialD (T.unpack tutdString) of
48+ Left err -> handleOpResult conn dbconn (DisplayErrorResult ("parse error: " `T.append` T.pack (show err)))
49+ Right parsed -> do
50+ result <- evalTutorialD sessionId dbconn SafeEvaluation parsed
51+ handleOpResult conn dbconn result
52+ _ -> unexpectedMsg
53+ pure ()
54+
55+notificationCallback :: WS.Connection -> NotificationCallback
56+notificationCallback conn notifName evaldNotif = WS.sendTextData conn (encode (object ["notificationname" .= notifName,
57+ "evaldnotification" .= evaldNotif
58+ ]))
59+
60+--this creates a new database for each connection- perhaps not what we want (?)
61+createConnection :: WS.Connection -> DatabaseName -> Port -> Hostname -> IO (Either ConnectionError Connection)
62+createConnection wsconn dbname port host = connectProjectM36 (RemoteProcessConnectionInfo dbname (createNodeId host port) (notificationCallback wsconn))
63+
64+sendError :: (ToJSON a) => WS.Connection -> a -> IO ()
65+sendError conn err = WS.sendTextData conn (encode (object ["displayerror" .= err]))
66+
67+handleOpResult :: WS.Connection -> Connection -> TutorialDOperatorResult -> IO ()
68+handleOpResult conn db QuitResult = WS.sendClose conn ("close" :: T.Text) >> close db
69+handleOpResult conn _ (DisplayResult out) = WS.sendTextData conn (encode (object ["display" .= out]))
70+handleOpResult _ _ (DisplayIOResult ioout) = ioout
71+handleOpResult conn _ (DisplayErrorResult err) = WS.sendTextData conn (encode (object ["displayerror" .= err]))
72+handleOpResult conn _ QuietSuccessResult = WS.sendTextData conn (encode (object ["acknowledged" .= True]))
73+handleOpResult conn _ (DisplayRelationResult rel) = WS.sendTextData conn (encode (object ["displayrelation" .= rel]))
ProjectM36/Server/WebSocket/Main.hsnew file+19
@@ -0,0 +1,19 @@
1+import ProjectM36.Server.WebSocket
2+import ProjectM36.Server.Config
3+import ProjectM36.Server.ParseArgs
4+import ProjectM36.Server
5+import Control.Concurrent
6+import qualified Network.WebSockets as WS
7+
8+main :: IO ()
9+main = do
10+ -- launch normal project-m36-server
11+ portMVar <- newEmptyMVar
12+ serverConfig <- parseConfig
13+ let serverHost = bindHost serverConfig
14+ _ <- forkFinally (launchServer serverConfig (Just portMVar)) failureHandler
15+ --wait for server to be listening
16+ serverPort <- takeMVar portMVar
17+ --this built-in server is apparently not meant for production use, but it's easier to test than starting up the wai or snap interfaces
18+ WS.runServer "0.0.0.0" 8888 (websocketProxyServer serverPort serverHost)
19+
ProjectM36/Server/WebSocket/project-m36.jsnew file+202
@@ -0,0 +1,202 @@
1+var ProjectM36Connection = function (host, port, dbname, openCallback, errorCallback, statusCallback, closeCallback) {
2+ this.host = host
3+ this.port = port
4+ this.dbname = dbname
5+ var connectURL = "ws://" + host + ":" + port + "/";
6+ var socket = new WebSocket("ws://localhost:8888/");
7+ var self = this;
8+ socket.onopen = function(event) {
9+ self.socket.send("connectdb:" + self.dbname);
10+ openCallback(event);
11+ };
12+ socket.onerror = function(event) {
13+ errorCallback(event);
14+ };
15+ var self = this;
16+ socket.onmessage = function(event) {
17+ var msg = JSON.parse(event.data);
18+ self.handleResponse(msg);
19+ };
20+ socket.onclose = function(event) {
21+ closeCallback(event);
22+ };
23+ this.statuscallback = statusCallback;
24+ this.socket = socket;
25+}
26+
27+var ProjectM36Status = function (relationResult, acknowledgementResult, errorResult)
28+{
29+ this.relation = relationResult;
30+ this.acknowledgement = acknowledgementResult;
31+ this.error = errorResult;
32+}
33+
34+ProjectM36Connection.prototype.close = function()
35+{
36+ this.socket.close();
37+}
38+
39+ProjectM36Connection.prototype.readyState = function()
40+{
41+ return this.socket.readyState;
42+}
43+
44+ProjectM36Connection.prototype.handleResponse = function(message)
45+{
46+ var relation = message["displayrelation"];
47+ var acknowledged = message["acknowledged"];
48+ var error = message["displayerror"];
49+ if(relation)
50+ {
51+ this.statuscallback(new ProjectM36Status(relation, null, null));
52+ }
53+
54+ if(acknowledged)
55+ {
56+ this.statuscallback(new ProjectM36Status(null, true, null));
57+ }
58+
59+ if(error)
60+ {
61+ if(error.tag)
62+ {
63+ error=error.tag; // for error objects
64+ }
65+ this.statuscallback(new ProjectM36Status(null, null, error));
66+ }
67+}
68+
69+ProjectM36Connection.prototype.executeTutorialD = function(tutd)
70+{
71+ this.socket.send("executetutd:" + tutd);
72+}
73+
74+ProjectM36Connection.prototype.generateRelation = function(relation)
75+{
76+ var table = document.createElement("table");
77+
78+ var headers = this.generateRelationHeader(relation[0]);
79+ var body = this.generateRelationBody(relation[1]);
80+
81+ table.appendChild(headers);
82+ table.appendChild(body);
83+
84+ return table;
85+}
86+
87+ProjectM36Connection.prototype.generateRelationHeader = function(header)
88+{
89+ var thead = document.createElement("thead");
90+ var headerrow = document.createElement("tr");
91+ for(var hindex=0; hindex < header.length; hindex++)
92+ {
93+ var th = document.createElement("th");
94+ var attrtype = this.generateAtomType(header[hindex]);
95+ th.appendChild(attrtype);
96+ headerrow.appendChild(th);
97+ }
98+ //special case- if there are no attributes (the "true" and "false" relations, then leave a class marker so that the table can be styled to appear regardless
99+ if(header.length == 0)
100+ {
101+ headerrow.setAttribute("class", "emptyrow");
102+ }
103+ thead.appendChild(headerrow);
104+ return thead;
105+}
106+
107+ProjectM36Connection.prototype.generateAtomType = function(attr)
108+{
109+ var atomType = attr[1]["tag"];
110+ var attrName = attr[0];
111+ var element = document.createElement("span");
112+ element.textContent = attrName + "::";
113+ if(atomType == "AtomType")
114+ {
115+ element.textContent += attr[1]["contents"]["serialrep"][0][2];
116+ }
117+ else if (atomType == "RelationAtomType")
118+ {
119+ var table = document.createElement("table");
120+ element.appendChild(table);
121+ var thead = document.createElement("thead");
122+ table.appendChild(thead);
123+ var tr = document.createElement("tr");
124+ thead.appendChild(tr);
125+ var relattrs = attr[1]["contents"];
126+ for(var attrindex = 0; attrindex < relattrs.length; attrindex++)
127+ {
128+ var th = document.createElement("th");
129+ var relattrNode = this.generateAtomType(relattrs[attrindex]);
130+ th.appendChild(relattrNode);
131+ tr.appendChild(th);
132+ }
133+ }
134+ else
135+ {
136+ element.textContent = "unknown";
137+ }
138+ return element
139+}
140+
141+ProjectM36Connection.prototype.generateRelationBody = function (body)
142+{
143+ var bodyrows = body["asList"]
144+ var tbody = document.createElement("tbody");
145+ for(var rindex=0; rindex < bodyrows.length; rindex++)
146+ {
147+ var tablerow = document.createElement("tr");
148+ var bodyrow = bodyrows[rindex];
149+ for(var atomindex=0; atomindex < bodyrow[1].length; atomindex++)
150+ {
151+ var td = document.createElement("td");
152+ var atomNode = this.generateAtom(bodyrow[1][atomindex]);
153+ td.appendChild(atomNode);
154+ tablerow.appendChild(td);
155+ }
156+ //special case- mark row with class attribute if it contains no columns
157+ if(bodyrow[1].length == 0)
158+ {
159+ tablerow.setAttribute("class", "emptyrow");
160+ }
161+ tbody.appendChild(tablerow);
162+ }
163+ return tbody;
164+}
165+
166+ProjectM36Connection.prototype.generateAtom = function(atom)
167+{
168+ var element = document.createElement("span");
169+ var atomType = atom["type"]["tag"];
170+
171+ if(atomType == "RelationAtomType")
172+ {
173+ var rel = this.generateRelation(atom["val"]);
174+ element.appendChild(rel);
175+ }
176+ else
177+ {
178+ element.textContent = atom["val"];
179+ }
180+ return element;
181+}
182+
183+//special case to make sure that a table appears for "true" and "false"
184+function mungeEmptyRows()
185+{
186+ var empties = document.getElementsByClassName("emptyrow");
187+ for(var index=0; index < empties.length; index++)
188+ {
189+ var empty = empties[index];
190+ if(empty.childNodes.length == 0)
191+ {
192+ var elementType = "td";
193+ if(empty.parentNode.nodeName == "THEAD")
194+ {
195+ elementType = "th";
196+ }
197+ var dudHeader = document.createElement(elementType);
198+ dudHeader.innerHTML = "&nbsp;";
199+ empty.appendChild(dudHeader);
200+ }
201+ }
202+}
ProjectM36/Server/WebSocket/websocket-client.htmlnew file+118
@@ -0,0 +1,118 @@
1+<html>
2+<head>
3+<!-- add examples drop down menu -->
4+<meta http-equiv="Content-Type" content="text/html; charset=UTF-8" />
5+<title>Project:M36 WebSocket Client</title>
6+<script type="text/javascript" src="project-m36.js"></script>
7+<script type="text/javascript" src="websocket-client.js"></script>
8+<style>
9+#sectiontemplate
10+{
11+ display: none;
12+}
13+
14+.deletesection
15+{
16+ float:right;
17+ border: 1px solid;
18+ padding: 3px;
19+ border-radius: 3px;
20+ background: #ff8b8b;
21+}
22+
23+hr
24+{
25+border: 0;
26+height: 1px;
27+background-image: linear-gradient(to right, rgba(0, 0, 0, 0), rgba(0, 0, 0, 0.75), rgba(0, 0, 0, 0));
28+}
29+
30+.title
31+{
32+padding: 3pt;
33+border: 1px solid;
34+border-radius: 3px;
35+background-image: linear-gradient(to top, rgba(0, 0, 0, 0), rgba(0, 0, 0, 0.1), rgba(0, 0, 0, 0));
36+margin: 3px;
37+}
38+
39+.result table
40+{
41+ border-collapse: collapse;
42+ display: inline-block;
43+ vertical-align: middle;
44+}
45+
46+.result td, .result th
47+{
48+ border: 1px solid black;
49+ padding: 2px;
50+}
51+
52+.result th
53+{
54+ background-image: linear-gradient(to top, rgba(0, 0, 0, 0), rgba(0, 0, 0, 0.1), rgba(0, 0, 0, 0));
55+}
56+
57+#connection input
58+{
59+ width: 100px;
60+}
61+
62+#samples
63+{
64+ display:none;
65+}
66+
67+#samplesouter
68+{
69+ border: 1px solid;
70+ display: inline-block;
71+ padding-left: 10px;
72+ padding-right: 10px;
73+}
74+
75+#samples li:hover
76+{
77+ background-color: #d1d1e0;
78+}
79+
80+</style>
81+</head>
82+<body onload="installSampleHandlers();">
83+<h1>Project:M36 WebSocket Client</h1>
84+<div id="sheet">
85+ <div id="interactor">
86+ <form onsubmit="return connectOrDisconnect(this);" id="connection">
87+ <label>Connection:</label><input type="text" name="host" value="localhost" placeholder="Host"/>:<input type="number" placeholder="Port" name="port" min="0" max="32767" value="8888"/>/<input type="text" placeholder="Database Name" name="dbname" value="test"/><input type="submit" name="connect" value="Connect"/>
88+ </form>
89+ <div onmouseover="toggleSamples(this, true);" onmouseleave="toggleSamples(this, false);" id="samplesouter">
90+ <span>Sample TutorialD: <a href="https://github.com/agentm/project-m36/blob/master/docs/15_minute_tutorial.markdown">15 minute TutorialD Tutorial</a>.</span>
91+</span>
92+ <ul id="samples">
93+ <li>:showexpr true</li>
94+ <li>:showexpr false</li>
95+ <li>:importexample date</li>
96+ <li>:showexpr s join sp</li>
97+ <li>update s where city=&quot;Paris&quot; (status:=10)</li>
98+ <li>:showexpr s</li>
99+ <li>:commit</li>
100+ <li>:showgraph</li>
101+ </ul>
102+ </div>
103+ <form onsubmit="return execTutorialD();">
104+ <input type="text" id="tutd"/>
105+ <input type="submit"/>
106+ </form>
107+ </div>
108+ <div id="sectiontemplate">
109+ <span class="title"></span>
110+ <span class="deletesection" onclick="return hideParent(this);">X</span>
111+ <div style="clear: both;"></div>
112+ <div class="result">
113+ </div>
114+ <span class="relinfo"></span>
115+ <hr/>
116+ </div>
117+</body>
118+</html>
ProjectM36/Server/WebSocket/websocket-client.jsnew file+157
@@ -0,0 +1,157 @@
1+function appendResult(title, result)
2+{
3+ //prepend the page with an additional relation result
4+ var sheet = document.getElementById("sheet");
5+ var template = document.getElementById("sectiontemplate").cloneNode(true);
6+ template.removeAttribute("id");
7+ var titleSpan = document.createElement("span");
8+ titleSpan.textContent = title;
9+ template.getElementsByClassName("title")[0].appendChild(titleSpan);
10+ template.getElementsByClassName("result")[0].appendChild(result);
11+ if(result.nodeName == "TABLE") // show some relation statistics
12+ {
13+ var tupleCount = result.querySelectorAll(".result > table > tbody > tr").length
14+ var attrCount = result.querySelectorAll(".result > table > thead > tr > th").length
15+ var attrText = attrCount + " attribute" + (attrCount == 1 ? "" : "s")
16+ var tupleText = tupleCount + " tuple" + (tupleCount == 1 ? "" : "s")
17+ template.getElementsByClassName("relinfo")[0].textContent = attrText + ", " + tupleText;
18+ }
19+ var interactor = document.getElementById("interactor");
20+ sheet.insertBefore(template, interactor);
21+ window.scrollTo(0,document.body.scrollHeight);
22+}
23+
24+function updateStatus(status)
25+{
26+ var tutd = document.getElementById("tutd").value;
27+ if(status.relation)
28+ {
29+ var relastable = conn.generateRelation(status.relation);
30+ appendResult(tutd, relastable);
31+ mungeEmptyRows();
32+ }
33+ if(status.acknowledgement)
34+ {
35+ var ok = document.createElement("span");
36+ ok.textContent="OK";
37+ appendResult(tutd, ok);
38+ }
39+ if(status.error)
40+ {
41+ var error = document.createElement("span");
42+ error.textContent=status.error;
43+ appendResult(tutd, error);
44+ }
45+}
46+
47+var conn;
48+
49+function connectOrDisconnect(form)
50+{
51+ var formin = form.elements;
52+ var host = formin["host"].value;
53+ var port = formin["port"].value;
54+ var dbname = formin["dbname"].value;
55+
56+ if(window.conn && window.conn.readyState() == 1)
57+ {
58+ //disconnect
59+ window.conn.close();
60+ toggleConnectionFields(form, true, "Connect");
61+ }
62+ else
63+ {
64+ //connect
65+ window.conn = new ProjectM36Connection(host, port, dbname,
66+ connectionOpened,
67+ connectionError,
68+ updateStatus,
69+ connectionClosed);
70+ toggleConnectionFields(form, false, "Connecting...");
71+ }
72+ return false;
73+}
74+
75+function connectionError(event)
76+{
77+ var err = document.createElement("span");
78+ err.textContent = "Failed to connect to websocket server. Please check the connection parameters and try again.";
79+ appendResult("Connect", err);
80+ connectionClosed(event)
81+}
82+
83+function connectionClosed(event)
84+{
85+ toggleConnectionFields(document.getElementById("connection"), true, "Connect");
86+}
87+
88+function toggleConnectionFields(form, enabled, status)
89+{
90+ form.elements["connect"].value = status;
91+ var readonlyElements = [form.elements["host"], form.elements["port"], form.elements["dbname"]];
92+ for(var ein=0; ein < readonlyElements.length; ein++)
93+ {
94+ var e = readonlyElements[ein];
95+ if(enabled)
96+ {
97+ e.removeAttribute("readonly");
98+ }
99+ else
100+ {
101+ e.setAttribute("readonly", "readonly");
102+ }
103+ }
104+}
105+
106+function connectionOpened(event)
107+{
108+ toggleConnectionFields(document.getElementById("connection"), false, "Disconnect");
109+}
110+
111+function execTutorialD()
112+{
113+ var tutd = document.getElementById("tutd").value;
114+ if(!window.conn || window.conn.readyState() != 1)
115+ {
116+ var err = document.createElement("span");
117+ err.textContent = "Cannot execute command until a database connection is established.";
118+ appendResult(tutd, err);
119+ }
120+ else
121+ {
122+ conn.executeTutorialD(tutd);
123+ }
124+ return false;
125+}
126+
127+function hideParent(element)
128+{
129+ var deleteNode = element.parentNode;
130+ element.parentNode.parentNode.removeChild(deleteNode)
131+}
132+
133+function toggleSamples(element,show)
134+{
135+ var samples = document.getElementById("samples");
136+ if(show)
137+ {
138+ samples.style.display = "block";
139+ }
140+ else
141+ {
142+ samples.style.display = "none";
143+ }
144+}
145+
146+function installSampleHandlers()
147+{
148+ var samples = document.querySelectorAll("#samples li");
149+ for(var idx = 0; idx < samples.length; idx++)
150+ {
151+ var tutd = document.getElementById("tutd");
152+ var el = samples[idx];
153+ el.onclick = function(el) {
154+ tutd.value = el.target.textContent;
155+ }
156+ }
157+}
README.markdown+1
@@ -36,6 +36,7 @@ Project:M36 supports multiple frontends which target different audiences.
36361. [Using Notifications](docs/using_notifications.markdown)
37371. [Merge Transactions](docs/merge_transactions.markdown)
38381. [Reaching "Out of the Tarpit" with Project:M36](docs/reaching_out_of_the_tarpit.markdown)
39+1. [WebSocket Server](docs/websocket_server.markdown)
3940
4041## Development
4142
TutorialD/Interpreter.hs+65−34
@@ -8,6 +8,7 @@ import TutorialD.Interpreter.InformationOperator
88
99import TutorialD.Interpreter.Import.CSV
1010import TutorialD.Interpreter.Import.TutorialD
11+import TutorialD.Interpreter.Import.BasicExamples
1112import TutorialD.Interpreter.Import.Base
1213
1314import TutorialD.Interpreter.Export.CSV
@@ -40,17 +41,24 @@ data ParsedOperation = RODatabaseContextOp RODatabaseContextOperator |
4041 ROGraphOp ROTransactionGraphOperator |
4142 ImportRelVarOp RelVarDataImportOperator |
4243 ImportDBContextOp DatabaseContextDataImportOperator |
44+ ImportBasicExampleOp ImportBasicExampleOperator |
4345 RelVarExportOp RelVarDataExportOperator
4446
4547interpreterParserP :: Parser ParsedOperation
46−interpreterParserP = liftM RODatabaseContextOp (roDatabaseContextOperatorP <* eof) <|>
47− liftM InfoOp (infoOpP <* eof) <|>
48− liftM GraphOp (transactionGraphOpP <* eof) <|>
49− liftM ROGraphOp (roTransactionGraphOpP <* eof) <|>
50− liftM DatabaseContextExprOp (databaseExprOpP <* eof) <|>
48+interpreterParserP = safeInterpreterParserP <|>
5149 liftM ImportRelVarOp (importCSVP <* eof) <|>
5250 liftM ImportDBContextOp (tutdImportP <* eof) <|>
5351 liftM RelVarExportOp (exportCSVP <* eof)
52+
53+-- the safe interpreter never reads or writes the file system
54+safeInterpreterParserP :: Parser ParsedOperation
55+safeInterpreterParserP = liftM RODatabaseContextOp (roDatabaseContextOperatorP <* eof) <|>
56+ liftM InfoOp (infoOpP <* eof) <|>
57+ liftM GraphOp (transactionGraphOpP <* eof) <|>
58+ liftM ROGraphOp (roTransactionGraphOpP <* eof) <|>
59+ liftM DatabaseContextExprOp (databaseExprOpP <* eof) <|>
60+ liftM ImportBasicExampleOp (importBasicExampleOperatorP <* eof)
61+
5462
5563promptText :: Maybe HeadName -> StringType
5664promptText mHeadName = "TutorialD (" `T.append` transInfo `T.append` "): "
@@ -60,9 +68,15 @@ promptText mHeadName = "TutorialD (" `T.append` transInfo `T.append` "): "
6068parseTutorialD :: String -> Either ParseError ParsedOperation
6169parseTutorialD inputString = parse interpreterParserP "" inputString
6270
71+--only parse tutoriald which doesn't result in file I/O
72+safeParseTutorialD :: String -> Either ParseError ParsedOperation
73+safeParseTutorialD inputString = parse safeInterpreterParserP "" inputString
74+
75+data SafeEvaluationFlag = SafeEvaluation | UnsafeEvaluation deriving (Eq)
76+
6377--execute the operation and display result
64−evalTutorialD :: C.SessionId -> C.Connection -> ParsedOperation -> IO (TutorialDOperatorResult)
65−evalTutorialD sessionId conn expr = case expr of
78+evalTutorialD :: C.SessionId -> C.Connection -> SafeEvaluationFlag -> ParsedOperation -> IO (TutorialDOperatorResult)
79+evalTutorialD sessionId conn safe expr = case expr of
6680
6781 --this does not pass through the ProjectM36.Client library because the operations
6882 --are specific to the interpreter, though some operations may be of general use in the future
@@ -85,42 +99,59 @@ evalTutorialD sessionId conn expr = case expr of
8599 opResult <- evalROGraphOp sessionId conn execOp
86100 case opResult of
87101 Left err -> barf err
88− Right rel -> return $ DisplayResult $ showRelation rel
102+ Right rel -> pure (DisplayRelationResult rel)
89103
90104 (ImportRelVarOp execOp@(RelVarDataImportOperator relVarName _ _)) -> do
91− -- collect attributes from relvar name
92− -- is there a race condition here? The attributes of the relvar may have since changed, no?
93− eImportType <- C.typeForRelationalExpr sessionId conn (RelationVariable relVarName)
94− case eImportType of
95− Left err -> barf err
96− Right importType -> do
97− exprErr <- evalRelVarDataImportOperator execOp (attributes importType)
98− case exprErr of
99− Left err -> barf err
100− Right dbexpr -> evalTutorialD sessionId conn (DatabaseContextExprOp dbexpr)
105+ if needsSafe then
106+ unsafeError
107+ else do
108+ -- collect attributes from relvar name
109+ -- is there a race condition here? The attributes of the relvar may have since changed, no?
110+ eImportType <- C.typeForRelationalExpr sessionId conn (RelationVariable relVarName)
111+ case eImportType of
112+ Left err -> barf err
113+ Right importType -> do
114+ exprErr <- evalRelVarDataImportOperator execOp (attributes importType)
115+ case exprErr of
116+ Left err -> barf err
117+ Right dbexpr -> evalTutorialD sessionId conn safe (DatabaseContextExprOp dbexpr)
101118
102119 (ImportDBContextOp execOp) -> do
103− mDbexprs <- evalDatabaseContextDataImportOperator execOp
104− case mDbexprs of
105− Left err -> barf err
106− Right dbexprs -> evalTutorialD sessionId conn (DatabaseContextExprOp dbexprs)
120+ if needsSafe then
121+ unsafeError
122+ else do
123+ mDbexprs <- evalDatabaseContextDataImportOperator execOp
124+ case mDbexprs of
125+ Left err -> barf err
126+ Right dbexprs -> evalTutorialD sessionId conn safe (DatabaseContextExprOp dbexprs)
107127
108128 (InfoOp execOp) -> do
109− case evalInformationOperator execOp of
110− Left err -> barf err
111− Right info -> pure (DisplayResult info)
129+ if needsSafe then
130+ unsafeError
131+ else
132+ case evalInformationOperator execOp of
133+ Left err -> barf err
134+ Right info -> pure (DisplayResult info)
112135
113136 (RelVarExportOp execOp@(RelVarDataExportOperator relExpr _ _)) -> do
114137 --eval relexpr to relation and pass to export function
115− eRel <- C.executeRelationalExpr sessionId conn relExpr
116− case eRel of
117− Left err -> barf err
118− Right rel -> do
119− exportResult <- evalRelVarDataExportOperator execOp rel
120− case exportResult of
121− Just err -> barf err
122− Nothing -> pure QuietSuccessResult
138+ if needsSafe then
139+ unsafeError
140+ else do
141+ eRel <- C.executeRelationalExpr sessionId conn relExpr
142+ case eRel of
143+ Left err -> barf err
144+ Right rel -> do
145+ exportResult <- evalRelVarDataExportOperator execOp rel
146+ case exportResult of
147+ Just err -> barf err
148+ Nothing -> pure QuietSuccessResult
149+ (ImportBasicExampleOp execOp) -> do
150+ let dbcontextexpr = evalImportBasicExampleOperator execOp
151+ evalTutorialD sessionId conn safe (DatabaseContextExprOp dbcontextexpr)
123152 where
153+ needsSafe = safe == SafeEvaluation
154+ unsafeError = pure $ DisplayErrorResult "File I/O operation prohibited."
124155 barf err = return $ DisplayErrorResult (T.pack (show err))
125156
126157data InterpreterConfig = LocalInterpreterConfig PersistenceStrategy HeadName|
@@ -147,6 +178,6 @@ reprLoop config sessionId conn = do
147178 Left err -> do
148179 displayOpResult $ DisplayErrorResult (T.pack (show err))
149180 Right parsed -> do
150− evald <- evalTutorialD sessionId conn parsed
181+ evald <- evalTutorialD sessionId conn UnsafeEvaluation parsed
151182 displayOpResult evald
152183 reprLoop config sessionId conn
TutorialD/Interpreter/Base.hs+6
@@ -1,3 +1,4 @@
1+{-# LANGUAGE DeriveGeneric #-}
12module TutorialD.Interpreter.Base where
23import Text.Parsec
34import Text.Parsec.String
@@ -10,6 +11,8 @@ import qualified Data.Vector as V
1011import qualified Data.Text.IO as TIO
1112import System.IO
1213import ProjectM36.DataTypes.Primitive
14+import ProjectM36.Relation.Show.Term
15+import GHC.Generics
1316
1417lexer :: Token.TokenParser ()
1518lexer = Token.makeTokenParser tutD
@@ -90,8 +93,10 @@ showRelationAttributes attrs = "{" `T.append` T.concat (L.intersperse ", " $ map
9093data TutorialDOperatorResult = QuitResult |
9194 DisplayResult StringType |
9295 DisplayIOResult (IO ()) |
96+ DisplayRelationResult Relation |
9397 DisplayErrorResult StringType |
9498 QuietSuccessResult
99+ deriving (Generic)
95100
96101type TransactionGraphWasUpdated = Bool
97102
@@ -101,6 +106,7 @@ displayOpResult (DisplayResult out) = TIO.putStrLn out
101106displayOpResult (DisplayIOResult ioout) = ioout
102107displayOpResult (DisplayErrorResult err) = TIO.hPutStrLn stderr ("ERR: " `T.append` err)
103108displayOpResult QuietSuccessResult = return ()
109+displayOpResult (DisplayRelationResult rel) = TIO.putStrLn (showRelation rel)
104110
105111quotedChar :: Parser Char
106112quotedChar = noneOf "\""
TutorialD/Interpreter/Import/BasicExamples.hsnew file+22
@@ -0,0 +1,22 @@
1+--includes some hardcoded examples which can be imported even during safe evaluation (no file I/O)
2+module TutorialD.Interpreter.Import.BasicExamples where
3+import ProjectM36.DateExamples
4+import ProjectM36.Base
5+import ProjectM36.DatabaseContext
6+import TutorialD.Interpreter.Base
7+import Text.Parsec.String
8+
9+data ImportBasicExampleOperator = ImportBasicDateExampleOperator
10+
11+evalImportBasicExampleOperator :: ImportBasicExampleOperator -> DatabaseContextExpr
12+evalImportBasicExampleOperator ImportBasicDateExampleOperator = databaseContextAsDatabaseContextExpr dateExamples
13+
14+importBasicExampleOperatorP :: Parser ImportBasicExampleOperator
15+importBasicExampleOperatorP = do
16+ reservedOp ":importexample"
17+ example <- identifier
18+ if example == "date" then
19+ pure ImportBasicDateExampleOperator
20+ else
21+ fail "Unknown example name"
22+
TutorialD/Interpreter/RODatabaseContextOperator.hs+2−4
@@ -9,7 +9,6 @@ import TutorialD.Interpreter.RelationalExpr
99import TutorialD.Interpreter.DatabaseContextExpr
1010import Control.Monad.State
1111import qualified Data.Text as T
12−import ProjectM36.Relation.Show.Term
1312import ProjectM36.Relation.Show.Gnuplot
1413import qualified Data.Map as M
1514import Data.Maybe
@@ -83,13 +82,13 @@ evalRODatabaseContextOp sessionId conn (ShowRelationType expr) = do
8382 res <- C.typeForRelationalExpr sessionId conn expr
8483 case res of
8584 Left err -> pure $ DisplayErrorResult $ T.pack (show err)
86− Right rel -> pure $ DisplayResult $ showRelation rel
85+ Right rel -> pure $ DisplayRelationResult rel
8786
8887evalRODatabaseContextOp sessionId conn (ShowRelation expr) = do
8988 res <- C.executeRelationalExpr sessionId conn expr
9089 case res of
9190 Left err -> pure $ DisplayErrorResult $ T.pack (show err)
92− Right rel -> pure $ DisplayResult $ showRelation rel
91+ Right rel -> pure $ DisplayRelationResult rel
9392
9493evalRODatabaseContextOp sessionId conn (PlotRelation expr) = do
9594 res <- C.executeRelationalExpr sessionId conn expr
@@ -126,7 +125,6 @@ evalRODatabaseContextOp sessionId conn ShowRelationVariables = do
126125 case eRel of
127126 Left err -> pure $ DisplayErrorResult (T.pack (show err))
128127 Right rel -> evalRODatabaseContextOp sessionId conn (ShowRelation (ExistingRelation rel))
129−
130128
131129evalRODatabaseContextOp _ _ (Quit) = pure QuitResult
132130
docs/15_minute_tutorial.markdown+9−1
@@ -26,11 +26,19 @@ Note that TutorialD is strongly-typed- no type coercions take place automaticall
2626### Load the Canonical Chris Date Example
2727
2828```
29−TutorialD (master): :importtutd "scripts/DateExamples.tutd"
29+TutorialD (master): :importexample date
30+```
31+
32+or
33+
34+```
35+TutorialD (master): :importtud "scripts/DateExamples.tutd"
3036```
3137
3238```:importtutd``` (do not skip typing the preceding colon), loads a file which contains a script written in the TutorialD dialect used by Project:M36 and executes it to change the state of the database. In this case, the relations "s" (supplier), "p" (product), and "sp" (suppliers-products) are now loaded.
3339
40+```:importexample date``` loads the date example directly without any file I/O, so it is safe to use with the websocket server.
41+
3442### Execute Relational Expressions
3543
3644```
docs/reaching_out_of_the_tarpit.markdown+2−2
@@ -58,8 +58,8 @@ Project:M36 implements multiple interfaces:
5858To understand how Project:M36 stacks up against the fictional programming language shown in the paper, we have implemented the [example from the paper](/examples/out_of_the_tarpit.tutd). The language used in the script is a dialect of Chris Date's TutorialD language. It can be loaded into an interactive ```tutd``` session like so:
5959
6060```
61−TutorialD (master): :importtutd "examples/out_of_the_tarpit.tutd"
62−TutorialD (master): :showexpr property
61+TutorialD (master): :importexample date
62+TutorialD (master): :showexpr p
6363┌───────────────────┬────────────┬───────────────────┬────────────┬────────────┐
6464│address::Address │agent::Agent│dateRegistered::Day│photo::Text │price::Price│
6565├───────────────────┼────────────┼───────────────────┼────────────┼────────────┤
docs/tutd_tutorial.markdown+1−1
@@ -68,7 +68,7 @@ products{}
6868The examples in this tutorial can be executed after loading Chris Date's sample relations using:
6969
7070```
71−:importtutd "scripts/DateExamples.tutd"
71+:importexample date
7272```
7373
7474Each section assumes a fresh instance of the Date examples. The relation variables created in the script are:
docs/websocket_server.markdownnew file+23
@@ -0,0 +1,23 @@
1+# Project:M36 WebSocket Server
2+
3+## Purpose
4+
5+The Project:M36 WebSocket server makes it easy to connect non-Haskell programs to the Project:M36 database. This server operates as a proxy to an actual Project:M36 database.
6+
7+## Setup
8+
9+The websocket server is started with the same arguments as the normal [Project:M36 server](docs/server_mode.markdown):
10+
11+```
12+cabal run project-m36-websocket-server -- --database mydbname --hostname 127.0.0.1
13+```
14+
15+except that the websocket server is now listening for websocket connections on port 8888.
16+
17+## Client Connection
18+
19+A [simple JavaScript library](ProjectM36/Server/WebSocket/project-m36.js) to manage the WebSocket connection is available.
20+
21+## Sample Application
22+
23+The [WebSocket example application](ProjectM36/Server/WebSocket/websocket-client.html) can be used to learn TutorialD and for remote database access from the web browser.
project-m36.cabal+46−9
@@ -205,6 +205,8 @@ Executable tutd
205205 ProjectM36.TypeConstructor,
206206 ProjectM36.TypeConstructorDef,
207207 ProjectM36.TransactionGraph.Merge,
208+ ProjectM36.DateExamples,
209+ TutorialD.Interpreter.Import.BasicExamples,
208210 TutorialD.Interpreter.InformationOperator,
209211 TutorialD.Interpreter.Export.Base,
210212 TutorialD.Interpreter.Export.CSV,
@@ -335,6 +337,7 @@ Executable bigrel
335337 ProjectM36.DataConstructorDef,
336338 ProjectM36.DataTypes.Basic,
337339 ProjectM36.DataTypes.Day,
340+ ProjectM36.Relation.Show.Term,
338341 ProjectM36.DataTypes.Either,
339342 ProjectM36.DataTypes.Maybe,
340343 ProjectM36.DataTypes.Primitive,
@@ -370,7 +373,7 @@ Test-Suite test-tutoriald
370373 type: exitcode-stdio-1.0
371374 main-is: test/TutorialD/Interpreter.hs
372375 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, parallel, cassava, attoparsec, gnuplot, directory, temporary, haskeline, parsec, text, base64-bytestring, data-interval, filepath, stm-containers, list-t
373− Other-Modules: ProjectM36.Atom, ProjectM36.AtomFunction, ProjectM36.AtomFunctions.Basic, ProjectM36.AtomFunctions.Primitive, ProjectM36.AtomType, ProjectM36.Attribute, ProjectM36.AttributeNames, ProjectM36.Base, ProjectM36.Client, ProjectM36.ConcreteTypeRep, ProjectM36.DataConstructorDef, ProjectM36.DataTypes.Basic, ProjectM36.DataTypes.Day, ProjectM36.DataTypes.Either, ProjectM36.DataTypes.Maybe, ProjectM36.DataTypes.Primitive, ProjectM36.DatabaseContext, ProjectM36.DateExamples, ProjectM36.Error, ProjectM36.Key, ProjectM36.MiscUtils, ProjectM36.Notifications, ProjectM36.Persist, ProjectM36.Relation, ProjectM36.Relation.Parse.CSV, ProjectM36.Relation.Show.CSV, ProjectM36.Relation.Show.Gnuplot, ProjectM36.Relation.Show.Term, ProjectM36.RelationalExpression, ProjectM36.Server.RemoteCallTypes, ProjectM36.Session, ProjectM36.Sessions, ProjectM36.StaticOptimizer, ProjectM36.Transaction, ProjectM36.Transaction.Persist, ProjectM36.TransactionGraph, ProjectM36.TransactionGraph.Persist, ProjectM36.TransactionGraph.Merge, ProjectM36.Tuple, ProjectM36.TupleSet, ProjectM36.TypeConstructor, ProjectM36.TypeConstructorDef, TutorialD.Interpreter, TutorialD.Interpreter.Base, TutorialD.Interpreter.Export.Base, TutorialD.Interpreter.Export.CSV, TutorialD.Interpreter.Import.Base, TutorialD.Interpreter.Import.CSV, TutorialD.Interpreter.Import.TutorialD, TutorialD.Interpreter.RODatabaseContextOperator, TutorialD.Interpreter.RelationalExpr, TutorialD.Interpreter.TransactionGraphOperator, TutorialD.Interpreter.Types, TutorialD.Interpreter.DatabaseContextExpr, TutorialD.Interpreter.InformationOperator
376+ Other-Modules: ProjectM36.Atom, ProjectM36.AtomFunction, ProjectM36.AtomFunctions.Basic, ProjectM36.AtomFunctions.Primitive, ProjectM36.AtomType, ProjectM36.Attribute, ProjectM36.AttributeNames, ProjectM36.Base, ProjectM36.Client, ProjectM36.ConcreteTypeRep, ProjectM36.DataConstructorDef, ProjectM36.DataTypes.Basic, ProjectM36.DataTypes.Day, ProjectM36.DataTypes.Either, ProjectM36.DataTypes.Maybe, ProjectM36.DataTypes.Primitive, ProjectM36.DatabaseContext, ProjectM36.DateExamples, ProjectM36.Error, ProjectM36.Key, ProjectM36.MiscUtils, ProjectM36.Notifications, ProjectM36.Persist, ProjectM36.Relation, ProjectM36.Relation.Parse.CSV, ProjectM36.Relation.Show.CSV, ProjectM36.Relation.Show.Gnuplot, ProjectM36.Relation.Show.Term, ProjectM36.RelationalExpression, ProjectM36.Server.RemoteCallTypes, ProjectM36.Session, ProjectM36.Sessions, ProjectM36.StaticOptimizer, ProjectM36.Transaction, ProjectM36.Transaction.Persist, ProjectM36.TransactionGraph, ProjectM36.TransactionGraph.Persist, ProjectM36.TransactionGraph.Merge, ProjectM36.Tuple, ProjectM36.TupleSet, ProjectM36.TypeConstructor, ProjectM36.TypeConstructorDef, TutorialD.Interpreter, TutorialD.Interpreter.Base, TutorialD.Interpreter.Export.Base, TutorialD.Interpreter.Export.CSV, TutorialD.Interpreter.Import.Base, TutorialD.Interpreter.Import.CSV, TutorialD.Interpreter.Import.TutorialD, TutorialD.Interpreter.RODatabaseContextOperator, TutorialD.Interpreter.RelationalExpr, TutorialD.Interpreter.TransactionGraphOperator, TutorialD.Interpreter.Types, TutorialD.Interpreter.DatabaseContextExpr, TutorialD.Interpreter.InformationOperator, TutorialD.Interpreter.Import.BasicExamples
374377 GHC-Options: -Wall
375378 CPP-Options: -DPROJECTM36_VERSION="v0.1"
376379 if os(windows)
@@ -407,7 +410,7 @@ Test-Suite test-transactiongraph-persist
407410 type: exitcode-stdio-1.0
408411 main-is: test/TransactionGraph/Persist.hs
409412 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, parallel, cassava, attoparsec, gnuplot, directory, temporary, haskeline, parsec, text, base64-bytestring, data-interval, filepath, stm-containers
410− Other-Modules: ProjectM36.Atom, ProjectM36.AtomFunction, ProjectM36.AtomFunctions.Basic, ProjectM36.AtomFunctions.Primitive, ProjectM36.AtomType, ProjectM36.Attribute, ProjectM36.AttributeNames, ProjectM36.Base, ProjectM36.ConcreteTypeRep, ProjectM36.DataConstructorDef, ProjectM36.DataTypes.Basic, ProjectM36.DataTypes.Day, ProjectM36.DataTypes.Either, ProjectM36.DataTypes.Maybe, ProjectM36.DataTypes.Primitive, ProjectM36.DatabaseContext, ProjectM36.DateExamples, ProjectM36.Error, ProjectM36.Key, ProjectM36.MiscUtils, ProjectM36.Persist, ProjectM36.Relation, ProjectM36.RelationalExpression, ProjectM36.StaticOptimizer, ProjectM36.Transaction, ProjectM36.Transaction.Persist, ProjectM36.TransactionGraph, ProjectM36.TransactionGraph.Persist, ProjectM36.TransactionGraph.Merge, ProjectM36.Tuple, ProjectM36.TupleSet, ProjectM36.TypeConstructor, ProjectM36.TypeConstructorDef, TutorialD.Interpreter.Base, TutorialD.Interpreter.RelationalExpr, TutorialD.Interpreter.Types, TutorialD.Interpreter.DatabaseContextExpr
413+ Other-Modules: ProjectM36.Atom, ProjectM36.AtomFunction, ProjectM36.AtomFunctions.Basic, ProjectM36.AtomFunctions.Primitive, ProjectM36.AtomType, ProjectM36.Attribute, ProjectM36.AttributeNames, ProjectM36.Base, ProjectM36.ConcreteTypeRep, ProjectM36.DataConstructorDef, ProjectM36.DataTypes.Basic, ProjectM36.DataTypes.Day, ProjectM36.DataTypes.Either, ProjectM36.DataTypes.Maybe, ProjectM36.DataTypes.Primitive, ProjectM36.DatabaseContext, ProjectM36.DateExamples, ProjectM36.Error, ProjectM36.Key, ProjectM36.MiscUtils, ProjectM36.Persist, ProjectM36.Relation, ProjectM36.RelationalExpression, ProjectM36.StaticOptimizer, ProjectM36.Transaction, ProjectM36.Transaction.Persist, ProjectM36.TransactionGraph, ProjectM36.TransactionGraph.Persist, ProjectM36.TransactionGraph.Merge, ProjectM36.Tuple, ProjectM36.TupleSet, ProjectM36.TypeConstructor, ProjectM36.TypeConstructorDef, TutorialD.Interpreter.Base, TutorialD.Interpreter.RelationalExpr, TutorialD.Interpreter.Types, TutorialD.Interpreter.DatabaseContextExpr, TutorialD.Interpreter.Import.BasicExamples
411414 GHC-Options: -Wall
412415 CPP-Options: -DPROJECTM36_VERSION="v0.1"
413416 if os(windows)
@@ -434,7 +437,7 @@ Test-Suite test-tutoriald-import-tutoriald
434437 type: exitcode-stdio-1.0
435438 main-is: test/TutorialD/Interpreter/Import/TutorialD.hs
436439 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, parallel, cassava, attoparsec, gnuplot, directory, temporary, haskeline, parsec, text, base64-bytestring, data-interval, filepath, stm-containers
437− Other-Modules: ProjectM36.Atom, ProjectM36.AtomFunction, ProjectM36.AtomType, ProjectM36.Attribute, ProjectM36.AttributeNames, ProjectM36.Base, ProjectM36.ConcreteTypeRep, ProjectM36.DataConstructorDef, ProjectM36.DataTypes.Primitive, ProjectM36.Error, ProjectM36.Key, ProjectM36.MiscUtils, ProjectM36.Relation, ProjectM36.RelationalExpression, ProjectM36.StaticOptimizer, ProjectM36.Tuple, ProjectM36.TupleSet, ProjectM36.TypeConstructor, ProjectM36.TypeConstructorDef, TutorialD.Interpreter.Base, TutorialD.Interpreter.Import.Base, TutorialD.Interpreter.Import.TutorialD, TutorialD.Interpreter.RelationalExpr, TutorialD.Interpreter.Types, TutorialD.Interpreter.DatabaseContextExpr
440+ Other-Modules: ProjectM36.Atom, ProjectM36.AtomFunction, ProjectM36.AtomType, ProjectM36.Attribute, ProjectM36.AttributeNames, ProjectM36.Base, ProjectM36.ConcreteTypeRep, ProjectM36.DataConstructorDef, ProjectM36.DataTypes.Primitive, ProjectM36.Error, ProjectM36.Key, ProjectM36.MiscUtils, ProjectM36.Relation, ProjectM36.RelationalExpression, ProjectM36.StaticOptimizer, ProjectM36.Tuple, ProjectM36.TupleSet, ProjectM36.TypeConstructor, ProjectM36.TypeConstructorDef, ProjectM36.Relation.Show.Term, TutorialD.Interpreter.Base, TutorialD.Interpreter.Import.Base, TutorialD.Interpreter.Import.TutorialD, TutorialD.Interpreter.RelationalExpr, TutorialD.Interpreter.Types, TutorialD.Interpreter.DatabaseContextExpr, TutorialD.Interpreter.Import.BasicExamples
438441 GHC-Options: -Wall
439442 CPP-Options: -DPROJECTM36_VERSION="v0.1"
440443
@@ -464,18 +467,22 @@ Test-Suite test-persistent-driver
464467 C-sources: ProjectM36/DirectoryFsync.c
465468 Build-Depends: unix
466469
467−
468−
469470Test-Suite test-transactiongraph-merge
470471 Default-Language: Haskell2010
471472 Default-Extensions: OverloadedStrings
472473 type: exitcode-stdio-1.0
473474 main-is: test/TransactionGraph/Merge.hs
474− 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, template-haskell, transformers, aeson, persistent-template, conduit, persistent, either, path-pieces, http-api-data, stm-containers, list-t
475− Other-Modules: ProjectM36.Atom, ProjectM36.AtomFunction, ProjectM36.AtomFunctions.Basic, ProjectM36.AtomFunctions.Primitive, ProjectM36.AtomType, ProjectM36.Attribute, ProjectM36.AttributeNames, ProjectM36.Base, ProjectM36.ConcreteTypeRep, ProjectM36.DataConstructorDef, ProjectM36.DataTypes.Basic, ProjectM36.DataTypes.Day, ProjectM36.DataTypes.Either, ProjectM36.DataTypes.Maybe, ProjectM36.DataTypes.Primitive, ProjectM36.DatabaseContext, ProjectM36.DateExamples, ProjectM36.Error, ProjectM36.Key, ProjectM36.MiscUtils, ProjectM36.Relation, ProjectM36.RelationalExpression, ProjectM36.Transaction, ProjectM36.TransactionGraph, ProjectM36.TransactionGraph.Merge, ProjectM36.TransactionGraph.Show, ProjectM36.TransactionGraph.Show.Dot, ProjectM36.Tuple, ProjectM36.TupleSet, ProjectM36.TypeConstructor, ProjectM36.TypeConstructorDef
475+ 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, parallel, cassava, attoparsec, gnuplot, directory, temporary, haskeline, parsec, text, base64-bytestring, data-interval, filepath, template-haskell, transformers, aeson, persistent-template, conduit, persistent, either, path-pieces, http-api-data, stm-containers, list-t
476+ Other-Modules: ProjectM36.Atom, ProjectM36.AtomFunction, ProjectM36.AtomFunctions.Basic, ProjectM36.AtomFunctions.Primitive, ProjectM36.AtomType, ProjectM36.Attribute, ProjectM36.AttributeNames, ProjectM36.Base, ProjectM36.ConcreteTypeRep, ProjectM36.DataConstructorDef, ProjectM36.DataTypes.Basic, ProjectM36.DataTypes.Day, ProjectM36.DataTypes.Either, ProjectM36.DataTypes.Maybe, ProjectM36.DataTypes.Primitive, ProjectM36.DatabaseContext, ProjectM36.DateExamples, ProjectM36.Error, ProjectM36.Key, ProjectM36.MiscUtils, ProjectM36.Relation, ProjectM36.RelationalExpression, ProjectM36.Transaction, ProjectM36.TransactionGraph, ProjectM36.TransactionGraph.Merge, ProjectM36.TransactionGraph.Show, ProjectM36.TransactionGraph.Show.Dot, ProjectM36.Tuple, ProjectM36.TupleSet, ProjectM36.TypeConstructor, ProjectM36.TypeConstructorDef, ProjectM36.Relation.Show.Term
476477 GHC-Options: -Wall
477478 CPP-Options: -DPROJECTM36_VERSION="v0.1"
478− C-sources: ProjectM36/DirectoryFsync.c
479+ if os(windows)
480+ Build-Depends: Win32 >= 2.3 && < 2.4
481+ Other-Modules: ProjectM36.Win32Handle
482+ else
483+ C-sources: ProjectM36/DirectoryFsync.c
484+ Build-Depends: unix
485+
479486
480487benchmark bench
481488 Default-Language: Haskell2010
@@ -614,7 +621,7 @@ Test-Suite test-scripts
614621 type: exitcode-stdio-1.0
615622 main-is: test/scripts.hs
616623 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, parallel, cassava, attoparsec, gnuplot, directory, temporary, haskeline, parsec, text, base64-bytestring, data-interval, filepath, transformers, stm-containers, list-t
617− Other-Modules: ProjectM36.Atom, ProjectM36.AtomFunction, ProjectM36.AtomType, ProjectM36.Attribute, ProjectM36.AttributeNames, ProjectM36.Base, ProjectM36.ConcreteTypeRep, ProjectM36.DataConstructorDef, ProjectM36.DataTypes.Primitive, ProjectM36.Error, ProjectM36.Key, ProjectM36.MiscUtils, ProjectM36.Relation, ProjectM36.RelationalExpression, ProjectM36.StaticOptimizer, ProjectM36.Tuple, ProjectM36.TupleSet, ProjectM36.TypeConstructor, ProjectM36.TypeConstructorDef, TutorialD.Interpreter.Base, TutorialD.Interpreter.DatabaseContextExpr, TutorialD.Interpreter.Import.Base, TutorialD.Interpreter.Import.TutorialD, TutorialD.Interpreter.RelationalExpr, TutorialD.Interpreter.Types
624+ Other-Modules: ProjectM36.Atom, ProjectM36.AtomFunction, ProjectM36.AtomType, ProjectM36.Attribute, ProjectM36.AttributeNames, ProjectM36.Base, ProjectM36.ConcreteTypeRep, ProjectM36.DataConstructorDef, ProjectM36.DataTypes.Primitive, ProjectM36.Error, ProjectM36.Key, ProjectM36.MiscUtils, ProjectM36.Relation, ProjectM36.RelationalExpression, ProjectM36.StaticOptimizer, ProjectM36.Tuple, ProjectM36.TupleSet, ProjectM36.TypeConstructor, ProjectM36.TypeConstructorDef, ProjectM36.Relation.Show.Term, TutorialD.Interpreter.Base, TutorialD.Interpreter.DatabaseContextExpr, TutorialD.Interpreter.Import.Base, TutorialD.Interpreter.Import.TutorialD, TutorialD.Interpreter.RelationalExpr, TutorialD.Interpreter.Types, TutorialD.Interpreter.Import.BasicExamples
618625 GHC-Options: -Wall
619626 CPP-Options: -DPROJECTM36_VERSION="v0.1"
620627 if os(windows)
@@ -624,3 +631,33 @@ Test-Suite test-scripts
624631 C-sources: ProjectM36/DirectoryFsync.c
625632 Build-Depends: unix
626633
634+Executable project-m36-websocket-server
635+ Default-Language: Haskell2010
636+ 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, parallel, cassava, attoparsec, gnuplot, directory, temporary, haskeline, parsec, text, base64-bytestring, data-interval, filepath, transformers, stm-containers, list-t, persistent, aeson, path-pieces, either, conduit, http-api-data, template-haskell, persistent-template, websockets, aeson, uuid-aeson, optparse-applicative
637+ Other-Modules: ProjectM36.Atom, ProjectM36.AtomFunction, ProjectM36.AtomFunctions.Basic, ProjectM36.AtomFunctions.Primitive, ProjectM36.AtomType, ProjectM36.Attribute, ProjectM36.AttributeNames, ProjectM36.Base, ProjectM36.Client, ProjectM36.Client.Json, ProjectM36.ConcreteTypeRep, ProjectM36.DataConstructorDef, ProjectM36.DataTypes.Basic, ProjectM36.DataTypes.Day, ProjectM36.DataTypes.Either, ProjectM36.DataTypes.Maybe, ProjectM36.DataTypes.Primitive, ProjectM36.DatabaseContext, ProjectM36.DateExamples, ProjectM36.Error, ProjectM36.Key, ProjectM36.MiscUtils, ProjectM36.Notifications, ProjectM36.Persist, ProjectM36.Relation, ProjectM36.Relation.Parse.CSV, ProjectM36.Relation.Show.CSV, ProjectM36.Relation.Show.Gnuplot, ProjectM36.Relation.Show.Term, ProjectM36.RelationalExpression, ProjectM36.Server, ProjectM36.Server.Config, ProjectM36.Server.EntryPoints, ProjectM36.Server.ParseArgs, ProjectM36.Server.RemoteCallTypes, ProjectM36.Server.RemoteCallTypes.Json, ProjectM36.Server.WebSocket, ProjectM36.Session, ProjectM36.Sessions, ProjectM36.StaticOptimizer, ProjectM36.Transaction, ProjectM36.Transaction.Persist, ProjectM36.TransactionGraph, ProjectM36.TransactionGraph.Merge, ProjectM36.TransactionGraph.Persist, ProjectM36.Tuple, ProjectM36.TupleSet, ProjectM36.TypeConstructor, ProjectM36.TypeConstructorDef, TutorialD.Interpreter, TutorialD.Interpreter.Base, TutorialD.Interpreter.DatabaseContextExpr, TutorialD.Interpreter.Export.Base, TutorialD.Interpreter.Export.CSV, TutorialD.Interpreter.Import.Base, TutorialD.Interpreter.Import.BasicExamples, TutorialD.Interpreter.Import.CSV, TutorialD.Interpreter.Import.TutorialD, TutorialD.Interpreter.InformationOperator, TutorialD.Interpreter.RODatabaseContextOperator, TutorialD.Interpreter.RelationalExpr, TutorialD.Interpreter.TransactionGraphOperator, TutorialD.Interpreter.Types
638+ Main-Is: ProjectM36/Server/WebSocket/Main.hs
639+ GHC-Options: -Wall
640+ CPP-Options: -DPROJECTM36_VERSION="v0.1"
641+ Default-Extensions: OverloadedStrings
642+ if os(windows)
643+ Build-Depends: Win32 >= 2.3 && < 2.4
644+ Other-Modules: ProjectM36.Win32Handle
645+ else
646+ C-sources: ProjectM36/DirectoryFsync.c
647+ Build-Depends: unix
648+
649+Test-Suite test-websocket-server
650+ Default-Language: Haskell2010
651+ type: exitcode-stdio-1.0
652+ main-is: test/Server/WebSocket.hs
653+ 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, parallel, cassava, attoparsec, gnuplot, directory, temporary, haskeline, parsec, text, base64-bytestring, data-interval, filepath, transformers, stm-containers, list-t, websockets, optparse-applicative, network, aeson, uuid-aeson
654+ Other-Modules: ProjectM36.Atom, ProjectM36.AtomFunction, ProjectM36.AtomType, ProjectM36.Attribute, ProjectM36.AttributeNames, ProjectM36.Base, ProjectM36.ConcreteTypeRep, ProjectM36.DataConstructorDef, ProjectM36.DataTypes.Primitive, ProjectM36.Error, ProjectM36.Key, ProjectM36.MiscUtils, ProjectM36.Relation, ProjectM36.RelationalExpression, ProjectM36.StaticOptimizer, ProjectM36.Tuple, ProjectM36.TupleSet, ProjectM36.TypeConstructor, ProjectM36.TypeConstructorDef, TutorialD.Interpreter.Base, TutorialD.Interpreter.DatabaseContextExpr, TutorialD.Interpreter.Import.Base, TutorialD.Interpreter.Import.TutorialD, TutorialD.Interpreter.RelationalExpr, TutorialD.Interpreter.Types, ProjectM36.AtomFunctions.Basic, ProjectM36.AtomFunctions.Primitive, ProjectM36.Client, ProjectM36.Client.Json, ProjectM36.DataTypes.Basic, ProjectM36.DataTypes.Day, ProjectM36.DataTypes.Either, ProjectM36.DataTypes.Maybe, ProjectM36.DatabaseContext, ProjectM36.DateExamples, ProjectM36.Notifications, ProjectM36.Persist, ProjectM36.Relation.Parse.CSV, ProjectM36.Relation.Show.CSV, ProjectM36.Relation.Show.Gnuplot, ProjectM36.Relation.Show.Term, ProjectM36.Server, ProjectM36.Server.Config, ProjectM36.Server.EntryPoints, ProjectM36.Server.RemoteCallTypes, ProjectM36.Server.RemoteCallTypes.Json, ProjectM36.Server.WebSocket, ProjectM36.Session, ProjectM36.Sessions, ProjectM36.Transaction, ProjectM36.Transaction.Persist, ProjectM36.TransactionGraph, ProjectM36.TransactionGraph.Merge, ProjectM36.TransactionGraph.Persist, TutorialD.Interpreter, TutorialD.Interpreter.Export.Base, TutorialD.Interpreter.Export.CSV, TutorialD.Interpreter.Import.BasicExamples, TutorialD.Interpreter.Import.CSV, TutorialD.Interpreter.InformationOperator, TutorialD.Interpreter.RODatabaseContextOperator, TutorialD.Interpreter.TransactionGraphOperator
655+ Default-Extensions: OverloadedStrings
656+ GHC-Options: -Wall
657+ CPP-Options: -DPROJECTM36_VERSION="v0.1"
658+ if os(windows)
659+ Build-Depends: Win32 >= 2.3 && < 2.4
660+ Other-Modules: ProjectM36.Win32Handle
661+ else
662+ C-sources: ProjectM36/DirectoryFsync.c
663+ Build-Depends: unix
stack.yaml+1
@@ -14,6 +14,7 @@ extra-deps:
1414- extended-reals-0.2.1.0
1515- gnuplot-0.5.4.1
1616- text-1.2.2.1
17+- uuid-aeson-0.1.0.0
1718
1819# Override default flag values for local packages and extra-deps
1920flags: {}
test/Server/WebSocket.hsnew file+88
@@ -0,0 +1,88 @@
1+-- test the websocket server
2+
3+import Test.HUnit
4+import qualified Network.WebSockets as WS
5+import ProjectM36.Server.WebSocket
6+import ProjectM36.Server.Config
7+import ProjectM36.Server
8+import ProjectM36.Client
9+import Network.Socket
10+import Control.Exception
11+import Control.Concurrent
12+import System.Exit
13+import Data.Typeable
14+import Data.Text hiding (map)
15+import Data.Aeson
16+import ProjectM36.Base
17+import qualified Data.Map as M
18+import qualified Data.ByteString.Lazy as BS
19+import ProjectM36.Relation
20+
21+--start the websocket server
22+-- run some tutoriald against it
23+
24+launchTestServer :: IO (PortNumber, DatabaseName)
25+launchTestServer = do
26+ portMVar <- newEmptyMVar
27+ let config = defaultServerConfig { databaseName = testDatabaseName }
28+ testDatabaseName = "test"
29+ -- start normal server
30+ _ <- forkIO (launchServer config (Just portMVar) >> pure ())
31+ serverPort <- takeMVar portMVar
32+ let serverHost = "127.0.0.1"
33+ let testPort = 8889
34+ -- start websocket server proxy -- runServer doesn't support returning an arbitrary socket
35+ _ <- forkIO (WS.runServer serverHost testPort (websocketProxyServer serverPort serverHost))
36+ --wait for socket to be listening
37+ waitForListenSocket 5 (fromIntegral testPort)
38+ pure (fromIntegral testPort, testDatabaseName)
39+
40+data TestException = WaitForSocketListenException
41+ deriving (Show, Typeable)
42+
43+instance Exception TestException
44+
45+waitForListenSocket :: Int -> PortNumber -> IO ()
46+waitForListenSocket secondsToTry port = do
47+ if secondsToTry <= 0 then
48+ throw WaitForSocketListenException
49+ else do
50+ hostaddr <- inet_addr "127.0.0.1"
51+ sock <- socket AF_INET Stream defaultProtocol
52+ let handler :: IOException -> IO ()
53+ handler = \_ -> do
54+ threadDelay 1000000
55+ waitForListenSocket (secondsToTry - 1) port
56+ catch (connect sock (SockAddrInet port hostaddr)) handler
57+
58+main :: IO ()
59+main = do
60+ (port, dbname) <- launchTestServer
61+ tcounts <- runTestTT (testList port dbname)
62+ if errors tcounts + failures tcounts > 0 then exitFailure else exitSuccess
63+
64+testList :: PortNumber -> DatabaseName -> Test
65+testList port dbName = TestList $ map (\f -> f port dbName) [testBasicConnection,
66+ testTutorialD]
67+
68+basicConnection :: PortNumber -> WS.ClientApp () -> IO ()
69+basicConnection port block = WS.runClient "127.0.0.1" (fromIntegral port) "/" block
70+
71+basicConnectionWithDatabase :: PortNumber -> DatabaseName -> WS.ClientApp () -> IO ()
72+basicConnectionWithDatabase port dbname block = basicConnection port (\conn -> do
73+ WS.sendTextData conn ("connectdb:" `append` (pack dbname))
74+ block conn)
75+
76+testBasicConnection :: PortNumber -> DatabaseName -> Test
77+testBasicConnection port _ = TestCase $ basicConnection port (\conn -> WS.sendClose conn ("test close"::Text))
78+
79+testTutorialD :: PortNumber -> DatabaseName -> Test
80+testTutorialD port dbname = TestCase $ basicConnectionWithDatabase port dbname testtutd
81+ where
82+ testtutd = \conn -> do
83+ WS.sendTextData conn ("executetutd:" `append` ":showexpr true")
84+ response <- WS.receiveData conn :: IO BS.ByteString
85+ let decoded = decode response :: Maybe (M.Map Text Relation)
86+ case decoded of
87+ Just val -> assertEqual "round-trip true relation" (M.lookup "displayrelation" val) (Just relationTrue) >> WS.sendClose conn ("test close"::Text)
88+ Nothing -> assertFailure "failed to decode relation"
test/TutorialD/Interpreter.hs+4−2
@@ -141,11 +141,12 @@ transactionGraphAddCommitTest = TestCase $ do
141141 case parseTutorialD "x:=s" of
142142 Left err -> assertFailure (show err)
143143 Right parsed -> do
144− result <- evalTutorialD sessionId dbconn parsed
144+ result <- evalTutorialD sessionId dbconn UnsafeEvaluation parsed
145145 case result of
146146 QuitResult -> assertFailure "quit?"
147147 DisplayResult _ -> assertFailure "display?"
148148 DisplayIOResult _ -> assertFailure "displayIO?"
149+ DisplayRelationResult _ -> assertFailure "displayrelation?"
149150 DisplayErrorResult err -> assertFailure (show err)
150151 QuietSuccessResult -> do
151152 commit sessionId dbconn >>= maybeFail
@@ -280,11 +281,12 @@ executeTutorialD :: SessionId -> Connection -> String -> IO ()
280281executeTutorialD sessionId conn tutd = case parseTutorialD tutd of
281282 Left err -> assertFailure (show tutd ++ ": " ++ show err)
282283 Right parsed -> do
283− result <- evalTutorialD sessionId conn parsed
284+ result <- evalTutorialD sessionId conn UnsafeEvaluation parsed
284285 case result of
285286 QuitResult -> assertFailure "quit?"
286287 DisplayResult _ -> assertFailure "display?"
287288 DisplayIOResult _ -> assertFailure "displayIO?"
289+ DisplayRelationResult _ -> assertFailure "displayrelation?"
288290 DisplayErrorResult err -> assertFailure (show err)
289291 QuietSuccessResult -> pure ()
290292