2bc6417 · project-m36 · git.iko.soy

git.iko.soy/project-m36

WIP compilation checkpoint

scripting in place but Atom library is missing for function contexts proper type check is missing (currently Int -> Int but needs to be ([Atom] -> Atom)

commit2bc64174efe6b86ef7e3517a628228d86f8ce98c authorAgentM <agentm@themactionfaction.com> dateWed 17 Aug 2016, 23:02 (10 years ago) parenta62ba78

18 files changed+303−56

compare with master

unifiedsplit

ProjectM36/AtomFunction.hs+15 ProjectM36/AtomFunctionBody.hs+92 ProjectM36/AtomFunctions/Primitive.hs+14−12 ProjectM36/AtomType.hs+1 ProjectM36/Base.hs+32−6 ProjectM36/Client.hs+46−24 ProjectM36/DataTypes/Day.hs+3−3 ProjectM36/DataTypes/Either.hs+2−4 ProjectM36/DataTypes/Maybe.hs+1−1 ProjectM36/Error.hs+10−1 ProjectM36/RelationalExpression.hs+48−3 ProjectM36/Server.hs+1 ProjectM36/Server/EntryPoints.hs+5 ProjectM36/Server/RemoteCallTypes.hs+2 ProjectM36/StaticOptimizer.hs+1 TutorialD/Interpreter.hs+13−1 TutorialD/Interpreter/Base.hs+3 project-m36.cabal+14−1

ProjectM36/AtomFunction.hs+15

@@ -15,5 +15,20 @@ atomFunctionForName funcName funcSet = if HS.null foundFunc then

1515 where

1616 foundFunc = HS.filter (\(AtomFunction name _ _) -> name == funcName) funcSet

1717

18+-- | Create a junk named atom function for use with searching for an already existing function in the AtomFunctions HashSet.

19+emptyAtomFunction :: AtomFunctionName -> AtomFunction

20+emptyAtomFunction name = AtomFunction { atomFuncName = name,

21+ atomFuncType = [AnyAtomType, AnyAtomType],

22+ atomFuncBody = AtomFunctionBody Nothing (\(x:_) -> x) }

1823

1924

25+-- | AtomFunction constructor for compiled-in functions.

26+compiledAtomFunction :: AtomFunctionName -> [AtomType] -> AtomFunctionBodyType -> AtomFunction

27+compiledAtomFunction name aType body = AtomFunction { atomFuncName = name,

28+ atomFuncType = aType,

29+ atomFuncBody = AtomFunctionBody Nothing body }

30+

31+--the atom function really should offer some way to return an error

32+evalAtomFunction :: AtomFunction -> [Atom] -> Atom

33+evalAtomFunction func args = case atomFuncBody func of

34+ (AtomFunctionBody _ f) -> f args

ProjectM36/AtomFunctionBody.hsnew file+92

@@ -0,0 +1,92 @@

1+{-# LANGUAGE ScopedTypeVariables #-}

2+--tools to execute an atom function body

3+module ProjectM36.AtomFunctionBody where

4+import ProjectM36.Base

5+import ProjectM36.Error

7+import Control.Monad.IO.Class

8+import Control.Exception

9+import Data.Dynamic

10+import Data.Text

11+

12+import GHC

13+import GHC.Paths (libdir)

14+import DynFlags

15+import Outputable hiding ((<>))

16+import PprTyThing

17+import Type hiding (pprTyThing)

18+import TysWiredIn

19+

20+type ScriptSession = HscEnv

21+

22+-- | Configure a GHC environment/session which we will use for all script compilation.

23+initScriptSession :: IO ScriptSession

24+initScriptSession = runGhc (Just libdir) $ do

25+ liftIO $ putStrLn "Setting up HscEnv"

26+ dflags <- getSessionDynFlags

27+ let dflags' = dflags { hscTarget = HscInterpreted ,

28+ ghcLink = LinkInMemory,

29+ safeHaskell = Sf_Safe,

30+ safeInfer = True,

31+ safeInferred = True

32+ }

33+ `xopt_set` Opt_ExtendedDefaultRules

34+ --`xopt_unset` Opt_ImplicitPrelude

35+ `gopt_set` Opt_DistrustAllPackages

36+ `gopt_set` Opt_PackageTrust

37+ `gopt_set` Opt_ImplicitImportQualified

38+ _ <- setSessionDynFlags dflags'

39+ setContext [ IIDecl $ simpleImportDecl (mkModuleName "Prelude") ]

40+ env <- getSession

41+ return env

42+

43+addImport :: String -> Ghc ()

44+addImport moduleNam = do

45+ ctx <- getContext

46+ setContext ( (IIDecl $ simpleImportDecl (mkModuleName moduleNam)) : ctx )

47+

48+showType :: DynFlags -> Type -> String

49+showType dflags ty = showSDocForUser dflags alwaysQualify (pprTypeForUser ty)

50+

51+-- | Typecheck and validate the

52+typeCheckAtomFunctionScript :: AtomFunctionBodyScript -> Ghc (Maybe AtomFunctionBodyCompilationError)

53+typeCheckAtomFunctionScript inp = do

54+ dflags <- getSessionDynFlags

55+ --catch exception for SyntaxError

56+ funcType <- GHC.exprType (unpack inp)

57+

58+ let expectedType = atomFunctionBodyGhcType

59+

60+ if eqType funcType expectedType then

61+ pure Nothing

62+ else

63+ pure (Just (TypeCheckCompilationError (showType dflags expectedType) (showType dflags funcType)))

64+

65+atomFunctionBodyGhcType :: Type

66+atomFunctionBodyGhcType = Type.mkFunTy intTy intTy

67+

68+-- | After compiling the script, it must accept a list of Atoms and return an Atom, otherwise an AtomFunctionBodyCompilationError is returned

69+compileAtomFunctionScript :: AtomFunctionBodyScript -> Ghc (Either AtomFunctionBodyCompilationError AtomFunctionBodyType)

70+compileAtomFunctionScript script = do

71+ let sScript = unpack script

72+ mErr <- typeCheckAtomFunctionScript script

73+ case mErr of

74+ Just err -> pure (Left err)

75+ Nothing -> do

76+ --catch exception here

77+ --we could potentially wrap the script with Atom pattern matching so that the script doesn't have to do it, but the change to an Atom ADT should make it easier. Still, it would be nice if the script didn't have to handle a list of arguments, for example.

78+ mDyn <- fromDynamic <$> dynCompileExpr sScript

79+ case mDyn of

80+ Nothing -> pure $ Left (TypeCheckCompilationError "" "") --this really shouldn't happen

81+ Just funcBody -> pure $ Right funcBody

82+

83+catchCompileException :: MonadIO m => IO a -> m (Either AtomFunctionBodyCompilationError a)

84+catchCompileException m = liftIO $ do

85+ mres <- try m

86+ case mres of

87+ Left (err :: SomeException) -> do

88+ pure (Left (OtherScriptCompilationError (show err)))

89+ Right res -> pure (Right res)

90+

91+compiledAtomFunctionBody :: AtomFunctionBodyType -> AtomFunctionBody

92+compiledAtomFunctionBody func = AtomFunctionBody Nothing func

ProjectM36/AtomFunctions/Primitive.hs+14−12

@@ -17,42 +17,44 @@ primitiveAtomFunctions = HS.fromList [

1717 --match on any relation type

1818 AtomFunction { atomFuncName = "add",

1919 atomFuncType = [intAtomType, intAtomType, intAtomType],

20− atomFunc = (\(i1:i2:_) -> Atom $ ((unsafeCast i1)::Int) + unsafeCast i2)},

20+ atomFuncBody = body (\(i1:i2:_) -> Atom $ ((unsafeCast i1)::Int) + unsafeCast i2)},

2121 AtomFunction { atomFuncName = "id",

2222 atomFuncType = [AnyAtomType, AnyAtomType],

23− atomFunc = (\(x:_) -> x)},

23+ atomFuncBody = body (\(x:_) -> x)},

