project-m36 1.2.5 → 1.2.6

raw patch · 15 files changed

+781/−443 lines, 15 filesdep +th-lift-instancesdep ~aesondep ~basedep ~base16-bytestringnew-component:exe:Example-TutorialDInlinePVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependencies added: th-lift-instances

Dependency ranges changed: aeson, base, base16-bytestring, cassava, curryer-rpc, ghc, megaparsec, stm-containers, streamly, uuid, winery

API changes (from Hackage documentation)

Files

• Changelog.markdown +4/−0
• README.markdown +1/−0
• examples/tutd-inline.hs +44/−0
• project-m36.cabal +165/−157
• src/bin/ProjectM36/Cli.hs +0/−177
• src/bin/ProjectM36/Interpreter.hs +0/−60
• src/bin/TutorialD/Interpreter/Base.hs +1/−33
• src/bin/TutorialD/Interpreter/Import/BasicExamples.hs +0/−5
• src/bin/TutorialD/Interpreter/RelationalExpr.hs +0/−5
• src/bin/TutorialD/Interpreter/Template.hs +285/−0
• src/lib/ProjectM36/Cli.hs +177/−0
• src/lib/ProjectM36/Interpreter.hs +60/−0
• src/lib/ProjectM36/RelationalExpression.hs +4/−1
• src/lib/ProjectM36/TransactionGraph.hs +0/−5
• test/TutorialD/Interpreter/TemplateTest.hs +40/−0

@@ -1,3 +1,7 @@+# 2026-03-01 (v1.2.6)++* add support for inlining TutorialD expressions in Haskell using Quasiquoters+ # 2026-02-22 (v1.2.5)  * include GHC in docker image so that users can use the new Haskell module functionality

@@ -100,6 +100,7 @@ 1. [Merkle Transaction Hashes](docs/merkle_transaction_graph.markdown) 1. [Handling DDL Changes](docs/Handling_DDL_Changes.markdown) 1. [Importing a Haskell Module](docs/import_haskell_module.markdown)+1. [TutorialD Inline with Haskell](docs/inline_tutoriald.markdown)  ### Integrations 

@@ -0,0 +1,44 @@+{-# LANGUAGE QuasiQuotes #-}+import TutorialD.Interpreter.Template+import ProjectM36.Client+import ProjectM36.DatabaseContextExpr+import ProjectM36.DatabaseContext+import ProjectM36.DateExamples+import ProjectM36.TransactionGraph+import System.Random++main :: IO ()+main = do+  rando <- initStdGen++  conn <- failFast $ connectProjectM36 (InProcessConnectionInfo NoPersistence emptyNotificationCallback [] basicDatabaseContext rando "admin")++  sessionId <- failFast $ createSessionAtHead conn "master"++  -- add Date relvars+  case databaseContextAsDatabaseContextExpr (toDatabaseContext dateExamples) emptyTransactionGraph of+    Left err -> error (show err) +    Right dbexpr -> do+      failFast $ executeDatabaseContextExpr sessionId conn dbexpr++  let london_suppliers =+        replaceTextAtom "$1" "London" [relationalExpr|s where city="$1"|]++  _res <- failFast $ executeRelationalExpr sessionId conn london_suppliers++  let notlondon =+        case london_suppliers of+          Restrict yeslondon@(AttributeEqualityPredicate "city" "London") relExpr ->+            Restrict (NotPredicate yeslondon) relExpr+++  let insert_adelaide = [databaseContextExpr|insert s relation{tuple{city "adelaide", s# "S6", sname "Jacobs", status 10}}|]+      insert_adelaide' = replaceTextAtom "Jacobs" "Jacks" insert_adelaide+  failFast $ executeDatabaseContextExpr sessionId conn insert_adelaide'+  +failFast :: Show a => IO (Either a b) -> IO b+failFast m = do+  ret <- m+  case ret of+    Left err -> error (show err)+    Right val -> pure val

@@ -1,6 +1,6 @@-Cabal-Version: 2.2+Cabal-Version: 3.0 Name: project-m36-Version: 1.2.5+Version: 1.2.6 License: MIT --note that this license specification is erroneous and only labeled MIT to appease hackage which does not recognize public domain packages in cabal >2.2- Project:M36 is dedicated to the public domain Build-Type: Simple@@ -113,7 +113,8 @@                   data-default,                   process,                   system-linux-proc,-                  megaparsec +                  megaparsec,+                  haskeline     if flag(haskell-scripting)         Build-Depends: ghc >= 9.0         CPP-Options: -DPM36_HASKELL_SCRIPTING@@ -251,7 +252,9 @@                      ProjectM36.AccessControl,                      ProjectM36.LoginRoles,                      ProjectM36.PrettyBytes,-                     ProjectM36.Module+                     ProjectM36.Module,+                     ProjectM36.Interpreter,+                     ProjectM36.Cli     GHC-Options: -Wall -rdynamic     if os(windows)       Build-Depends: Win32 >= 2.12@@ -268,14 +271,98 @@     Default-Language: Haskell2010     Default-Extensions: OverloadedStrings, CPP, LambdaCase     if !flag(stack)-      Build-Depends: deferred-folds +      Build-Depends: deferred-folds +Library project-m36-tutoriald+    Visibility: public+    Default-Language: Haskell2010    +    Build-Depends:+        project-m36,+        text,+        base,+        modern-uri,+        MonadRandom,+        megaparsec,+        curryer-rpc,+        time,+        uuid,+        random,+        optparse-applicative,+        bytestring,+        containers,+        base64-bytestring,+        parser-combinators,+        prettyprinter,+        vector,+        http-types,+        http-conduit,+        base16-bytestring,+        cryptohash-sha256,+        template-haskell,+        haskeline,+        th-lift-instances+    Default-Extensions: OverloadedStrings+    Exposed-Modules:+        TutorialD.Interpreter,+        TutorialD.Interpreter.Base,+        TutorialD.Interpreter.DatabaseContextExpr,+        TutorialD.Interpreter.RODatabaseContextOperator,+        TutorialD.Interpreter.TransactionGraphOperator,+        TutorialD.Interpreter.Import.BasicExamples,+        TutorialD.Interpreter.InformationOperator,+        TutorialD.Interpreter.Export.Base,+        TutorialD.Interpreter.Export.CSV,+        TutorialD.Interpreter.DatabaseContextIOOperator,+        TutorialD.Interpreter.Import.Base,+        TutorialD.Interpreter.Import.CSV,+        TutorialD.Interpreter.Import.TutorialD,+        TutorialD.Interpreter.RelationalExpr,+        TutorialD.Interpreter.Types,+        TutorialD.Interpreter.TransGraphRelationalOperator,+        TutorialD.Interpreter.SchemaOperator,+        TutorialD.Interpreter.LoginRolesOperator,+        TutorialD.Interpreter.Template,+        TutorialD.Printer,+    Hs-Source-Dirs: ./src/bin++Library project-m36-sqlegacy+    Visibility: public+    Default-Language: Haskell2010    +    Build-Depends:+       project-m36,+       base,+       MonadRandom,+       time,+       uuid,+       text,+       megaparsec,+       base64-bytestring,+       containers,+       vector,+       prettyprinter,+       parser-combinators+    Hs-Source-Dirs: ./src/bin+    Default-Extensions: OverloadedStrings     +    Exposed-Modules: SQL.Interpreter.Base,+                   SQL.Interpreter.Select,+                   SQL.Interpreter,+                   SQL.Interpreter.TransactionGraphOperator,+                   SQL.Interpreter.ImportBasicExample,+                   SQL.Interpreter.Update,+                   SQL.Interpreter.Insert,+                   SQL.Interpreter.Delete,                   +                   SQL.Interpreter.DBUpdate,+                   SQL.Interpreter.CreateTable,+                   SQL.Interpreter.DropTable,+                   SQL.Interpreter.Info+    Other-Modules:+        TutorialD.Printer,+        TutorialD.Interpreter.Base         Executable tutd-    if flag(haskell-scripting)-        Build-Depends: ghc >= 9.4     Build-Depends: base >=4.17,                    ghc-paths,                    project-m36,+                   project-m36-tutoriald,                    containers,                    unordered-containers,                    hashable,@@ -318,35 +405,14 @@                    http-types,                    recursion-schemes,                    data-default -    Other-Modules: TutorialD.Interpreter,-                   TutorialD.Interpreter.Base,-                   TutorialD.Interpreter.DatabaseContextExpr,-                   TutorialD.Interpreter.RODatabaseContextOperator,-                   TutorialD.Interpreter.TransactionGraphOperator,-                   TutorialD.Interpreter.Import.BasicExamples,-                   TutorialD.Interpreter.InformationOperator,-                   TutorialD.Interpreter.Export.Base,-                   TutorialD.Interpreter.Export.CSV,-                   TutorialD.Interpreter.DatabaseContextIOOperator,-                   TutorialD.Interpreter.Import.Base,-                   TutorialD.Interpreter.Import.CSV,-                   TutorialD.Interpreter.Import.TutorialD,-                   TutorialD.Interpreter.RelationalExpr,-                   TutorialD.Interpreter.Types,-                   TutorialD.Interpreter.TransGraphRelationalOperator,-                   TutorialD.Interpreter.SchemaOperator,-                   TutorialD.Interpreter.LoginRolesOperator,-                   TutorialD.Printer,-                   ProjectM36.Cli,-                   ProjectM36.Interpreter-    main-is: TutorialD/tutd.hs+    main-is: ./src/bin/TutorialD/tutd.hs     CC-Options: -fPIC     GHC-Options: -Wall -threaded -rtsopts     if !os(windows)       GHC-Options: -rdynamic     if flag(profiler)       GHC-Prof-Options: -fprof-auto -rtsopts -threaded-    Hs-Source-Dirs: ./src/bin+--    Hs-Source-Dirs: ./src/bin     Default-Language: Haskell2010     Default-Extensions: OverloadedStrings @@ -356,6 +422,8 @@     Build-Depends: base,                    ghc-paths,                    project-m36,+                   project-m36-tutoriald,+                   project-m36-sqlegacy,                                       containers,                    unordered-containers,                    hashable,@@ -396,31 +464,13 @@                    modern-uri,                    http-types,                    recursion-schemes,-    Other-Modules: SQL.Interpreter.Base,-                   SQL.Interpreter.Select,-                   ProjectM36.Cli,-                   ProjectM36.Interpreter,-                   SQL.Interpreter,-                   SQL.Interpreter.TransactionGraphOperator,-                   SQL.Interpreter.ImportBasicExample,-                   SQL.Interpreter.Update,-                   SQL.Interpreter.Insert,-                   SQL.Interpreter.Delete,                   -                   SQL.Interpreter.DBUpdate,-                   SQL.Interpreter.CreateTable,-                   SQL.Interpreter.DropTable,-                   SQL.Interpreter.Info,-                   TutorialD.Printer,-                   TutorialD.Interpreter.Base-                   -    Main-Is: ./SQL/Interpreter/sqlegacy.hs+    Main-Is: ./src/bin/SQL/Interpreter/sqlegacy.hs     if os(windows)       GHC-Options: -Wall -threaded -rtsopts     else       GHC-Options: -Wall -threaded -rtsopts -rdynamic     if flag(profiler)       GHC-Prof-Options: -fprof-auto -rtsopts -threaded -Wall-    Hs-Source-Dirs: ./src/bin           Default-Language: Haskell2010     Default-Extensions: OverloadedStrings @@ -468,13 +518,7 @@     Type: exitcode-stdio-1.0               Default-Language: Haskell2010     Default-Extensions: OverloadedStrings-    Build-Depends: base, HUnit, Cabal, containers, hashable, unordered-containers, mtl, vector, time, bytestring, uuid, stm, deepseq, deepseq-generics, parallel, cassava, attoparsec, gnuplot, directory, temporary, haskeline, megaparsec, text, base64-bytestring, data-interval, filepath, optparse-applicative, stm-containers, list-t, ghc, ghc-paths, transformers, project-m36, random, MonadRandom, semigroups, parser-combinators, curryer-rpc-    Other-Modules: TutorialD.Interpreter.Base,-                   TutorialD.Interpreter.DatabaseContextExpr,-                   TutorialD.Interpreter.RelationalExpr,-                   TutorialD.Interpreter.Types,-                   ProjectM36.Interpreter,-                   ProjectM36.Cli+    Build-Depends: base, HUnit, Cabal, containers, hashable, unordered-containers, mtl, vector, time, bytestring, uuid, stm, deepseq, deepseq-generics, parallel, cassava, attoparsec, gnuplot, directory, temporary, haskeline, megaparsec, text, base64-bytestring, data-interval, filepath, optparse-applicative, stm-containers, list-t, ghc, ghc-paths, transformers, project-m36, project-m36-tutoriald, random, MonadRandom, semigroups, parser-combinators, curryer-rpc     main-is: benchmark/bigrel.hs     GHC-Options: -Wall -threaded -rtsopts -with-rtsopts=-N     HS-Source-Dirs: ./src/bin@@ -485,11 +529,10 @@  Common commontest     Default-Language: Haskell2010-    Build-Depends: base, HUnit, Cabal, containers, hashable, unordered-containers, mtl, vector, time, bytestring, uuid, stm, deepseq, deepseq-generics,parallel, cassava, attoparsec, gnuplot, directory, temporary, haskeline, megaparsec, text, base64-bytestring, data-interval, filepath, transformers, stm-containers, list-t, websockets, optparse-applicative, network, aeson, project-m36, random, MonadRandom, semigroups, parser-combinators, winery, curryer-rpc, prettyprinter, base64-bytestring, modern-uri, http-types, http-conduit, base16-bytestring, cryptohash-sha256, scientific, streamly+    Build-Depends: base, HUnit, Cabal, containers, hashable, unordered-containers, mtl, vector, time, bytestring, uuid, stm, deepseq, deepseq-generics,parallel, cassava, attoparsec, gnuplot, directory, temporary, haskeline, megaparsec, text, base64-bytestring, data-interval, filepath, transformers, stm-containers, list-t, websockets, optparse-applicative, network, aeson, project-m36, project-m36-tutoriald, random, MonadRandom, semigroups, parser-combinators, winery, curryer-rpc, prettyprinter, base64-bytestring, modern-uri, http-types, http-conduit, base16-bytestring, cryptohash-sha256, scientific, streamly     Default-Extensions: OverloadedStrings     GHC-Options: -Wall -threaded -with-rtsopts=-N-    Hs-Source-Dirs: test, src/bin-    Other-Modules: ProjectM36.Interpreter, ProjectM36.Cli+    Hs-Source-Dirs: test  Benchmark basic-benchmark     Default-Language: Haskell2010@@ -529,28 +572,28 @@     import: commontest     type: exitcode-stdio-1.0     main-is: SQL/InterpreterTest.hs-    Other-Modules: SQL.Interpreter.Select, SQL.Interpreter.Base, TutorialD.Interpreter.Base, TutorialD.Interpreter.RelationalExpr, TutorialD.Interpreter.Types, TutorialD.Interpreter.DatabaseContextExpr, TutorialD.Interpreter.RODatabaseContextOperator, ProjectM36.Interpreter, SQL.Interpreter.CreateTable-                   TutorialD.Printer,-                   ProjectM36.Cli,-                   SQL.Interpreter.DBUpdate,-                   SQL.Interpreter.Delete,-                   SQL.Interpreter.DropTable,-                   SQL.Interpreter.Insert,-                   SQL.Interpreter.Update--    Build-Depends: base, HUnit, Cabal, containers, hashable, unordered-containers, mtl, vector, time, bytestring, uuid, stm, deepseq, deepseq-generics, parallel, cassava, attoparsec, gnuplot, directory, temporary, haskeline, megaparsec, text, base64-bytestring, data-interval, filepath, stm-containers, list-t, project-m36, random, MonadRandom, semigroups, parser-combinators, prettyprinter, scientific, recursion-schemes+    Hs-Source-Dirs: ./src/bin+    Other-Modules:+        SQL.Interpreter.Select,+        SQL.Interpreter.Base,+        SQL.Interpreter.CreateTable,+        SQL.Interpreter.DBUpdate,+        SQL.Interpreter.Delete,+        SQL.Interpreter.DropTable,+        SQL.Interpreter.Insert,+        SQL.Interpreter.Update+    Build-Depends: base, HUnit, Cabal, containers, hashable, unordered-containers, mtl, vector, time, bytestring, uuid, stm, deepseq, deepseq-generics, parallel, cassava, attoparsec, gnuplot, directory, temporary, haskeline, megaparsec, text, base64-bytestring, data-interval, filepath, stm-containers, list-t, project-m36, project-m36-tutoriald, random, MonadRandom, semigroups, parser-combinators, prettyprinter, scientific, recursion-schemes      Test-Suite test-tutoriald     import: commontest     type: exitcode-stdio-1.0     main-is: TutorialD/InterpreterTest.hs-    Other-Modules: 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, TutorialD.Interpreter.DatabaseContextIOOperator, TutorialD.Interpreter.TestBase, TutorialD.Interpreter.TransGraphRelationalOperator, TutorialD.Interpreter.SchemaOperator, TutorialD.Printer, ProjectM36.Interpreter, ProjectM36.Cli, TutorialD.Interpreter.LoginRolesOperator-    Build-Depends: base, HUnit, Cabal, containers, hashable, unordered-containers, mtl, vector, time, bytestring, uuid, stm, deepseq, deepseq-generics, parallel, cassava, attoparsec, gnuplot, directory, temporary, haskeline, megaparsec, text, base64-bytestring, data-interval, filepath, stm-containers, list-t, project-m36, random, MonadRandom, semigroups, parser-combinators, prettyprinter, scientific+    Build-Depends: base, HUnit, Cabal, containers, hashable, unordered-containers, mtl, vector, time, bytestring, uuid, stm, deepseq, deepseq-generics, parallel, cassava, attoparsec, gnuplot, directory, temporary, haskeline, megaparsec, text, base64-bytestring, data-interval, filepath, stm-containers, list-t, project-m36, project-m36-tutoriald, random, MonadRandom, semigroups, parser-combinators, prettyprinter, scientific+    other-modules: TutorialD.Interpreter.TestBase      Test-Suite test-tutoriald-atomfunctionscript     import: commontest     type: exitcode-stdio-1.0-    Other-Modules: TutorialD.Interpreter, TutorialD.Interpreter.Base, TutorialD.Interpreter.DatabaseContextExpr, TutorialD.Interpreter.DatabaseContextIOOperator, 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.TestBase, TutorialD.Interpreter.TransGraphRelationalOperator, TutorialD.Interpreter.TransactionGraphOperator, TutorialD.Interpreter.Types, TutorialD.Interpreter.SchemaOperator, TutorialD.Printer, ProjectM36.Interpreter, TutorialD.Interpreter.LoginRolesOperator     main-is: TutorialD/Interpreter/AtomFunctionScript.hs  Test-Suite test-tutoriald-databasecontextfunctionscript@@ -558,8 +601,8 @@     type: exitcode-stdio-1.0     if flag(haskell-scripting)         CPP-Options: -DPM36_HASKELL_SCRIPTING-    Other-Modules: TutorialD.Interpreter, TutorialD.Interpreter.Base, TutorialD.Interpreter.DatabaseContextExpr, TutorialD.Interpreter.DatabaseContextIOOperator, 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.TestBase, TutorialD.Interpreter.TransGraphRelationalOperator, TutorialD.Interpreter.TransactionGraphOperator, TutorialD.Interpreter.Types, TutorialD.Interpreter.SchemaOperator, TutorialD.Printer, ProjectM36.Interpreter, TutorialD.Interpreter.LoginRolesOperator     main-is: TutorialD/Interpreter/DatabaseContextFunctionScript.hs+    other-modules: TutorialD.Interpreter.TestBase  Test-Suite test-relation     import: commontest@@ -575,7 +618,6 @@     import: commontest     type: exitcode-stdio-1.0     main-is: TransactionGraph/Persist.hs-    Other-Modules: TutorialD.Interpreter.Base, TutorialD.Interpreter.RelationalExpr, TutorialD.Interpreter.Types, TutorialD.Interpreter.DatabaseContextExpr, TutorialD.Interpreter.Import.BasicExamples, TutorialD.Printer  Test-Suite test-relation-import-csv     import: commontest@@ -587,7 +629,6 @@     type: exitcode-stdio-1.0     build-depends: warp, wai     main-is: TutorialD/Interpreter/Import/ImportTest.hs-    Other-Modules: TutorialD.Interpreter.Base, TutorialD.Interpreter.Import.Base, TutorialD.Interpreter.Import.TutorialD, TutorialD.Interpreter.RelationalExpr, TutorialD.Interpreter.Types, TutorialD.Interpreter.DatabaseContextExpr, TutorialD.Interpreter.Import.BasicExamples, TutorialD.Printer  Test-Suite test-tutoriald-import-module     import: commontest@@ -595,18 +636,7 @@     main-is: TutorialD/Interpreter/Module.hs     if flag(haskell-scripting)         CPP-Options: -DPM36_HASKELL_SCRIPTING-    Other-Modules: TutorialD.Interpreter.Base, TutorialD.Interpreter.Import.Base, TutorialD.Interpreter.Import.TutorialD, TutorialD.Interpreter.RelationalExpr, TutorialD.Interpreter.Types, TutorialD.Interpreter.DatabaseContextExpr, TutorialD.Interpreter.Import.BasicExamples, TutorialD.Printer,         TutorialD.Interpreter,-        TutorialD.Interpreter.DatabaseContextIOOperator,-        TutorialD.Interpreter.Export.Base,-        TutorialD.Interpreter.Export.CSV,-        TutorialD.Interpreter.Import.CSV,-        TutorialD.Interpreter.InformationOperator,-        TutorialD.Interpreter.LoginRolesOperator,-        TutorialD.Interpreter.RODatabaseContextOperator,-        TutorialD.Interpreter.SchemaOperator,-        TutorialD.Interpreter.TestBase,-        TutorialD.Interpreter.TransGraphRelationalOperator,-        TutorialD.Interpreter.TransactionGraphOperator+    other-modules: TutorialD.Interpreter.TestBase          Test-Suite test-relation-export-csv     import: commontest@@ -623,12 +653,12 @@     import: commontest     type: exitcode-stdio-1.0     main-is: TutorialD/PrinterTest.hs-    Other-Modules: TutorialD.Printer, TutorialD.Interpreter.Base, TutorialD.Interpreter.RelationalExpr, TutorialD.Interpreter.Types  benchmark bench     import: commontest     build-depends: criterion     type: exitcode-stdio-1.0+    HS-Source-Dirs: ./src/bin         main-is: benchmark/Relation.hs  benchmark ondiskclient@@ -637,28 +667,9 @@     main-is: benchmark/OnDiskClient.hs     GHC-Prof-Options: -fprof-auto -rtsopts -threaded -Wall     GHC-Options: -rtsopts -Wall -threaded -finfo-table-map -fdistinct-constructor-tables+    HS-Source-Dirs: ./src/bin     if impl(ghc <9.4)       GHC-Options: -eventlog-    Other-Modules: ProjectM36.Cli,-        TutorialD.Interpreter,-        TutorialD.Interpreter.Base,-        TutorialD.Interpreter.DatabaseContextExpr,-        TutorialD.Interpreter.DatabaseContextIOOperator,-        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.SchemaOperator,-        TutorialD.Interpreter.TransGraphRelationalOperator,-        TutorialD.Interpreter.TransactionGraphOperator,-        TutorialD.Interpreter.Types,-        TutorialD.Interpreter.LoginRolesOperator,-        TutorialD.Printer  Test-Suite test-server     import: commontest@@ -676,6 +687,17 @@     Main-Is: examples/SimpleClient.hs     GHC-Options: -Wall -threaded +Executable Example-TutorialDInline+    if flag(build-examples)+        buildable: True+    else+        buildable: False+    Default-Language: Haskell2010+    Default-Extensions: OverloadedStrings+    Build-Depends: base, HUnit, Cabal, containers, hashable, unordered-containers, mtl, vector, time, bytestring, uuid, stm, deepseq, deepseq-generics,parallel, cassava, attoparsec, gnuplot, directory, temporary, haskeline, megaparsec, text, base64-bytestring, data-interval, filepath, transformers, stm-containers, list-t, ghc, ghc-paths, project-m36, project-m36-tutoriald, random, MonadRandom, curryer-rpc+    Main-Is: examples/tutd-inline.hs+    GHC-Options: -Wall -threaded+ Executable Example-OutOfTheTarpit     if flag(build-examples)       buildable: True@@ -766,13 +788,12 @@     import: commontest     type: exitcode-stdio-1.0     main-is: scripts.hs-    Other-Modules: TutorialD.Interpreter.Base, TutorialD.Interpreter.DatabaseContextExpr, TutorialD.Interpreter.Import.Base, TutorialD.Interpreter.Import.TutorialD, TutorialD.Interpreter.RelationalExpr, TutorialD.Interpreter.Types, TutorialD.Interpreter.Import.BasicExamples, TutorialD.Printer, TutorialD.Interpreter.LoginRolesOperator+    Other-Modules: TutorialD.Interpreter.TestBase  Executable project-m36-websocket-server     Default-Language: Haskell2010-    Build-Depends: base, aeson, path-pieces, either, conduit, http-api-data, template-haskell, websockets, optparse-applicative, project-m36, containers, bytestring, text, vector, uuid, megaparsec, haskeline, mtl, directory, base64-bytestring, random, MonadRandom, time, semigroups, attoparsec, parser-combinators, prettyprinter, network, modern-uri, http-conduit, base16-bytestring, http-types, cryptohash-sha256, wai, wai-websockets, warp, warp-tls, scientific, curryer-rpc+    Build-Depends: base, aeson, path-pieces, either, conduit, http-api-data, template-haskell, websockets, optparse-applicative, project-m36, project-m36-tutoriald, containers, bytestring, text, vector, uuid, megaparsec, haskeline, mtl, directory, base64-bytestring, random, MonadRandom, time, semigroups, attoparsec, parser-combinators, prettyprinter, network, modern-uri, http-conduit, base16-bytestring, http-types, cryptohash-sha256, wai, wai-websockets, warp, warp-tls, scientific, curryer-rpc     Main-Is: ProjectM36/Server/WebSocket/websocket-server.hs-    Other-Modules:  ProjectM36.Cli, ProjectM36.Client.Json, ProjectM36.Server.RemoteCallTypes.Json, ProjectM36.Server.WebSocket, TutorialD.Interpreter, TutorialD.Interpreter.Base, TutorialD.Interpreter.DatabaseContextExpr, TutorialD.Interpreter.DatabaseContextIOOperator, 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, TutorialD.Interpreter.TransGraphRelationalOperator, TutorialD.Interpreter.SchemaOperator, TutorialD.Printer, ProjectM36.Interpreter, TutorialD.Interpreter.LoginRolesOperator     GHC-Options: -Wall -threaded     Hs-Source-Dirs: ./src/bin     Default-Extensions: OverloadedStrings@@ -781,7 +802,30 @@     import: commontest     type: exitcode-stdio-1.0     main-is: Server/WebSocket.hs-    Other-Modules: 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, ProjectM36.Client.Json, ProjectM36.Server.RemoteCallTypes.Json, ProjectM36.Server.WebSocket, TutorialD.Interpreter, TutorialD.Interpreter.Base, TutorialD.Interpreter.DatabaseContextExpr, TutorialD.Interpreter.Import.Base, TutorialD.Interpreter.Import.TutorialD, TutorialD.Interpreter.RelationalExpr, TutorialD.Interpreter.Types, TutorialD.Interpreter.DatabaseContextIOOperator, TutorialD.Interpreter.TransGraphRelationalOperator, TutorialD.Interpreter.SchemaOperator, TutorialD.Printer, ProjectM36.Interpreter, ProjectM36.Cli, TutorialD.Interpreter.LoginRolesOperator+    hs-source-dirs: ./src/bin+    other-modules:+        ProjectM36.Server.WebSocket,+        ProjectM36.Client.Json,+        ProjectM36.Server.RemoteCallTypes.Json,+        TutorialD.Interpreter,+        TutorialD.Interpreter.Base,+        TutorialD.Interpreter.DatabaseContextExpr,+        TutorialD.Interpreter.DatabaseContextIOOperator,+        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.LoginRolesOperator,+        TutorialD.Interpreter.RODatabaseContextOperator,+        TutorialD.Interpreter.RelationalExpr,+        TutorialD.Interpreter.SchemaOperator,+        TutorialD.Interpreter.TransGraphRelationalOperator,+        TutorialD.Interpreter.TransactionGraphOperator,+        TutorialD.Interpreter.Types,+        TutorialD.Printer  Test-Suite test-isomorphic-schemas     import: commontest@@ -792,7 +836,6 @@     import: commontest     type: exitcode-stdio-1.0     main-is: Relation/Atomable.hs-    Other-Modules: TutorialD.Interpreter, TutorialD.Interpreter.Base, TutorialD.Interpreter.DatabaseContextExpr, TutorialD.Interpreter.DatabaseContextIOOperator, 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.SchemaOperator, TutorialD.Interpreter.TestBase, TutorialD.Interpreter.TransGraphRelationalOperator, TutorialD.Interpreter.TransactionGraphOperator, TutorialD.Interpreter.Types, TutorialD.Printer, ProjectM36.Cli, TutorialD.Interpreter.LoginRolesOperator  Test-Suite test-multiprocess-access     import: commontest@@ -803,7 +846,7 @@     import: commontest     type: exitcode-stdio-1.0     main-is: TransactionGraph/Automerge.hs-    Other-Modules: TutorialD.Interpreter, TutorialD.Interpreter.Base, TutorialD.Interpreter.DatabaseContextExpr, TutorialD.Interpreter.DatabaseContextIOOperator, 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.SchemaOperator, TutorialD.Interpreter.TestBase, TutorialD.Interpreter.TransGraphRelationalOperator, TutorialD.Interpreter.TransactionGraphOperator, TutorialD.Interpreter.Types, TutorialD.Printer, ProjectM36.Cli, TutorialD.Interpreter.LoginRolesOperator+    other-modules: TutorialD.Interpreter.TestBase  Test-Suite test-tupleable     import: commontest@@ -822,27 +865,6 @@     Default-Extensions: OverloadedStrings     Build-Depends: base, HUnit, Cabal, containers, hashable, unordered-containers, mtl, vector, time, bytestring, uuid, stm, deepseq, deepseq-generics,parallel, cassava, attoparsec, gnuplot, directory, temporary, haskeline, megaparsec, text, base64-bytestring, data-interval, filepath, optparse-applicative, stm-containers, list-t, ghc, ghc-paths, transformers, project-m36, random, MonadRandom, semigroups, parser-combinators, prettyprinter, modern-uri, http-types, http-conduit, base16-bytestring, cryptohash-sha256, curryer-rpc     main-is: benchmark/Handles.hs-    Other-Modules: TutorialD.Interpreter,-      TutorialD.Interpreter.Base,-      TutorialD.Interpreter.DatabaseContextExpr,-      TutorialD.Interpreter.DatabaseContextIOOperator,-      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.SchemaOperator,-      TutorialD.Interpreter.TransGraphRelationalOperator,-      TutorialD.Interpreter.TransactionGraphOperator,-      TutorialD.Interpreter.Types,-      TutorialD.Printer,-      ProjectM36.Interpreter,-      ProjectM36.Cli,-      TutorialD.Interpreter.LoginRolesOperator     GHC-Options: -Wall -threaded -rtsopts     HS-Source-Dirs: ./src/bin     if flag(profiler)@@ -852,7 +874,7 @@     import: commontest     type: exitcode-stdio-1.0     Main-Is: DataFrame.hs-    Other-Modules: TutorialD.Interpreter, TutorialD.Interpreter.Base, TutorialD.Interpreter.DatabaseContextExpr,  TutorialD.Interpreter.DatabaseContextIOOperator, 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.SchemaOperator, TutorialD.Interpreter.TestBase, TutorialD.Interpreter.TransGraphRelationalOperator, TutorialD.Interpreter.TransactionGraphOperator, TutorialD.Interpreter.Types, TutorialD.Printer, ProjectM36.Interpreter, TutorialD.Interpreter.LoginRolesOperator+    other-modules: TutorialD.Interpreter.TestBase  Test-Suite test-cache    import: commontest@@ -873,24 +895,10 @@     import: commontest     type: exitcode-stdio-1.0         Main-Is: AccessControl.hs-    Other-Modules:-        TutorialD.Interpreter-        TutorialD.Interpreter.Base-        TutorialD.Interpreter.DatabaseContextExpr-        TutorialD.Interpreter.DatabaseContextIOOperator-        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.LoginRolesOperator-        TutorialD.Interpreter.RODatabaseContextOperator-        TutorialD.Interpreter.RelationalExpr-        TutorialD.Interpreter.SchemaOperator-        TutorialD.Interpreter.TestBase-        TutorialD.Interpreter.TransGraphRelationalOperator-        TutorialD.Interpreter.TransactionGraphOperator-        TutorialD.Interpreter.Types-        TutorialD.Printer+    Other-Modules: TutorialD.Interpreter.TestBase++Test-Suite test-tutoriald-template+    import: commontest+    type: exitcode-stdio-1.0    +    Main-Is: TutorialD/Interpreter/TemplateTest.hs+     

@@ -1,177 +0,0 @@-{-# LANGUAGE LambdaCase #-}--- functions common to both tutd and sqlegacy command line interfaces-module ProjectM36.Cli where-import qualified ProjectM36.Client as C-import qualified Data.Text as T-import ProjectM36.Base-import ProjectM36.DatabaseContext.Types-import ProjectM36.IsomorphicSchema.Types-import ProjectM36.Client (RemoteServerAddress(..))-import System.Console.Haskeline-import Control.Exception-import System.IO-import ProjectM36.Relation.Show.Term -- probably want to display dataframes instead-import ProjectM36.Error-import Options.Applicative -import ProjectM36.Server.ParseArgs-import ProjectM36.Server (checkFSType, checkFSErrorMsg)-import Data.Maybe (fromMaybe)-import GHC.IO.Encoding-import Control.Monad (when)-import System.Exit-import Text.Megaparsec.Error-import Data.Void (Void)-import ProjectM36.Interpreter hiding (Parser)-import Network.RPC.Curryer.Client-import System.Random (StdGen, initStdGen)--type GhcPkgPath = String-type TutorialDExec = String-type CheckFS = Bool--type DirectExecute = String-type ParserError = ParseErrorBundle T.Text Void--data InterpreterConfig = LocalInterpreterConfig PersistenceStrategy HeadName (Maybe DirectExecute) [GhcPkgPath] CheckFS RoleName |-                         RemoteInterpreterConfig RemoteServerAddress ClientConnectionConfig C.DatabaseName HeadName (Maybe TutorialDExec) CheckFS RoleName--outputNotificationCallback :: C.NotificationCallback-outputNotificationCallback notName evaldNot = hPutStrLn stderr $ "Notification received " ++ show notName ++ ":\n" ++ "\n" ++ prettyEvaluatedNotification evaldNot--prettyEvaluatedNotification :: C.EvaluatedNotification -> String-prettyEvaluatedNotification eNotif = let eRelShow eRel = case eRel of-                                           Left err -> show err-                                           Right reportRel -> T.unpack (showRelation reportRel) in-  eRelShow (C.reportOldRelation eNotif) <> "\n" <> eRelShow (C.reportNewRelation eNotif)--type ReprLoopEvaluator = C.SessionId -> C.Connection -> Maybe PromptLength -> T.Text -> IO ()-type MakePrompt = Either RelationalError C.CurrentHead -> Either RelationalError SchemaName -> StringType-type HistoryFilePath = FilePath-  -reprLoop :: InterpreterConfig -> HistoryFilePath -> ReprLoopEvaluator -> MakePrompt -> C.SessionId -> C.Connection -> IO ()-reprLoop config historyFilePath reprLoopEvaluator promptText sessionId conn = do-  let settings = defaultSettings {historyFile = Just historyFilePath} -- (homeDirectory ++ "/.tutd_history")}-  eCurrentHead <- C.currentHead sessionId conn-  eSchemaName <- C.currentSchemaName sessionId conn-  let prompt = promptText eCurrentHead eSchemaName-      catchInterrupt = handleJust (\case-                                      UserInterrupt -> Just Nothing-                                      _ -> Nothing) (\_ -> do-                                                        hPutStrLn stderr "Statement cancelled. Use \":quit\" to exit."-                                                        pure (Just ""))-  maybeLine <- catchInterrupt $ runInputT settings $ getInputLine (T.unpack prompt)-  case maybeLine of-    Nothing -> return ()-    Just line -> do-      reprLoopEvaluator sessionId conn (Just (T.length prompt)) (T.pack line)-      reprLoop config historyFilePath reprLoopEvaluator promptText sessionId conn--parseArgs :: Parser InterpreterConfig-parseArgs = LocalInterpreterConfig <$> parsePersistenceStrategy <*> parseHeadName <*> parseDirectExecute <*> many parseGhcPkgPath <*> parseCheckFS <*> parseRoleName <|>-            RemoteInterpreterConfig <$> parseServerAddress <*> parseClientConnectionConfig <*> parseDatabaseName <*> parseHeadName <*> parseDirectExecute <*> parseCheckFS <*> parseRoleName--parseClientConnectionConfig :: Parser ClientConnectionConfig-parseClientConnectionConfig =-  flag' UnencryptedConnectionConfig (long "disable-tls" <>-                                       help "Disable encryption when connecting to the server.")-  <|>-  EncryptedConnectionConfig <$> parseClientTLSConfig--parseClientTLSConfig :: Parser ClientTLSConfig-parseClientTLSConfig =-  ClientTLSConfig <$>-    parseClientTLSCertInfo <*>-    parseHostname "localhost" <*>-    parseServiceName ""--parseClientTLSCertInfo :: Parser ClientTLSCertInfo-parseClientTLSCertInfo =-  ClientTLSCertInfo <$>-  optional ((,) <$>-              strOption (long "public-x509-key" <>-                         metavar "KEY_PATH" <>-                         help "Enables TLS with path to public key.") <*>-              strOption (long "private-x509-key" <>-                         metavar "KEY_PATH" <>-                         help "Enables TLS with path to private key.")) <*>-  optional (strOption (long "certificate-x509-path" <>-                        metavar "CERT_PATH" <>-                        help "Path to certificate for TLS. Elide to use system's certificate store."))-    -parseHeadName :: Parser HeadName               -parseHeadName = option auto (long "head" <>-                             help "Start session at head name." <>-                             metavar "GRAPH HEAD NAME" <>-                             value "master"-                            )--parseDirectExecute :: Parser (Maybe DirectExecute)-parseDirectExecute = optional $ strOption (long "exec-tutd" <>-                           short 'e' <>-                           metavar "TUTORIALD" <>-                           help "Execute TutorialD expression and exit"-                           )--type PrintWelcome = IO ()-type ExecUserInput = C.SessionId -> C.Connection -> Maybe PromptLength -> T.Text -> IO ()--mainLoop :: IO () -> HistoryFilePath -> ReprLoopEvaluator -> MakePrompt -> ExecUserInput -> ResolvedDatabaseContext -> IO ()-mainLoop printWelcome historyFilePath reprLoopEvaluator promptText execUserInput defaultDBContext = do-  setLocaleIfNecessary-  interpreterConfig <- execParser opts-  rando <- initStdGen-  let connInfo = connectionInfoForConfig interpreterConfig defaultDBContext rando-  fscheck <- checkFSType (checkFSForConfig interpreterConfig) (fromMaybe NoPersistence (persistenceStrategyForConfig interpreterConfig))-  if not fscheck then-    errDie checkFSErrorMsg-    else do-    dbconn <- C.connectProjectM36 connInfo-    case dbconn of -      Left err -> -        errDie ("Failed to create database connection: " ++ show err)-      Right conn -> do-        let connHeadName = headNameForConfig interpreterConfig-        eSessionId <- C.createSessionAtHead conn connHeadName-        case eSessionId of -            Left err -> errDie ("Failed to create database session at \"" ++ show connHeadName ++ "\": " ++ show err)-            Right sessionId -> -              case directExecForConfig interpreterConfig of-                Nothing -> do-                  printWelcome-                  _ <- reprLoop interpreterConfig historyFilePath reprLoopEvaluator promptText sessionId conn-                  pure ()-                Just execStr -> -                  execUserInput sessionId conn Nothing (T.pack execStr)-  --- | If the locale is set to ASCII, upgrade it to UTF-8 because tutd outputs UTF-8-encoded attributes. This is especially important in light docker images where the locale data may be missing.-setLocaleIfNecessary :: IO ()-setLocaleIfNecessary = do-  l <- getLocaleEncoding-  when (textEncodingName l == "ASCII") (setLocaleEncoding utf8)--opts :: ParserInfo InterpreterConfig            -opts = info (parseArgs <**> helpOption) idm--connectionInfoForConfig :: InterpreterConfig -> ResolvedDatabaseContext -> StdGen -> C.ConnectionInfo-connectionInfoForConfig (LocalInterpreterConfig pStrategy _ _ ghcPkgPaths _ roleName) defaultDBContext rando = C.InProcessConnectionInfo pStrategy outputNotificationCallback ghcPkgPaths defaultDBContext rando roleName-connectionInfoForConfig (RemoteInterpreterConfig remoteAddress connConfig remoteDBName _ _ _ roleName) _ _ = C.RemoteConnectionInfo remoteDBName remoteAddress connConfig outputNotificationCallback roleName--headNameForConfig :: InterpreterConfig -> HeadName-headNameForConfig (LocalInterpreterConfig _ headn _ _ _ _) = headn-headNameForConfig (RemoteInterpreterConfig _ _ _ headn _ _ _) = headn--directExecForConfig :: InterpreterConfig -> Maybe String-directExecForConfig (LocalInterpreterConfig _ _ t _ _ _) = t-directExecForConfig (RemoteInterpreterConfig _ _ _ _ t _ _) = t--checkFSForConfig :: InterpreterConfig -> Bool-checkFSForConfig (LocalInterpreterConfig _ _ _ _ c _) = c-checkFSForConfig (RemoteInterpreterConfig _ _ _ _ _ c _) = c--persistenceStrategyForConfig :: InterpreterConfig -> Maybe PersistenceStrategy-persistenceStrategyForConfig (LocalInterpreterConfig strat _ _ _ _ _) = Just strat-persistenceStrategyForConfig RemoteInterpreterConfig{} = Nothing-                         -errDie :: String -> IO ()                                                           -errDie err = hPutStrLn stderr err >> exitFailure-

@@ -1,60 +0,0 @@-{-# LANGUAGE DeriveGeneric #-}--- functions common to both SQL and TutorialD interpreters-module ProjectM36.Interpreter where-import ProjectM36.Base-import ProjectM36.Error-import ProjectM36.DataFrame-import Text.Megaparsec-import Data.Void-import GHC.Generics-import qualified Data.Text.IO as TIO-import qualified Data.Text as T-import qualified Data.List.NonEmpty as NE-import System.IO-import Control.Monad.Random-import ProjectM36.Relation.Show.Term-import ProjectM36.Relation--type Parser = Parsec Void T.Text-type ParserError = ParseErrorBundle T.Text Void-type PromptLength = Int--data SafeEvaluationFlag = SafeEvaluation | UnsafeEvaluation deriving (Eq)--data ConsoleResult = QuitResult |-                     DisplayResult StringType |-                     DisplayIOResult (IO ()) |-                     DisplayRelationResult Relation |-                     DisplayDataFrameResult DataFrame |-                     DisplayHintWith T.Text ConsoleResult |-                     DisplayErrorResult StringType |-                     DisplayRelationalErrorResult RelationalError |-                     DisplayParseErrorResult (Maybe PromptLength) ParserError | -- PromptLength refers to length of prompt text-                     QuietSuccessResult-                   deriving (Generic)--type InteractiveConsole = Bool--displayResult :: ConsoleResult -> IO ()-displayResult QuitResult = return ()-displayResult (DisplayResult out) = TIO.putStrLn out-displayResult (DisplayIOResult ioout) = ioout-displayResult (DisplayErrorResult err) = let outputf = if T.length err > 0 && T.last err /= '\n' then TIO.hPutStrLn else TIO.hPutStr in-  outputf stderr ("ERR: " <> err)-displayResult QuietSuccessResult = return ()-displayResult (DisplayRelationResult rel) = do-  gen <- newStdGen-  let randomlySortedRel = evalRand (randomizeTupleOrder rel) gen-  TIO.putStrLn (showRelation randomlySortedRel)-displayResult (DisplayParseErrorResult mPromptLength err) = do-  let errorIndent = errorOffset . NE.head . bundleErrors $ err-      errString = T.pack (parseErrorPretty . NE.head . bundleErrors $ err)-      pointyString len = T.justifyRight (len + fromIntegral errorIndent) '_' "^"-  maybe (pure ()) (TIO.putStrLn . pointyString) mPromptLength-  TIO.putStr ("ERR:" <> errString)-displayResult (DisplayDataFrameResult dFrame) = TIO.putStrLn (showDataFrame dFrame)-displayResult (DisplayRelationalErrorResult err) =-  TIO.putStrLn ("ERR:" <> T.pack (show err))-displayResult (DisplayHintWith hint result) = do-  displayResult (DisplayResult hint)-  displayResult result

@@ -1,48 +1,28 @@-{-# LANGUAGE CPP #-} module TutorialD.Interpreter.Base (   module TutorialD.Interpreter.Base,   module Text.Megaparsec,-#if MIN_VERSION_megaparsec(6,0,0)   module Text.Megaparsec.Char,   module Control.Applicative-#else-  module Text.Megaparsec.Text-#endif  )   where import ProjectM36.Base import ProjectM36.AtomType import ProjectM36.Attribute as A import ProjectM36.Interpreter--#if MIN_VERSION_megaparsec(6,0,0) import Text.Megaparsec.Char  import qualified Text.Megaparsec.Char.Lexer as Lex import Text.Megaparsec import Control.Applicative hiding (many, some)-#else-import Text.Megaparsec.Text-import qualified Text.Megaparsec.Lexer as Lex-#endif  import Data.Text hiding (count) import qualified Data.Text as T import qualified Data.List as L-#if __GLASGOW_HASKELL__ < 804-import Data.Monoid-#endif import qualified Data.UUID as U import Control.Monad.Random import Data.Time.Clock import Data.Time.Format import Data.Char -#if !MIN_VERSION_megaparsec(7,0,0)-anySingle :: Parsec Void Text (Token Text)-anySingle = anyChar-#endif-- type ParseStr = Text  -- consumes only horizontal spaces@@ -85,11 +65,7 @@   pure (pack (c:rest))  symbol :: ParseStr -> Parser Text-#if MIN_VERSION_megaparsec(6,0,0)-symbol sym = Lex.symbol spaceConsumer sym-#else-symbol sym = pack <$> Lex.symbol spaceConsumer sym-#endif+symbol = Lex.symbol spaceConsumer  comma :: Parser Text comma = symbol ","@@ -116,18 +92,10 @@ nline = (T.singleton <$> newline) <|> crlf  integer :: Parser Integer-#if MIN_VERSION_megaparsec(6,0,0) integer = Lex.signed (pure ()) Lex.decimal <* spaceConsumer-#else-integer = Lex.signed (pure ()) Lex.integer <* spaceConsumer-#endif  natural :: Parser Integer-#if MIN_VERSION_megaparsec(6,0,0) natural = Lex.decimal <* spaceConsumer-#else-natural = Lex.integer <* spaceConsumer-#endif  float :: Parser Double float = Lex.float <* spaceConsumer

@@ -1,4 +1,3 @@-{-# LANGUAGE CPP #-} --includes some hardcoded examples which can be imported even during safe evaluation (no file I/O) module TutorialD.Interpreter.Import.BasicExamples where import ProjectM36.DateExamples@@ -6,10 +5,6 @@ import ProjectM36.Interpreter import ProjectM36.DatabaseContextExpr import TutorialD.Interpreter.Base--#if !MIN_VERSION_megaparsec(6,0,0)-import Text.Megaparsec.Text-#endif  data ImportBasicExampleOperator = ImportBasicDateExampleOperator                                 deriving (Show)

@@ -1,11 +1,6 @@-{-# LANGUAGE CPP #-} module TutorialD.Interpreter.RelationalExpr where import Text.Megaparsec-#if MIN_VERSION_megaparsec(7,0,0) import Control.Monad.Combinators.Expr-#else-import Text.Megaparsec.Expr-#endif import ProjectM36.Base import ProjectM36.Interpreter import TutorialD.Interpreter.Base

@@ -0,0 +1,285 @@+-- | Implements client-side TutorialD templating for use in Haskell code including parameterized replacement.++-- if I want users to use tutoriald from client libraries then it needs to be bundled in the project-m36 library OR I need to make a separate client library (less appealing)+{-# LANGUAGE FlexibleInstances, TypeApplications, StandaloneDeriving, DeriveLift, CPP, TemplateHaskell #-}+module TutorialD.Interpreter.Template where+import TutorialD.Interpreter.RelationalExpr+import TutorialD.Interpreter.DatabaseContextExpr+import TutorialD.Interpreter.TransGraphRelationalOperator+import Text.Megaparsec+import qualified Data.Text as T+import Language.Haskell.TH+import Language.Haskell.TH.Syntax+import Language.Haskell.TH.Quote+import ProjectM36.Base+import ProjectM36.Relation+import ProjectM36.Tuple+import ProjectM36.TransactionGraph+import ProjectM36.DataTypes.Primitive+import ProjectM36.AccessControlList+import Instances.TH.Lift ()+import qualified Data.Vector as V+import qualified Data.Map as M+-- older time modules do not include Lift instance+#if !MIN_VERSION_time(1,14,0)+import Data.Time.Calendar (Day, fromGregorian, toGregorian, toModifiedJulianDay)+import Data.Time.Clock (UTCTime(..), diffTimeToPicoseconds, addUTCTime, secondsToDiffTime, DiffTime, NominalDiffTime, secondsToNominalDiffTime)+import Data.Fixed (Pico)+#endif++relationalExpr :: QuasiQuoter+relationalExpr =+    QuasiQuoter+    { quoteExp = parseRelationalExprQ+    , quotePat = notHandled "pattern"+    , quoteType = notHandled "type"+    , quoteDec = notHandled "declaration"+    }+    where+      parseRelationalExprQ tutdString =+        case parse (relExprP @()) "" (T.pack tutdString) of+          Left err -> fail (show err)+          Right parsed -> lift parsed+      ++databaseContextExpr :: QuasiQuoter+databaseContextExpr =+    QuasiQuoter+    { quoteExp = \strIn ->+        case parse databaseContextExprP "" (T.pack strIn) of+          Left err -> fail (show err)+          Right parsed -> lift parsed+    , quotePat = notHandled "pattern"+    , quoteType = notHandled "type"+    , quoteDec = notHandled "declaration"+    }++transGraphRelationalExpr :: QuasiQuoter+transGraphRelationalExpr = +    QuasiQuoter+    { quoteExp = \strIn ->+        case parse (relExprP @TransactionIdLookup) "" (T.pack strIn) of+          Left err -> fail (show err)+          Right parsed -> lift parsed+    , quotePat = notHandled "pattern"+    , quoteType = notHandled "type"+    , quoteDec = notHandled "declaration"+    }++deriving instance Lift a => Lift (RelationalExprBase a)+deriving instance Lift a => Lift (TupleExprsBase a)+deriving instance Lift a => Lift (TupleExprBase a)+deriving instance Lift a => Lift (AttributeExprBase a)+deriving instance Lift a => Lift (AttributeNamesBase a)+deriving instance Lift a => Lift (RestrictionPredicateExprBase a)+deriving instance Lift a => Lift (ExtendTupleExprBase a)+deriving instance Lift a => Lift (WithNameExprBase a)+deriving instance Lift a => Lift (AtomExprBase a)+deriving instance Lift RelationTupleSet+deriving instance Lift Attributes+deriving instance Lift Relation+deriving instance Lift TypeConstructor+deriving instance Lift Attribute+deriving instance Lift Atom+deriving instance Lift RelationTuple+deriving instance Lift AtomType++deriving instance (Lift a, Lift r) => Lift (DatabaseContextExprBase a r)+deriving instance Lift r => Lift (AlterDBCACLExprBase r)+deriving instance Lift TypeConstructorDef+deriving instance Lift DataConstructorDef+deriving instance Lift DataConstructorDefArg+deriving instance Lift SomePermission+deriving instance Lift RelVarPermission+deriving instance Lift DBCFunctionPermission+deriving instance Lift FunctionPermission+deriving instance Lift AlterSchemaPermission+deriving instance Lift AlterTransGraphPermission+deriving instance Lift ACLPermission+deriving instance Lift InclusionDependency++deriving instance Lift TransactionIdLookup+deriving instance Lift TransactionIdHeadBacktrack++notHandled :: String -> a+notHandled e = error $  e <> "not supported by TutorialD Quasiquoter"++class AtomReplacer a where+  replace :: Atom -> Atom -> a -> a++instance AtomReplacer Atom where+  replace needle replacement haystack =+    case haystack of+      h | h == needle -> replacement+      IntegerAtom{} -> haystack+      IntAtom{} -> haystack+      ScientificAtom{} -> haystack+      DoubleAtom{} -> haystack+      TextAtom{} -> haystack+      DayAtom{} -> haystack+      DateTimeAtom{} -> haystack+      ByteStringAtom{} -> haystack+      BoolAtom{} -> haystack+      UUIDAtom{} -> haystack+      RelationAtom rel -> RelationAtom (replace needle replacement rel)+      SubrelationFoldAtom rel attr -> SubrelationFoldAtom (replace needle replacement rel) attr+      ConstructedAtom dConsName aType args ->+        ConstructedAtom dConsName aType (fmap (replace needle replacement) args)++instance AtomReplacer (AtomExprBase a) where+  replace needle replacement haystack =+    case haystack of+      AttributeAtomExpr{} -> haystack+      SubrelationAttributeAtomExpr{} -> haystack+      NakedAtomExpr atom -> NakedAtomExpr (replace needle replacement atom)+      FunctionAtomExpr fname args marker ->+        FunctionAtomExpr fname (fmap (replace needle replacement) args) marker+      RelationAtomExpr relExpr ->+        RelationAtomExpr (replace needle replacement relExpr)+      IfThenAtomExpr if' then' else' ->+        IfThenAtomExpr (replace needle replacement if') (replace needle replacement then') (replace needle replacement else')+      ConstructedAtomExpr dConsName args marker ->+        ConstructedAtomExpr dConsName (fmap (replace needle replacement) args) marker++-- only allow a replacement if the type does *not* change+instance AtomReplacer Relation where+  replace needle replacement haystack =+    if atomTypeForAtom needle /= atomTypeForAtom replacement then+      error "atoms in Relation can only replaced with one of same type"+      else+      case relMap tupMapper haystack of+        Left err -> error ("replacement rejected: " <> show err)+        Right rel -> rel+    where+      tupMapper tup =+        pure $ replace needle replacement tup++instance AtomReplacer (RelationalExprBase a) where+  replace needle replacement haystack =+    case haystack of+      MakeRelationFromExprs attrExprs tupExprs ->+        MakeRelationFromExprs attrExprs (replace needle replacement tupExprs)+      MakeStaticRelation attrs tupSet ->+        MakeStaticRelation attrs (replace needle replacement tupSet)+      ExistingRelation rel ->+        ExistingRelation (replace needle replacement rel)+      RelationVariable{} -> haystack+      RelationValuedAttribute{} -> haystack+      Project attrNames relExpr ->+        Project attrNames (replace needle replacement relExpr)+      Union attrNames relExpr ->+        Union attrNames (replace needle replacement relExpr)+      Join relExprA relExprB ->+        Join (replace needle replacement relExprA) (replace needle replacement relExprB)+      Rename renames relExpr ->+        Rename renames (replace needle replacement relExpr)+      Difference relExprA relExprB ->+        Difference (replace needle replacement relExprA) (replace needle replacement relExprB)+      Group attrNames groupAttr relExpr ->+        Group attrNames groupAttr (replace needle replacement relExpr)+      Ungroup attrName relExpr ->+        Ungroup attrName (replace needle replacement relExpr)+      Restrict predExpr relExpr ->+        Restrict (replace needle replacement predExpr) (replace needle replacement relExpr)+      Equals relExprA relExprB ->+        Equals (replace needle replacement relExprA) (replace needle replacement relExprB)+      NotEquals relExprA relExprB ->+        NotEquals (replace needle replacement relExprA) (replace needle replacement relExprB)+      Extend extender relExpr ->+        Extend (replace needle replacement extender) (replace needle replacement relExpr)+      With withs relExpr ->+        With (replace needle replacement withs) (replace needle replacement relExpr)+      +instance AtomReplacer RelationTuple where+  replace needle replacement haystack =+    if atomTypeForAtom needle /= atomTypeForAtom replacement then+      error "atoms in Relation can only replaced with one of same type"+    else+      RelationTuple (tupleAttributes haystack) (V.map (replace needle replacement) (tupleAtoms haystack))++instance AtomReplacer (TupleExprsBase a) where+  replace needle replacement (TupleExprs marker tupExprs) =+    TupleExprs marker (fmap (replace needle replacement) tupExprs)++instance AtomReplacer RelationTupleSet where+  replace needle replacement (RelationTupleSet tups) =+    RelationTupleSet (fmap (replace needle replacement) tups)++instance AtomReplacer (RestrictionPredicateExprBase a) where+  replace needle replacement expr =+    case expr of+      TruePredicate -> expr+      AndPredicate a b ->+        AndPredicate (replace needle replacement a) (replace needle replacement b)+      OrPredicate a b ->+        OrPredicate (replace needle replacement a) (replace needle replacement b)+      NotPredicate a ->+        NotPredicate (replace needle replacement a)+      AtomExprPredicate expr ->+        AtomExprPredicate (replace needle replacement expr)+      AttributeEqualityPredicate attrName atomExpr ->+        AttributeEqualityPredicate attrName (replace needle replacement atomExpr)+      +instance AtomReplacer (ExtendTupleExprBase a) where+  replace needle replacement (AttributeExtendTupleExpr attrName expr) =+    AttributeExtendTupleExpr attrName (replace needle replacement expr)++instance AtomReplacer (WithNamesAssocsBase a) where+  replace needle replacement assocs =+    fmap (\(name, relExpr) -> (name, replace needle replacement relExpr)) assocs++instance AtomReplacer (TupleExprBase a) where+  replace needle replacement (TupleExpr tupMap) =+    TupleExpr (M.map (\atomExpr -> replace needle replacement atomExpr) tupMap)++instance AtomReplacer (DatabaseContextExprBase a r) where+  replace needle replacement expr =+    case expr of+      NoOperation -> expr+      Define{} -> expr+      Undefine{} -> expr+      Assign rv relExpr ->+        Assign rv (replace needle replacement relExpr)+      Insert rv relExpr ->+        Insert rv (replace needle replacement relExpr)+      Delete rv predExpr ->+        Delete rv (replace needle replacement predExpr)+      Update rv attrAtomMap predExpr ->+        Update rv (M.map (replace needle replacement) attrAtomMap) (replace needle replacement predExpr)+      AddInclusionDependency nam incDep ->+        AddInclusionDependency nam (replace needle replacement incDep)+      RemoveInclusionDependency{} -> expr+      AddNotification nam expr1 expr2 expr3 ->+        AddNotification nam (replace needle replacement expr1) (replace needle replacement expr2) (replace needle replacement expr3)+      RemoveNotification{} -> expr+      AddTypeConstructor{} -> expr+      RemoveTypeConstructor{} -> expr+      RemoveAtomFunction{} -> expr+      RemoveDatabaseContextFunction{} -> expr+      ExecuteDatabaseContextFunction fname args ->+        ExecuteDatabaseContextFunction fname (map (replace needle replacement) args)+      AddRegisteredQuery qName relExpr ->+        AddRegisteredQuery qName (replace needle replacement relExpr)+      RemoveRegisteredQuery{} -> expr+      AlterACL{} -> expr+      MultipleExpr exprs ->+        MultipleExpr (map (replace needle replacement) exprs)++instance AtomReplacer InclusionDependency where+  replace needle replacement (InclusionDependency exprA exprB) =+    InclusionDependency (replace needle replacement exprA) (replace needle replacement exprB)++replaceTextAtom :: AtomReplacer a => T.Text -> T.Text -> a -> a+replaceTextAtom needle replacement haystack =+  replace (TextAtom needle) (TextAtom replacement) haystack+    +replaceIntegerAtom :: AtomReplacer a => Integer -> Integer -> a -> a+replaceIntegerAtom needle replacement haystack =+  replace (IntegerAtom needle) (IntegerAtom replacement) haystack++replaceAtoms :: AtomReplacer a => [(Atom, Atom)] -> a -> a+replaceAtoms assocs haystack =+  foldr folder haystack assocs+  where+    folder (needle, replacement) acc =+      replace needle replacement acc

@@ -0,0 +1,177 @@+{-# LANGUAGE LambdaCase #-}+-- functions common to both tutd and sqlegacy command line interfaces+module ProjectM36.Cli where+import qualified ProjectM36.Client as C+import qualified Data.Text as T+import ProjectM36.Base+import ProjectM36.DatabaseContext.Types+import ProjectM36.IsomorphicSchema.Types+import ProjectM36.Client (RemoteServerAddress(..))+import System.Console.Haskeline+import Control.Exception+import System.IO+import ProjectM36.Relation.Show.Term -- probably want to display dataframes instead+import ProjectM36.Error+import Options.Applicative +import ProjectM36.Server.ParseArgs+import ProjectM36.Server (checkFSType, checkFSErrorMsg)+import Data.Maybe (fromMaybe)+import GHC.IO.Encoding+import Control.Monad (when)+import System.Exit+import Text.Megaparsec.Error+import Data.Void (Void)+import ProjectM36.Interpreter hiding (Parser)+import Network.RPC.Curryer.Client+import System.Random (StdGen, initStdGen)++type GhcPkgPath = String+type TutorialDExec = String+type CheckFS = Bool++type DirectExecute = String+type ParserError = ParseErrorBundle T.Text Void++data InterpreterConfig = LocalInterpreterConfig PersistenceStrategy HeadName (Maybe DirectExecute) [GhcPkgPath] CheckFS RoleName |+                         RemoteInterpreterConfig RemoteServerAddress ClientConnectionConfig C.DatabaseName HeadName (Maybe TutorialDExec) CheckFS RoleName++outputNotificationCallback :: C.NotificationCallback+outputNotificationCallback notName evaldNot = hPutStrLn stderr $ "Notification received " ++ show notName ++ ":\n" ++ "\n" ++ prettyEvaluatedNotification evaldNot++prettyEvaluatedNotification :: C.EvaluatedNotification -> String+prettyEvaluatedNotification eNotif = let eRelShow eRel = case eRel of+                                           Left err -> show err+                                           Right reportRel -> T.unpack (showRelation reportRel) in+  eRelShow (C.reportOldRelation eNotif) <> "\n" <> eRelShow (C.reportNewRelation eNotif)++type ReprLoopEvaluator = C.SessionId -> C.Connection -> Maybe PromptLength -> T.Text -> IO ()+type MakePrompt = Either RelationalError C.CurrentHead -> Either RelationalError SchemaName -> StringType+type HistoryFilePath = FilePath+  +reprLoop :: InterpreterConfig -> HistoryFilePath -> ReprLoopEvaluator -> MakePrompt -> C.SessionId -> C.Connection -> IO ()+reprLoop config historyFilePath reprLoopEvaluator promptText sessionId conn = do+  let settings = defaultSettings {historyFile = Just historyFilePath} -- (homeDirectory ++ "/.tutd_history")}+  eCurrentHead <- C.currentHead sessionId conn+  eSchemaName <- C.currentSchemaName sessionId conn+  let prompt = promptText eCurrentHead eSchemaName+      catchInterrupt = handleJust (\case+                                      UserInterrupt -> Just Nothing+                                      _ -> Nothing) (\_ -> do+                                                        hPutStrLn stderr "Statement cancelled. Use \":quit\" to exit."+                                                        pure (Just ""))+  maybeLine <- catchInterrupt $ runInputT settings $ getInputLine (T.unpack prompt)+  case maybeLine of+    Nothing -> return ()+    Just line -> do+      reprLoopEvaluator sessionId conn (Just (T.length prompt)) (T.pack line)+      reprLoop config historyFilePath reprLoopEvaluator promptText sessionId conn++parseArgs :: Parser InterpreterConfig+parseArgs = LocalInterpreterConfig <$> parsePersistenceStrategy <*> parseHeadName <*> parseDirectExecute <*> many parseGhcPkgPath <*> parseCheckFS <*> parseRoleName <|>+            RemoteInterpreterConfig <$> parseServerAddress <*> parseClientConnectionConfig <*> parseDatabaseName <*> parseHeadName <*> parseDirectExecute <*> parseCheckFS <*> parseRoleName++parseClientConnectionConfig :: Parser ClientConnectionConfig+parseClientConnectionConfig =+  flag' UnencryptedConnectionConfig (long "disable-tls" <>+                                       help "Disable encryption when connecting to the server.")+  <|>+  EncryptedConnectionConfig <$> parseClientTLSConfig++parseClientTLSConfig :: Parser ClientTLSConfig+parseClientTLSConfig =+  ClientTLSConfig <$>+    parseClientTLSCertInfo <*>+    parseHostname "localhost" <*>+    parseServiceName ""++parseClientTLSCertInfo :: Parser ClientTLSCertInfo+parseClientTLSCertInfo =+  ClientTLSCertInfo <$>+  optional ((,) <$>+              strOption (long "public-x509-key" <>+                         metavar "KEY_PATH" <>+                         help "Enables TLS with path to public key.") <*>+              strOption (long "private-x509-key" <>+                         metavar "KEY_PATH" <>+                         help "Enables TLS with path to private key.")) <*>+  optional (strOption (long "certificate-x509-path" <>+                        metavar "CERT_PATH" <>+                        help "Path to certificate for TLS. Elide to use system's certificate store."))+    +parseHeadName :: Parser HeadName               +parseHeadName = option auto (long "head" <>+                             help "Start session at head name." <>+                             metavar "GRAPH HEAD NAME" <>+                             value "master"+                            )++parseDirectExecute :: Parser (Maybe DirectExecute)+parseDirectExecute = optional $ strOption (long "exec-tutd" <>+                           short 'e' <>+                           metavar "TUTORIALD" <>+                           help "Execute TutorialD expression and exit"+                           )++type PrintWelcome = IO ()+type ExecUserInput = C.SessionId -> C.Connection -> Maybe PromptLength -> T.Text -> IO ()++mainLoop :: IO () -> HistoryFilePath -> ReprLoopEvaluator -> MakePrompt -> ExecUserInput -> ResolvedDatabaseContext -> IO ()+mainLoop printWelcome historyFilePath reprLoopEvaluator promptText execUserInput defaultDBContext = do+  setLocaleIfNecessary+  interpreterConfig <- execParser opts+  rando <- initStdGen+  let connInfo = connectionInfoForConfig interpreterConfig defaultDBContext rando+  fscheck <- checkFSType (checkFSForConfig interpreterConfig) (fromMaybe NoPersistence (persistenceStrategyForConfig interpreterConfig))+  if not fscheck then+    errDie checkFSErrorMsg+    else do+    dbconn <- C.connectProjectM36 connInfo+    case dbconn of +      Left err -> +        errDie ("Failed to create database connection: " ++ show err)+      Right conn -> do+        let connHeadName = headNameForConfig interpreterConfig+        eSessionId <- C.createSessionAtHead conn connHeadName+        case eSessionId of +            Left err -> errDie ("Failed to create database session at \"" ++ show connHeadName ++ "\": " ++ show err)+            Right sessionId -> +              case directExecForConfig interpreterConfig of+                Nothing -> do+                  printWelcome+                  _ <- reprLoop interpreterConfig historyFilePath reprLoopEvaluator promptText sessionId conn+                  pure ()+                Just execStr -> +                  execUserInput sessionId conn Nothing (T.pack execStr)+  +-- | If the locale is set to ASCII, upgrade it to UTF-8 because tutd outputs UTF-8-encoded attributes. This is especially important in light docker images where the locale data may be missing.+setLocaleIfNecessary :: IO ()+setLocaleIfNecessary = do+  l <- getLocaleEncoding+  when (textEncodingName l == "ASCII") (setLocaleEncoding utf8)++opts :: ParserInfo InterpreterConfig            +opts = info (parseArgs <**> helpOption) idm++connectionInfoForConfig :: InterpreterConfig -> ResolvedDatabaseContext -> StdGen -> C.ConnectionInfo+connectionInfoForConfig (LocalInterpreterConfig pStrategy _ _ ghcPkgPaths _ roleName) defaultDBContext rando = C.InProcessConnectionInfo pStrategy outputNotificationCallback ghcPkgPaths defaultDBContext rando roleName+connectionInfoForConfig (RemoteInterpreterConfig remoteAddress connConfig remoteDBName _ _ _ roleName) _ _ = C.RemoteConnectionInfo remoteDBName remoteAddress connConfig outputNotificationCallback roleName++headNameForConfig :: InterpreterConfig -> HeadName+headNameForConfig (LocalInterpreterConfig _ headn _ _ _ _) = headn+headNameForConfig (RemoteInterpreterConfig _ _ _ headn _ _ _) = headn++directExecForConfig :: InterpreterConfig -> Maybe String+directExecForConfig (LocalInterpreterConfig _ _ t _ _ _) = t+directExecForConfig (RemoteInterpreterConfig _ _ _ _ t _ _) = t++checkFSForConfig :: InterpreterConfig -> Bool+checkFSForConfig (LocalInterpreterConfig _ _ _ _ c _) = c+checkFSForConfig (RemoteInterpreterConfig _ _ _ _ _ c _) = c++persistenceStrategyForConfig :: InterpreterConfig -> Maybe PersistenceStrategy+persistenceStrategyForConfig (LocalInterpreterConfig strat _ _ _ _ _) = Just strat+persistenceStrategyForConfig RemoteInterpreterConfig{} = Nothing+                         +errDie :: String -> IO ()                                                           +errDie err = hPutStrLn stderr err >> exitFailure+

@@ -0,0 +1,60 @@+{-# LANGUAGE DeriveGeneric #-}+-- functions common to both SQL and TutorialD interpreters+module ProjectM36.Interpreter where+import ProjectM36.Base+import ProjectM36.Error+import ProjectM36.DataFrame+import Text.Megaparsec+import Data.Void+import GHC.Generics+import qualified Data.Text.IO as TIO+import qualified Data.Text as T+import qualified Data.List.NonEmpty as NE+import System.IO+import Control.Monad.Random+import ProjectM36.Relation.Show.Term+import ProjectM36.Relation++type Parser = Parsec Void T.Text+type ParserError = ParseErrorBundle T.Text Void+type PromptLength = Int++data SafeEvaluationFlag = SafeEvaluation | UnsafeEvaluation deriving (Eq)++data ConsoleResult = QuitResult |+                     DisplayResult StringType |+                     DisplayIOResult (IO ()) |+                     DisplayRelationResult Relation |+                     DisplayDataFrameResult DataFrame |+                     DisplayHintWith T.Text ConsoleResult |+                     DisplayErrorResult StringType |+                     DisplayRelationalErrorResult RelationalError |+                     DisplayParseErrorResult (Maybe PromptLength) ParserError | -- PromptLength refers to length of prompt text+                     QuietSuccessResult+                   deriving (Generic)++type InteractiveConsole = Bool++displayResult :: ConsoleResult -> IO ()+displayResult QuitResult = return ()+displayResult (DisplayResult out) = TIO.putStrLn out+displayResult (DisplayIOResult ioout) = ioout+displayResult (DisplayErrorResult err) = let outputf = if T.length err > 0 && T.last err /= '\n' then TIO.hPutStrLn else TIO.hPutStr in+  outputf stderr ("ERR: " <> err)+displayResult QuietSuccessResult = return ()+displayResult (DisplayRelationResult rel) = do+  gen <- newStdGen+  let randomlySortedRel = evalRand (randomizeTupleOrder rel) gen+  TIO.putStrLn (showRelation randomlySortedRel)+displayResult (DisplayParseErrorResult mPromptLength err) = do+  let errorIndent = errorOffset . NE.head . bundleErrors $ err+      errString = T.pack (parseErrorPretty . NE.head . bundleErrors $ err)+      pointyString len = T.justifyRight (len + fromIntegral errorIndent) '_' "^"+  maybe (pure ()) (TIO.putStrLn . pointyString) mPromptLength+  TIO.putStr ("ERR:" <> errString)+displayResult (DisplayDataFrameResult dFrame) = TIO.putStrLn (showDataFrame dFrame)+displayResult (DisplayRelationalErrorResult err) =+  TIO.putStrLn ("ERR:" <> T.pack (show err))+displayResult (DisplayHintWith hint result) = do+  displayResult (DisplayResult hint)+  displayResult result

@@ -52,7 +52,10 @@ import ProjectM36.NormalizeExpr import ProjectM36.WithNameExpr import ProjectM36.Function-import ProjectM36.AccessControlList (RoleId, AccessControlList, SomePermission(..), relvarsACL, dbcFunctionsACL, schemaACL, transGraphACL, aclACL, allPermissionsForRole, addAccess, removeAccess)+import ProjectM36.AccessControlList (RoleId, AccessControlList, SomePermission(..), relvarsACL, dbcFunctionsACL, schemaACL, transGraphACL, aclACL, addAccess, removeAccess)+#if defined(PM36_HASKELL_SCRIPTING)+import ProjectM36.AccessControlList (allPermissionsForRole)+#endif import Test.QuickCheck import Data.Functor (void) import qualified Data.Functor.Foldable as Fold

@@ -25,9 +25,7 @@ import ProjectM36.DatabaseContext.Fields  import Codec.Winery-#if MIN_VERSION_base(4,18,0) import Control.Monad (foldM, forM, unless, when)-#endif import Control.Monad.Except import Control.Monad.Reader import qualified Data.Vector as V@@ -39,9 +37,6 @@ import qualified Data.Text as T import GHC.Generics import Data.Either (lefts, rights, isRight)-#if __GLASGOW_HASKELL__ < 804-import Data.Monoid-#endif import Control.Arrow import Data.Maybe import Data.UUID.V4

@@ -0,0 +1,40 @@+{-# LANGUAGE QuasiQuotes #-}+import System.Exit+import Test.HUnit+import TutorialD.Interpreter.Template+import ProjectM36.Base+import ProjectM36.TransactionGraph++main :: IO ()+main = do+  tcounts <- runTestTT (TestList [testRelationalExpr,+                                 testDatabaseContextExpr,+                                 testTransGraphRelationalExpr,+                                 testRelationalExprReplacement])+  if errors tcounts + failures tcounts > 0 then exitFailure else exitSuccess++testRelationalExpr :: Test+testRelationalExpr = TestCase $ do+  let actual = [relationalExpr|x union x|]+      expected = RelationVariable "x" () `Union` RelationVariable "x" ()+  assertEqual "relational expr" expected actual++testDatabaseContextExpr :: Test+testDatabaseContextExpr = TestCase $ do+  let actual :: DatabaseContextExpr -- resolved ACL type variable+      actual = [databaseContextExpr|x:=true|]+      expected = Assign "x" (RelationVariable "true" ())+  assertEqual "database context expr" expected actual++testTransGraphRelationalExpr :: Test+testTransGraphRelationalExpr = TestCase $ do+  let actual = [transGraphRelationalExpr|t@master^|]+      expected = RelationVariable "t" (TransactionIdHeadNameLookup "master" [TransactionIdHeadBranchBacktrack 1])+  assertEqual "trans graph relational expr" expected actual++testRelationalExprReplacement :: Test+testRelationalExprReplacement = TestCase $ do+  let actual = [relationalExpr|s where city="$1"|]+      expected = Restrict (AttributeEqualityPredicate "city" (NakedAtomExpr (TextAtom "London"))) (RelationVariable "s" ())+      actual' = replaceTextAtom "$1" "London" actual+  assertEqual "replace relational expr" expected actual'