2424 AtomFunction { atomFuncName = "sum",

2525 atomFuncType = foldAtomFuncType intAtomType intAtomType,

26− atomFunc = (\(relAtom:_) -> relationSum $ unsafeCast relAtom)},

26+ atomFuncBody = body (\(relAtom:_) -> relationSum $ unsafeCast relAtom)},

2727 AtomFunction { atomFuncName = "count",

2828 atomFuncType = foldAtomFuncType AnyAtomType intAtomType,

29− atomFunc = (\((relIn):_) -> relationCount (castRelation relIn))},

29+ atomFuncBody = body (\((relIn):_) -> relationCount (castRelation relIn))},

3030 AtomFunction { atomFuncName = "max",

3131 atomFuncType = foldAtomFuncType intAtomType intAtomType,

32− atomFunc = (\((relIn):_) -> relationMax (castRelation relIn))},

32+ atomFuncBody = body (\((relIn):_) -> relationMax (castRelation relIn))},

3333 AtomFunction { atomFuncName = "min",

3434 atomFuncType = foldAtomFuncType intAtomType intAtomType,

35− atomFunc = (\((relIn):_) -> relationMin (castRelation relIn))},

35+ atomFuncBody = body (\((relIn):_) -> relationMin (castRelation relIn))},

3636 AtomFunction { atomFuncName = "lt",

3737 atomFuncType = [intAtomType, intAtomType, boolAtomType],

38− atomFunc = intAtomFuncLessThan False},

38+ atomFuncBody = body $ intAtomFuncLessThan False},

3939 AtomFunction { atomFuncName = "lte",

4040 atomFuncType = [intAtomType, intAtomType, boolAtomType],

41− atomFunc = intAtomFuncLessThan True},

41+ atomFuncBody = body $ intAtomFuncLessThan True},

4242 AtomFunction { atomFuncName = "gte",

4343 atomFuncType = [intAtomType, intAtomType, boolAtomType],

44− atomFunc = boolAtomNot . (:[]) . intAtomFuncLessThan False},

44+ atomFuncBody = body $ boolAtomNot . (:[]) . intAtomFuncLessThan False},

4545 AtomFunction { atomFuncName = "gt",

4646 atomFuncType = [intAtomType, intAtomType, boolAtomType],

47− atomFunc = boolAtomNot . (:[]) . intAtomFuncLessThan True},

47+ atomFuncBody = body $ boolAtomNot . (:[]) . intAtomFuncLessThan True},

4848 AtomFunction { atomFuncName = "not",

4949 atomFuncType = [boolAtomType, boolAtomType],

50− atomFunc = boolAtomNot},

50+ atomFuncBody = body boolAtomNot},

5151 AtomFunction { atomFuncName = "makeByteString",

5252 atomFuncType = [textAtomType, byteStringAtomType],

5353 --I need a proper error-handling scheme for AtomFunctions!

54− atomFunc = \(textIn:_) -> Atom $ (B64.decodeLenient . TE.encodeUtf8) ((unsafeCast textIn)::T.Text) }

54+ atomFuncBody = body $ \(textIn:_) -> Atom $ (B64.decodeLenient . TE.encodeUtf8) ((unsafeCast textIn)::T.Text) }

5555 ]

56+ where

57+ body = AtomFunctionBody Nothing

5658

5759unsafeCast :: (Atomable a) => Atom -> a

5860unsafeCast (ConstructedAtom _ _ _) = error "unsafeCast attempt on ConstructedAtom"

ProjectM36/AtomType.hs+1

@@ -264,3 +264,4 @@ prettyAtomType AnyAtomType = "?AnyAtomType?"

264264

265265prettyAttribute :: Attribute -> T.Text

266266prettyAttribute attr = A.attributeName attr `T.append` "::" `T.append` prettyAtomType (A.atomType attr)

267+

ProjectM36/Base.hs+32−6

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

2525import ProjectM36.ConcreteTypeRep

2626import qualified Data.Text.Encoding as TE

2727import qualified Data.ByteString.Base64 as BS64

28+import Data.Maybe (isJust)

2829

2930type StringType = Text

3031

@@ -347,13 +348,15 @@ data DatabaseContextExpr =

347348 AddTypeConstructor TypeConstructorDef [DataConstructorDef] |

348349 RemoveTypeConstructor TypeConstructorName |

349350

350− -- to implement this, I likely need to implement a DSL for constructing arbitrary functions to operate on atoms at runtime

351− --AddAtomFunction AtomFunction

352− --RemoveAtomFunction AtomFunctionName

351+ --adding an AtomFunction is not a pure operation (required loading GHC modules)

352+ RemoveAtomFunction AtomFunctionName |

353353

354354 MultipleExpr [DatabaseContextExpr]

355355 deriving (Show, Eq, Binary, Generic)

356356

357+-- | Adding an atom function should be nominally a DatabaseExpr except for the fact that it cannot be performed purely. Thus, we create the DatabaseContextIOExpr.

358+data DatabaseContextIOExpr = AddAtomFunction AtomFunctionName [TypeConstructor] AtomFunctionBodyScript

359+ deriving (Show, Eq, Generic, Binary)

357360

358361type DatabaseState a = State DatabaseContext a

359362

@@ -438,22 +441,45 @@ type AtomFunctions = HS.HashSet AtomFunction

438441

439442type AtomFunctionName = StringType

440443

444+type AtomFunctionBodyScript = StringType

445+

446+type AtomFunctionBodyType = [Atom] -> Atom

447+

448+data AtomFunctionBody = AtomFunctionBody (Maybe AtomFunctionBodyScript) AtomFunctionBodyType

449+

450+instance Show AtomFunctionBody where

451+ show (AtomFunctionBody mScript _) = case mScript of

452+ Just script -> show (unpack script)

453+ Nothing -> "<compiled>"

454+

441455-- | An AtomFunction has a name, a type, and a function body to execute when called.

442456data AtomFunction = AtomFunction {

443457 atomFuncName :: AtomFunctionName,

444458 atomFuncType :: [AtomType],

445− atomFunc :: [Atom] -> Atom

459+ atomFuncBody :: AtomFunctionBody

446460 }

447461

448462instance Hashable AtomFunction where

449463 hashWithSalt salt func = salt `hashWithSalt` (atomFuncName func)

450464

451465instance Eq AtomFunction where

452− f1 == f2 = (atomFuncName f1) == (atomFuncName f2)

466+ f1 == f2 = let (AtomFunctionBody mScript1 _) = atomFuncBody f1

467+ (AtomFunctionBody mScript2 _) = atomFuncBody f2 in

468+ if atomFuncName f1 == atomFuncName f2 then

469+ if isJust mScript1 then

470+ if mScript1 == mScript2 then

471+ True

472+ else

473+ False

474+ else

475+ True

476+ else

477+ False

453478

454479instance Show AtomFunction where

455− show aFunc = unpack (atomFuncName aFunc) ++ "::" ++ showArgTypes

480+ show aFunc = unpack (atomFuncName aFunc) ++ "::" ++ showArgTypes ++ "; " ++ body

456481 where

482+ body = show (atomFuncBody aFunc)

457483 showArgTypes = concat (L.intersperse "->" $ map show (atomFuncType aFunc))

458484

459485-- | The 'AttributeNames' structure represents a set of attribute names or the same set of names but inverted in the context of a relational expression. For example, if a relational expression has attributes named "a", "b", and "c", the 'InvertedAttributeNames' of ("a","c") is ("b").

ProjectM36/Client.hs+46−24

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

1010 close,

1111 executeRelationalExpr,

1212 executeDatabaseContextExpr,

13+ executeDatabaseContextIOExpr,

1314 executeGraphExpr,

1415 commit,

1516 rollback,

@@ -64,6 +65,7 @@ import ProjectM36.Persist (DiskSync(..))

6465import ProjectM36.Notifications

6566import ProjectM36.Server.RemoteCallTypes

6667import ProjectM36.Relation (typesAsRelation)

68+import ProjectM36.AtomFunctionBody (initScriptSession, ScriptSession)

6769import qualified ProjectM36.Relation as R

6870import Network.Transport.TCP (createTransport, defaultTCPParameters, encodeEndPointAddress)

6971import Control.Distributed.Process.Node (newLocalNode, initRemoteTable, runProcess, LocalNode, forkProcess)

@@ -137,7 +139,7 @@ defaultRemoteConnectionInfo = RemoteProcessConnectionInfo defaultDatabaseName (c

137139-- | The 'Connection' represents either local or remote access to a database. All operations flow through the connection.

138140type ClientNodes = STMSet.Set ProcessId

139141

140−data Connection = InProcessConnection PersistenceStrategy ClientNodes Sessions (TVar TransactionGraph) |

142+data Connection = InProcessConnection PersistenceStrategy ClientNodes Sessions (TVar TransactionGraph) ScriptSession |

141143 RemoteProcessConnection LocalNode ProcessId

142144

143145-- | There are several reasons why a connection can fail.

@@ -193,7 +195,8 @@ connectProjectM36 (InProcessConnectionInfo strat notificationCallback) = do

193195 clientNodes <- STMSet.newIO

194196 sessions <- STMMap.newIO

195197 notificationPid <- startNotificationListener notificationCallback

196− let conn = InProcessConnection strat clientNodes sessions graphTvar

198+ interpreterSession <- initScriptSession

199+ let conn = InProcessConnection strat clientNodes sessions graphTvar interpreterSession

197200 addClientNode conn notificationPid

198201 pure (Right conn)

199202 MinimalPersistence dbdir -> connectPersistentProjectM36 strat NoDiskSync dbdir freshGraph notificationCallback

@@ -239,21 +242,22 @@ connectPersistentProjectM36 strat sync dbdir freshGraph notificationCallback = d

239242 tvarGraph <- newTVarIO graph'

240243 sessions <- STMMap.newIO

241244 clientNodes <- STMSet.newIO

242− let conn = InProcessConnection strat clientNodes sessions tvarGraph

245+ scriptSession <- initScriptSession

246+ let conn = InProcessConnection strat clientNodes sessions tvarGraph scriptSession

243247 notificationPid <- startNotificationListener notificationCallback

244248 addClientNode conn notificationPid

245249 pure (Right conn)

246250

247251-- | Create a new session at the transaction id and return the session's Id.

248252createSessionAtCommit :: TransactionId -> Connection -> IO (Either RelationalError SessionId)

249−createSessionAtCommit commitId conn@(InProcessConnection _ _ _ _) = do

253+createSessionAtCommit commitId conn@(InProcessConnection _ _ _ _ _) = do

250254 newSessionId <- nextRandom

251255 atomically $ do

252256 createSessionAtCommit_ commitId newSessionId conn

253257createSessionAtCommit uuid conn@(RemoteProcessConnection _ _) = remoteCall conn (CreateSessionAtCommit uuid)

254258

255259createSessionAtCommit_ :: TransactionId -> SessionId -> Connection -> STM (Either RelationalError SessionId)

256−createSessionAtCommit_ commitId newSessionId (InProcessConnection _ _ sessions graphTvar) = do

260+createSessionAtCommit_ commitId newSessionId (InProcessConnection _ _ sessions graphTvar _) = do

257261 graph <- readTVar graphTvar

258262 case transactionForId commitId graph of

259263 Left err -> pure (Left err)

@@ -269,7 +273,7 @@ createSessionAtCommit_ _ _ (RemoteProcessConnection _ _) = error "createSessionA

269273

270274-- | Call 'createSessionAtHead' with a transaction graph's head's name to create a new session pinned to that head. This function returns a 'SessionId' which can be used in other function calls to reference the point in the transaction graph.

271275createSessionAtHead :: HeadName -> Connection -> IO (Either RelationalError SessionId)

272−createSessionAtHead headn conn@(InProcessConnection _ _ _ graphTvar) = do

276+createSessionAtHead headn conn@(InProcessConnection _ _ _ graphTvar _) = do

273277 newSessionId <- nextRandom

274278 atomically $ do

275279 graph <- readTVar graphTvar

@@ -281,16 +285,16 @@ createSessionAtHead headn conn@(RemoteProcessConnection _ _) = remoteCall conn (

281285-- | Used internally for server connections to keep track of remote nodes for the purpose of sending notifications later.

282286addClientNode :: Connection -> ProcessId -> IO ()

283287addClientNode (RemoteProcessConnection _ _) _ = error "addClientNode called on remote connection"

284−addClientNode (InProcessConnection _ clientNodes _ _) newProcessId = atomically (STMSet.insert newProcessId clientNodes)

288+addClientNode (InProcessConnection _ clientNodes _ _ _) newProcessId = atomically (STMSet.insert newProcessId clientNodes)

285289

286290-- | Discards a session, eliminating any uncommitted changes present in the session.

287291closeSession :: SessionId -> Connection -> IO ()

288−closeSession sessionId (InProcessConnection _ _ sessions _) = do

292+closeSession sessionId (InProcessConnection _ _ sessions _ _) = do

289293 atomically $ STMMap.delete sessionId sessions

290294closeSession sessionId conn@(RemoteProcessConnection _ _) = remoteCall conn (CloseSession sessionId)

291295-- | 'close' cleans up the database access connection. Note that sessions persist even after the connection is closed.

292296close :: Connection -> IO ()

293−close (InProcessConnection _ _ sessions _) = atomically $ do

297+close (InProcessConnection _ _ sessions _ _) = atomically $ do

294298 traverse_ (\(k,_) -> STMMap.delete k sessions) (STMMap.stream sessions)

295299 pure ()

296300

@@ -307,7 +311,7 @@ runProcessResult localNode proc = do

307311 takeMVar ret

308312

309313remoteCall :: (Serializable a, Serializable b) => Connection -> a -> IO b

310−remoteCall (InProcessConnection _ _ _ _) _ = error "remoteCall called on local connection"

314+remoteCall (InProcessConnection _ _ _ _ _) _ = error "remoteCall called on local connection"

311315remoteCall (RemoteProcessConnection localNode serverProcessId) arg = runProcessResult localNode $ do

312316 ret <- safeCall serverProcessId arg

313317 case ret of

@@ -321,7 +325,7 @@ sessionForSessionId sessionId sessions = do

321325

322326-- | Execute a relational expression in the context of the session and connection. Relational expressions are queries and therefore cannot alter the database.

323327executeRelationalExpr :: SessionId -> Connection -> RelationalExpr -> IO (Either RelationalError Relation)

324−executeRelationalExpr sessionId (InProcessConnection _ _ sessions _) expr = atomically $ do

328+executeRelationalExpr sessionId (InProcessConnection _ _ sessions _ _) expr = atomically $ do

325329 eSession <- sessionForSessionId sessionId sessions

326330 case eSession of

327331 Left err -> pure $ Left err

@@ -330,7 +334,7 @@ executeRelationalExpr sessionId conn@(RemoteProcessConnection _ _) relExpr = rem

330334

331335-- | Execute a database context expression in the context of the session and connection. Database expressions modify the current session's disconnected transaction but cannot modify the transaction graph.

332336executeDatabaseContextExpr :: SessionId -> Connection -> DatabaseContextExpr -> IO (Maybe RelationalError)

333−executeDatabaseContextExpr sessionId (InProcessConnection _ _ sessions _) expr = atomically $ do

337+executeDatabaseContextExpr sessionId (InProcessConnection _ _ sessions _ _) expr = atomically $ do

334338 eSession <- sessionForSessionId sessionId sessions

335339 case eSession of

336340 Left err -> pure $ Just err

@@ -342,6 +346,24 @@ executeDatabaseContextExpr sessionId (InProcessConnection _ _ sessions _) expr =

342346 STMMap.insert newSession sessionId sessions

343347 return Nothing

344348executeDatabaseContextExpr sessionId conn@(RemoteProcessConnection _ _) dbExpr = remoteCall conn (ExecuteDatabaseContextExpr sessionId dbExpr)

349+

350+-- | Execute a database context IO-monad-based expression for the given session and connection. `DatabaseContextIOExpr` modify the DatabaseContext but cannot be purely implemented.

351+--this is almost completely identical to executeDatabaseContextExpr above

352+executeDatabaseContextIOExpr :: SessionId -> Connection -> DatabaseContextIOExpr -> IO (Maybe RelationalError)

353+executeDatabaseContextIOExpr sessionId (InProcessConnection _ _ sessions _ scriptSession) expr = do

354+ eSession <- atomically $ sessionForSessionId sessionId sessions --potentially race condition due to interleaved IO?

355+ case eSession of

356+ Left err -> pure $ Just err

357+ Right session -> do

358+ res <- RE.evalDatabaseContextIOExpr scriptSession (sessionContext session) expr

359+ case res of

360+ Left err -> pure (Just err)

361+ Right context' -> do

362+ let newDiscon = DisconnectedTransaction (sessionParentId session) context'

363+ newSession = Session newDiscon

364+ atomically $ STMMap.insert newSession sessionId sessions

365+ pure Nothing

366+executeDatabaseContextIOExpr sessionId conn@(RemoteProcessConnection _ _) dbExpr = remoteCall conn (ExecuteDatabaseContextIOExpr sessionId dbExpr)

345367

346368executeGraphExprSTM_ :: TransactionId -> SessionId -> Sessions -> TransactionGraphOperator -> TVar TransactionGraph -> STM (Either RelationalError TransactionGraph)

347369executeGraphExprSTM_ freshId sessionId sessions graphExpr graphTvar = do

@@ -369,7 +391,7 @@ executeCommitExprSTM_ oldContext newContext nodes = do

369391

370392-- | Execute a transaction graph expression in the context of the session and connection. Transaction graph operators modify the transaction graph state.

371393executeGraphExpr :: SessionId -> Connection -> TransactionGraphOperator -> IO (Maybe RelationalError)

372−executeGraphExpr sessionId (InProcessConnection strat clientNodes sessions graphTvar) graphExpr = do

394+executeGraphExpr sessionId (InProcessConnection strat clientNodes sessions graphTvar _) graphExpr = do

373395 freshId <- nextRandom

374396 manip <- atomically $ do

375397 eSession <- sessionForSessionId sessionId sessions

@@ -411,7 +433,7 @@ commitSTM_ freshUUID sessionId sessions graph = do

411433

412434-- | After modifying a session, 'commit' the transaction to the transaction graph at the head which the session is referencing. This will also trigger checks for any notifications which need to be propagated.

413435commit :: SessionId -> Connection -> IO (Maybe RelationalError)

414−commit sessionId conn@(InProcessConnection _ _ _ _) = executeGraphExpr sessionId conn Commit

436+commit sessionId conn@(InProcessConnection _ _ _ _ _) = executeGraphExpr sessionId conn Commit

415437commit sessionId conn@(RemoteProcessConnection _ _) = remoteCall conn (ExecuteGraphExpr sessionId Commit)

416438

417439sendNotifications :: [ProcessId] -> EvaluatedNotifications -> IO ()

@@ -425,7 +447,7 @@ sendNotifications pids nots = mapM_ sendNots pids

425447

426448-- | Discard any changes made in the current session. This resets the disconnected transaction to reference the original database context of the parent transaction and is a very cheap operation.

427449rollback :: SessionId -> Connection -> IO (Maybe RelationalError)

428−rollback sessionId conn@(InProcessConnection _ _ _ _) = executeGraphExpr sessionId conn Rollback

450+rollback sessionId conn@(InProcessConnection _ _ _ _ _) = executeGraphExpr sessionId conn Rollback

429451rollback sessionId conn@(RemoteProcessConnection _ _) = remoteCall conn (ExecuteGraphExpr sessionId Rollback)

430452

431453processPersistence :: PersistenceStrategy -> TransactionGraph -> IO ()

@@ -435,11 +457,11 @@ processPersistence (CrashSafePersistence dbdir) graph = transactionGraphPersist

435457

436458-- | Return a relation whose type would match that of the relational expression if it were executed. This is useful for checking types and validating a relational expression's types.

437459typeForRelationalExpr :: SessionId -> Connection -> RelationalExpr -> IO (Either RelationalError Relation)

438−typeForRelationalExpr sessionId conn@(InProcessConnection _ _ _ _) relExpr = atomically $ typeForRelationalExprSTM sessionId conn relExpr

460+typeForRelationalExpr sessionId conn@(InProcessConnection _ _ _ _ _) relExpr = atomically $ typeForRelationalExprSTM sessionId conn relExpr

439461typeForRelationalExpr sessionId conn@(RemoteProcessConnection _ _) relExpr = remoteCall conn (ExecuteTypeForRelationalExpr sessionId relExpr)

440462

441463typeForRelationalExprSTM :: SessionId -> Connection -> RelationalExpr -> STM (Either RelationalError Relation)

442−typeForRelationalExprSTM sessionId (InProcessConnection _ _ sessions _) relExpr = do

464+typeForRelationalExprSTM sessionId (InProcessConnection _ _ sessions _ _) relExpr = do

443465 eSession <- sessionForSessionId sessionId sessions

444466 case eSession of

445467 Left err -> pure $ Left err

@@ -449,7 +471,7 @@ typeForRelationalExprSTM _ _ _ = error "typeForRelationalExprSTM called on non-l

449471

450472-- | Return a 'Map' of the database's constraints at the context of the session and connection.

451473inclusionDependencies :: SessionId -> Connection -> IO (Either RelationalError (M.Map IncDepName InclusionDependency))

452−inclusionDependencies sessionId (InProcessConnection _ _ sessions _) = do

474+inclusionDependencies sessionId (InProcessConnection _ _ sessions _ _) = do

453475 atomically $ do

454476 eSession <- sessionForSessionId sessionId sessions

455477 case eSession of

@@ -460,7 +482,7 @@ inclusionDependencies sessionId conn@(RemoteProcessConnection _ _) = remoteCall

460482

461483-- | Return an optimized database expression which is logically equivalent to the input database expression. This function can be used to determine which expression will actually be evaluated.

462484planForDatabaseContextExpr :: SessionId -> Connection -> DatabaseContextExpr -> IO (Either RelationalError DatabaseContextExpr)

463−planForDatabaseContextExpr sessionId (InProcessConnection _ _ sessions _) dbExpr = do

485+planForDatabaseContextExpr sessionId (InProcessConnection _ _ sessions _ _) dbExpr = do

464486 atomically $ do

465487 eSession <- sessionForSessionId sessionId sessions

466488 case eSession of

@@ -474,7 +496,7 @@ planForDatabaseContextExpr sessionId conn@(RemoteProcessConnection _ _) dbExpr =

474496-- * id- id attribute of the transaction

475497-- * parents- a relation-valued attribute which contains a relation of transaction ids which are parent transaction to the transaction

476498transactionGraphAsRelation :: SessionId -> Connection -> IO (Either RelationalError Relation)

477−transactionGraphAsRelation sessionId (InProcessConnection _ _ sessions tvar) = do

499+transactionGraphAsRelation sessionId (InProcessConnection _ _ sessions tvar _) = do

478500 atomically $ do

479501 eSession <- sessionForSessionId sessionId sessions

480502 case eSession of

@@ -486,7 +508,7 @@ transactionGraphAsRelation sessionId (InProcessConnection _ _ sessions tvar) = d

486508transactionGraphAsRelation sessionId conn@(RemoteProcessConnection _ _) = remoteCall conn (RetrieveTransactionGraph sessionId)

487509

488510relationVariablesAsRelation :: SessionId -> Connection -> IO (Either RelationalError Relation)

489−relationVariablesAsRelation sessionId (InProcessConnection _ _ sessions _) = do

511+relationVariablesAsRelation sessionId (InProcessConnection _ _ sessions _ _) = do

490512 atomically $ do

491513 eSession <- sessionForSessionId sessionId sessions

492514 case eSession of

@@ -497,7 +519,7 @@ relationVariablesAsRelation sessionId conn@(RemoteProcessConnection _ _) = remot

497519

498520-- | Returns the transaction id for the connection's disconnected transaction committed parent transaction.

499521headTransactionId :: SessionId -> Connection -> IO (Maybe TransactionId)

500−headTransactionId sessionId (InProcessConnection _ _ sessions _) = do

522+headTransactionId sessionId (InProcessConnection _ _ sessions _ _) = do

501523 atomically $ do

502524 eSession <- sessionForSessionId sessionId sessions

503525 case eSession of

@@ -517,12 +539,12 @@ headNameSTM_ sessionId sessions graphTvar = do

517539

518540-- | Returns Just the name of the head of the current disconnected transaction or Nothing.

519541headName :: SessionId -> Connection -> IO (Maybe HeadName)

520−headName sessionId (InProcessConnection _ _ sessions graphTvar) = do

542+headName sessionId (InProcessConnection _ _ sessions graphTvar _) = do

521543 atomically (headNameSTM_ sessionId sessions graphTvar)

522544headName sessionId conn@(RemoteProcessConnection _ _) = remoteCall conn (ExecuteHeadName sessionId)

523545

524546atomTypesAsRelation :: SessionId -> Connection -> IO (Either RelationalError Relation)

525−atomTypesAsRelation sessionId (InProcessConnection _ _ sessions _) = do

547+atomTypesAsRelation sessionId (InProcessConnection _ _ sessions _ _) = do

526548 atomically $ do

527549 eSession <- sessionForSessionId sessionId sessions

528550 case eSession of

ProjectM36/DataTypes/Day.hs+3−3

@@ -1,12 +1,12 @@

11module ProjectM36.DataTypes.Day where

22import ProjectM36.Base

3+import ProjectM36.AtomFunctionBody

34import ProjectM36.DataTypes.Primitive

45import ProjectM36.AtomFunctions.Primitive

56import qualified Data.HashSet as HS

67import Data.Time.Calendar

78import qualified Data.Map as M

9−

1010dayAtom :: Day -> Atom

1111dayAtom d = Atom d

1212

@@ -17,11 +17,11 @@ dayAtomFunctions :: AtomFunctions

1717dayAtomFunctions = HS.fromList [

1818 AtomFunction { atomFuncName = "fromGregorian",

1919 atomFuncType = [intAtomType, intAtomType, intAtomType, dayAtomType],

20− atomFunc = \(year:month:day:_) -> ConstructedAtom "Day" dayAtomType [Atom (fromGregorian (fromIntegral (unsafeCast year::Int)) (unsafeCast month) (unsafeCast day))]

20+ atomFuncBody = compiledAtomFunctionBody $ \(year:month:day:_) -> ConstructedAtom "Day" dayAtomType [Atom (fromGregorian (fromIntegral (unsafeCast year::Int)) (unsafeCast month) (unsafeCast day))]

2121 },

2222 AtomFunction { atomFuncName = "dayEarlierThan",

2323 atomFuncType = [dayAtomType, dayAtomType, boolAtomType],

24− atomFunc = \((ConstructedAtom _ _ (dayA:_)):(ConstructedAtom _ _ (dayB:_)):_) -> Atom (unsafeCast dayA < (unsafeCast dayB :: Day))

24+ atomFuncBody = compiledAtomFunctionBody $ \((ConstructedAtom _ _ (dayA:_)):(ConstructedAtom _ _ (dayB:_)):_) -> Atom (unsafeCast dayA < (unsafeCast dayB :: Day))

2525 }

2626 ]

2727

ProjectM36/DataTypes/Either.hs+2−4

@@ -1,6 +1,7 @@

11module ProjectM36.DataTypes.Either where

22import ProjectM36.Base

33import ProjectM36.DataTypes.Primitive

4+import ProjectM36.AtomFunction

45import qualified Data.HashSet as HS

56import qualified Data.Map as M

@@ -14,8 +15,5 @@ eitherTypeConstructorMapping = [(ADTypeConstructorDef "Either" ["a", "b"],

1415

1516eitherAtomFunctions :: AtomFunctions

1617eitherAtomFunctions = HS.fromList [

17− AtomFunction { atomFuncName = "isLeft",

18− atomFuncType = [eitherAtomType AnyAtomType AnyAtomType, boolAtomType],

19− atomFunc = \((ConstructedAtom dConsName _ _):_) -> Atom (dConsName == "Left")

20− }

18+ compiledAtomFunction "isLeft" [eitherAtomType AnyAtomType AnyAtomType, boolAtomType] $ \((ConstructedAtom dConsName _ _):_) -> Atom (dConsName == "Left")

2119 ]

ProjectM36/DataTypes/Maybe.hs+1−1

@@ -18,6 +18,6 @@ maybeAtomFunctions = HS.fromList [

1818 AtomFunction {

1919 atomFuncName ="isJust",

2020 atomFuncType = [maybeAtomType AnyAtomType, boolAtomType],

21− atomFunc = \((ConstructedAtom dConsName _ _):_) -> Atom (dConsName == "Nothing")

21+ atomFuncBody = AtomFunctionBody Nothing $ \((ConstructedAtom dConsName _ _):_) -> Atom (dConsName == "Nothing")

2222 }

2323 ]

ProjectM36/Error.hs+10−1

@@ -53,6 +53,8 @@ data RelationalError = NoSuchAttributeNamesError (S.Set AttributeName)

5353 | AtomTypeNameInUseError AtomTypeName

5454 | IncompletelyDefinedAtomTypeWithConstructorError

5555 | AtomTypeNameNotInUseError AtomTypeName

56+ | AtomFunctionNameInUseError AtomFunctionName

57+ | AtomFunctionNameNotInUseError AtomFunctionName

5658 | NoSuchDataConstructorError DataConstructorName

5759 | NoSuchTypeConstructorError TypeConstructorName

5860 | InvalidAtomTypeName AtomTypeName

@@ -67,6 +69,7 @@ data RelationalError = NoSuchAttributeNamesError (S.Set AttributeName)

6769 | ImportError T.Text -- really? This should be broken out into some other error type- this has nothing to do with relational algebra

6870 | ExportError T.Text

6971 | MergeTransactionError MergeError

72+ | AtomFunctionBodyScriptError AtomFunctionBodyCompilationError

7073 | MultipleErrors [RelationalError]

7174 deriving (Show,Eq,Generic,Binary,Typeable)

7275

@@ -94,4 +97,10 @@ data MergeError = SelectedHeadMismatchMergeError |

9497 StrategyViolatesTypeConstructorMergeError

9598 deriving (Show, Eq, Generic, Binary, Typeable)

9699

97−instance NFData MergeError where rnf = genericRnf

100+instance NFData MergeError where rnf = genericRnf

101+

102+data AtomFunctionBodyCompilationError = TypeCheckCompilationError String String | --expected, got

103+ SyntaxErrorCompilationError String |

104+ OtherScriptCompilationError String

105+ deriving (Show,Eq, Generic, Binary, Typeable, NFData)

106+

ProjectM36/RelationalExpression.hs+48−3

@@ -1,3 +1,4 @@

1+{-# LANGUAGE ScopedTypeVariables #-}

12module ProjectM36.RelationalExpression where

23import ProjectM36.Relation

34import ProjectM36.Tuple

@@ -5,19 +6,24 @@ import ProjectM36.TupleSet

56import ProjectM36.Base

67import ProjectM36.Error

78import ProjectM36.AtomType

9+import ProjectM36.AtomFunctionBody

810import ProjectM36.DataTypes.Primitive

911import ProjectM36.AtomFunction

1012import qualified ProjectM36.Attribute as A

1113import qualified Data.Map as M

1214import qualified Data.HashSet as HS

1315import Control.Monad.State hiding (join)

16+import Control.Exception

1417import Data.Maybe

1518import Data.Either

1619import Data.Char (isUpper)

1720import qualified Data.Text as T

1821import qualified Data.Vector as V

1922import qualified ProjectM36.TypeConstructorDef as TCD

20−import Debug.Trace

23+

24+import GHC

25+import GHC.Paths

26+--import Debug.Trace

2127

2228--relvar state is needed in evaluation of relational expression but only as read-only in order to extract current relvar values

2329evalRelationalExpr :: RelationalExpr -> DatabaseState (Either RelationalError Relation)

@@ -321,6 +327,45 @@ evalContextExpr (MultipleExpr exprs) = do

321327 case catMaybes evald of

322328 [] -> return $ Nothing

323329 err:_ -> return $ Just err

330+

331+evalContextExpr (RemoveAtomFunction funcName) = do

332+ currentContext <- get

333+ let atomFuncs = atomFunctions currentContext

334+ dudFunc = emptyAtomFunction funcName -- just for lookup in the hashset

335+ if HS.member dudFunc atomFuncs then do

336+ let updatedFuncs = HS.delete dudFunc atomFuncs

337+ put (currentContext {atomFunctions = updatedFuncs })

338+ pure Nothing

339+ else

340+ pure (Just (AtomFunctionNameNotInUseError funcName))

341+

342+evalDatabaseContextIOExpr :: HscEnv -> DatabaseContext -> DatabaseContextIOExpr -> IO (Either RelationalError DatabaseContext)

343+evalDatabaseContextIOExpr hscEnv currentContext (AddAtomFunction funcName funcType script) = do

344+ res <- try $ runGhc (Just libdir) $ do

345+ setSession hscEnv

346+ let atomFuncs = atomFunctions currentContext

347+ --compile the function

348+ eCompiledFunc <- compileAtomFunctionScript script

349+ pure $ case eCompiledFunc of

350+ Left err -> Left (AtomFunctionBodyScriptError err)

351+ Right compiledFunc -> do

352+ funcAtomType <- mapM (\funcTypeArg -> atomTypeForTypeConstructor funcTypeArg (typeConstructorMapping currentContext)) funcType

353+ let updatedFuncs = HS.insert newAtomFunc atomFuncs

354+ newContext = currentContext { atomFunctions = updatedFuncs }

355+ newAtomFunc = AtomFunction { atomFuncName = funcName,

356+ atomFuncType = funcAtomType,

357+ atomFuncBody = AtomFunctionBody (Just script) compiledFunc }

358+

359+ -- check if the name is already in use

360+ if HS.member newAtomFunc atomFuncs then

361+ Left (AtomFunctionNameInUseError funcName)

362+ else do

363+ Right newContext

364+ case res of

365+ Left (exc :: SomeException) -> pure $ Left (AtomFunctionBodyScriptError (OtherScriptCompilationError (show exc)))

366+ Right eContext -> case eContext of

367+ Left err -> pure (Left err)

368+ Right context' -> pure (Right context')

324369

325370updateTupleWithAtomExprs :: (M.Map AttributeName AtomExpr) -> DatabaseContext -> RelationTuple -> Either RelationalError RelationTuple

326371updateTupleWithAtomExprs exprMap context tupIn = do

@@ -460,7 +505,7 @@ evalAtomExpr tupIn context (FunctionAtomExpr funcName arguments) = do

460505 argTypes <- mapM (typeFromAtomExpr (tupleAttributes tupIn) context) arguments

461506 _ <- mapM (uncurry atomTypeVerify) $ init (zip (atomFuncType func) argTypes)

462507 evaldArgs <- mapM (evalAtomExpr tupIn context) arguments

463− return $ (atomFunc func) evaldArgs

508+ return $ (evalAtomFunction func) evaldArgs

464509evalAtomExpr _ context (RelationAtomExpr relExpr) = do

465510 relAtom <- evalState (evalRelationalExpr relExpr) context

466511 return $ Atom relAtom

@@ -536,7 +581,7 @@ evalTupleExpr context attrs (TupleExpr tupMap) = do

536581 tConss = typeConstructorMapping context

537582 finalAttrs = fromMaybe tupAttrs attrs

538583 --verify that the attributes match

539− when (A.attributeNameSet finalAttrs /= A.attributeNameSet tupAttrs) (traceShow (finalAttrs,tupAttrs) $ Left (TupleAttributeTypeMismatchError tupAttrs))

584+ when (A.attributeNameSet finalAttrs /= A.attributeNameSet tupAttrs) $ Left (TupleAttributeTypeMismatchError tupAttrs)

540585 tup' <- resolveTypesInTuple finalAttrs (reorderTuple finalAttrs tup)

541586 _ <- validateTuple tup' tConss

542587 pure tup'

ProjectM36/Server.hs+1

@@ -23,6 +23,7 @@ serverDefinition = defaultProcess {

2323 handleCall (\conn (ExecuteHeadName sessionId) -> handleExecuteHeadName sessionId conn),

2424 handleCall (\conn (ExecuteRelationalExpr sessionId expr) -> handleExecuteRelationalExpr sessionId conn expr),

2525 handleCall (\conn (ExecuteDatabaseContextExpr sessionId expr) -> handleExecuteDatabaseContextExpr sessionId conn expr),

26+ handleCall (\conn (ExecuteDatabaseContextIOExpr sessionId expr) -> handleExecuteDatabaseContextIOExpr sessionId conn expr),

2627 handleCall (\conn (ExecuteGraphExpr sessionId expr) -> handleExecuteGraphExpr sessionId conn expr),

2728 handleCall (\conn (ExecuteTypeForRelationalExpr sessionId expr) -> handleExecuteTypeForRelationalExpr sessionId conn expr),

2829 handleCall (\conn (RetrieveInclusionDependencies sessionId) -> handleRetrieveInclusionDependencies sessionId conn),

ProjectM36/Server/EntryPoints.hs+5

@@ -18,6 +18,11 @@ handleExecuteDatabaseContextExpr sessionId conn dbexpr = do

1818 ret <- liftIO $ executeDatabaseContextExpr sessionId conn dbexpr

1919 reply ret conn

2020

21+handleExecuteDatabaseContextIOExpr :: SessionId -> Connection -> DatabaseContextIOExpr -> Process (ProcessReply (Maybe RelationalError) Connection)

22+handleExecuteDatabaseContextIOExpr sessionId conn dbexpr = do

23+ ret <- executeDatabaseContextIOExpr sessionId conn dbexpr

24+ reply ret conn

25+

2126handleExecuteHeadName :: SessionId -> Connection -> Process (ProcessReply (Maybe HeadName) Connection)

2227handleExecuteHeadName sessionId conn = do

2328 ret <- liftIO $ headName sessionId conn

ProjectM36/Server/RemoteCallTypes.hs+2

@@ -17,6 +17,8 @@ data ExecuteRelationalExpr = ExecuteRelationalExpr SessionId RelationalExpr

1717 deriving (Binary, Generic)

1818data ExecuteDatabaseContextExpr = ExecuteDatabaseContextExpr SessionId DatabaseContextExpr

1919 deriving (Binary, Generic)

20+data ExecuteDatabaseContextIOExpr = ExecuteDatabaseContextIOExpr SessionId DatabaseContextIOExpr

21+ deriving (Binary, Generic)

2022data ExecuteGraphExpr = ExecuteGraphExpr SessionId TransactionGraphOperator

2123 deriving (Binary, Generic)

2224data ExecuteHeadName = ExecuteHeadName SessionId

ProjectM36/StaticOptimizer.hs+1

@@ -153,6 +153,7 @@ applyStaticDatabaseOptimization notif@(RemoveNotification _) = pure (Right notif

153153

154154applyStaticDatabaseOptimization c@(AddTypeConstructor _ _) = pure (Right c)

155155applyStaticDatabaseOptimization c@(RemoveTypeConstructor _) = pure (Right c)

156+applyStaticDatabaseOptimization c@(RemoveAtomFunction _) = pure (Right c)

156157

157158--optimization: from pgsql lists- check for join condition referencing foreign key- if join projection project away the referenced table, then it does not need to be scanned

158159

TutorialD/Interpreter.hs+13−1

@@ -5,6 +5,7 @@ import TutorialD.Interpreter.RODatabaseContextOperator

55import TutorialD.Interpreter.DatabaseContextExpr

66import TutorialD.Interpreter.TransactionGraphOperator

77import TutorialD.Interpreter.InformationOperator

8+import TutorialD.Interpreter.DatabaseContextIOOperator

910import TutorialD.Interpreter.Import.CSV

1011import TutorialD.Interpreter.Import.TutorialD

@@ -36,6 +37,7 @@ graph ops are read-write operations which change the transaction graph

3637-}

3738data ParsedOperation = RODatabaseContextOp RODatabaseContextOperator |

3839 DatabaseContextExprOp DatabaseContextExpr |

40+ DatabaseContextIOExprOp DatabaseContextIOExpr |

3941 InfoOp InformationOperator |

4042 GraphOp TransactionGraphOperator |

4143 ROGraphOp ROTransactionGraphOperator |

@@ -48,7 +50,8 @@ interpreterParserP :: Parser ParsedOperation

4850interpreterParserP = safeInterpreterParserP <|>

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

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

51− liftM RelVarExportOp (exportCSVP <* eof)

53+ liftM RelVarExportOp (exportCSVP <* eof) <|>

54+ liftM DatabaseContextIOExprOp (parseCreateAtomFunctionExpr <* eof)

5255

5356-- the safe interpreter never reads or writes the file system

5457safeInterpreterParserP :: Parser ParsedOperation

@@ -88,6 +91,15 @@ evalTutorialD sessionId conn safe expr = case expr of

8891 case maybeErr of

8992 Just err -> barf err

9093 Nothing -> return QuietSuccessResult

94+

95+ (DatabaseContextIOExprOp execOp) -> do

96+ if needsSafe then

97+ unsafeError

98+ else do

99+ mErr <- C.executeDatabaseContextIOExpr sessionId conn execOp

100+ case mErr of

101+ Just err -> barf err

102+ Nothing -> pure QuietSuccessResult

91103

92104 (GraphOp execOp) -> do

93105 maybeErr <- C.executeGraphExpr sessionId conn execOp

TutorialD/Interpreter/Base.hs+3

@@ -47,6 +47,9 @@ comma = Token.comma lexer

4747pipe :: Parser String

4848pipe = Token.symbol lexer "|"

4949

50+arrow :: Parser String

51+arrow = Token.symbol lexer "->"

52+

5053semi :: Parser String

5154semi = Token.semi lexer

5255

project-m36.cabal+14−1

@@ -13,6 +13,8 @@ Description: A relational algebra engine which can be used to persist and query

1313

1414Library

1515 Build-Depends: base>=4.8 && < 4.9

16+ ,ghc >= 7.8 && <= 8.0.1

17+ ,ghc-paths

1618 ,mtl

1719 ,containers

1820 ,unordered-containers

@@ -121,9 +123,12 @@ Library

121123

122124Executable tutd

123125 Build-Depends: base >=4.8 && <4.9,

126+ ghc >= 7.8 && <= 8.0.1,

127+ ghc-paths,

124128 containers,

125129 unordered-containers,

126130 hashable,

131+ transformers,

127132 mtl,

128133 uuid,

129134 deepseq-generics,

@@ -217,6 +222,7 @@ Executable tutd

217222 TutorialD.Interpreter.Types

218223 main-is: TutorialD/tutd.hs

219224 CPP-Options: -DPROJECTM36_VERSION="v0.1"

225+ CC-Options: -fPIC

220226 GHC-Options: -Wall

221227 Default-Language: Haskell2010

222228 Default-Extensions: OverloadedStrings

@@ -630,7 +636,14 @@ Test-Suite test-scripts

630636 else

631637 C-sources: ProjectM36/DirectoryFsync.c

632638 Build-Depends: unix

633−

639+

640+Executable dud

641+ Default-Language: Haskell2010

642+ Build-Depends: ghc >= 7.8 && <= 8.0.1, base, ghc-paths, mtl, haskeline

643+ Main-Is: test.hs

644+ GHC-Options: -Wall

645+ CPP-Options: -DGHCI

646+

634647Executable project-m36-websocket-server

635648 Default-Language: Haskell2010

636649 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