diff --git a/app/Server.hs b/app/Server.hs index 38b5e6e..8ddfcda 100644 --- a/app/Server.hs +++ b/app/Server.hs @@ -30,6 +30,7 @@ import Control.Lens hiding ((.=)) import Compiler.RLPC import Compiler.JustRun +import GM -- import Misc.CofreeF -- import Rlp.AltSyntax @@ -62,7 +63,7 @@ instance FromJSON Command where data Response = Annotated Value | PartiallyAnnotated Value - | Evaluated Value + | Evaluated [GmState] | Error Value deriving (Generic) deriving (ToJSON) @@ -87,5 +88,5 @@ respond (Annotate s) respond (Evaluate s) = justLexParseGmEval (T.unpack s) - & either (Error . toJSON) (Evaluated . toJSON) + & either (Error . toJSON) Evaluated diff --git a/src/Compiler/RlpcError.hs b/src/Compiler/RlpcError.hs index 6cb242e..9201775 100644 --- a/src/Compiler/RlpcError.hs +++ b/src/Compiler/RlpcError.hs @@ -23,6 +23,9 @@ import Data.Text qualified as T import GHC.Exts (IsString(..)) import Control.Lens import Compiler.Types +import GHC.Generics ( Generic, Generic1 + , Generically(..), Generically1(..) ) +import Data.Aeson (ToJSON1(..), ToJSON(..)) ---------------------------------------------------------------------------------- data MsgEnvelope e = MsgEnvelope @@ -30,10 +33,18 @@ data MsgEnvelope e = MsgEnvelope , _msgDiagnostic :: e , _msgSeverity :: Severity } - deriving (Functor, Show) + deriving (Functor, Show, Generic, Generic1) newtype RlpcError = Text [Text] - deriving Show + deriving (Show, Generic) + +deriving via Generically1 MsgEnvelope + instance ToJSON1 MsgEnvelope +deriving via Generically (MsgEnvelope e) + instance ToJSON e => ToJSON (MsgEnvelope e) + +deriving via Generically RlpcError + instance ToJSON RlpcError instance IsString RlpcError where fromString = Text . pure . T.pack @@ -47,7 +58,10 @@ instance IsRlpcError RlpcError where data Severity = SevWarning | SevError | SevDebug Text -- ^ Tag - deriving Show + deriving (Show, Generic) + +deriving via Generically Severity + instance ToJSON Severity makeLenses ''MsgEnvelope diff --git a/src/Compiler/Types.hs b/src/Compiler/Types.hs index 607a0db..efb8008 100644 --- a/src/Compiler/Types.hs +++ b/src/Compiler/Types.hs @@ -20,6 +20,9 @@ import Data.Functor.Apply import Data.Functor.Bind import Control.Lens hiding ((<<~)) import Language.Haskell.TH.Syntax (Lift) +import GHC.Generics ( Generic, Generic1 + , Generically(..), Generically1(..) ) +import Data.Aeson (ToJSON1(..), ToJSON(..)) -------------------------------------------------------------------------------- -- | Token wrapped with a span (line, column, absolute, length) @@ -47,7 +50,10 @@ data SrcSpan = SrcSpan !Int -- ^ Column !Int -- ^ Absolute !Int -- ^ Length - deriving (Show, Lift) + deriving (Show, Lift, Generic) + +deriving via Generically SrcSpan + instance ToJSON SrcSpan tupling :: Iso' SrcSpan (Int, Int, Int, Int) tupling = iso (\ (SrcSpan a b c d) -> (a,b,c,d)) diff --git a/visualisers/gmvis/package-lock.json b/visualisers/gmvis/package-lock.json index 13d227a..474a21a 100644 --- a/visualisers/gmvis/package-lock.json +++ b/visualisers/gmvis/package-lock.json @@ -7,10 +7,21 @@ "": { "name": "gmvis", "version": "0.0.1", + "dependencies": { + "ace-builds": "^1.32.7", + "react": "16.13.0", + "react-ace": "^10.1.0", + "react-dom": "16.13.0" + }, "devDependencies": { "shadow-cljs": "2.28.3" } }, + "node_modules/ace-builds": { + "version": "1.33.1", + "resolved": "https://registry.npmjs.org/ace-builds/-/ace-builds-1.33.1.tgz", + "integrity": "sha512-pj5mcXV1n3s86UI4SWUt8X0ltN8cTaYcvF76cSmvy5i2ZDtXX9KkjVcYTGkCV7ox6VUrzqHByeqH0xRsMjXi4g==" + }, "node_modules/asn1.js": { "version": "4.10.1", "resolved": "https://registry.npmjs.org/asn1.js/-/asn1.js-4.10.1.tgz", @@ -341,6 +352,11 @@ "minimalistic-assert": "^1.0.0" } }, + "node_modules/diff-match-patch": { + "version": "1.0.5", + "resolved": "https://registry.npmjs.org/diff-match-patch/-/diff-match-patch-1.0.5.tgz", + "integrity": "sha512-IayShXAgj/QMXgB0IWmKx+rOPuGMhqm5w6jvFxmVenXKIzRqTAAsbBPT3kWQeGANj3jGgvcvv4yK6SxqYmikgw==" + }, "node_modules/diffie-hellman": { "version": "5.0.3", "resolved": "https://registry.npmjs.org/diffie-hellman/-/diffie-hellman-5.0.3.tgz", @@ -595,6 +611,32 @@ "integrity": "sha512-RHxMLp9lnKHGHRng9QFhRCMbYAcVpn69smSGcq3f36xjgVVWThj4qqLbTLlq7Ssj8B+fIQ1EuCEGI2lKsyQeIw==", "dev": true }, + "node_modules/js-tokens": { + "version": "4.0.0", + "resolved": "https://registry.npmjs.org/js-tokens/-/js-tokens-4.0.0.tgz", + "integrity": "sha512-RdJUflcE3cUzKiMqQgsCu06FPu9UdIJO0beYbPhHN4k6apgJtifcoCtT9bcxOpYBtpD2kCM6Sbzg4CausW/PKQ==" + }, + "node_modules/lodash.get": { + "version": "4.4.2", + "resolved": "https://registry.npmjs.org/lodash.get/-/lodash.get-4.4.2.tgz", + "integrity": "sha512-z+Uw/vLuy6gQe8cfaFWD7p0wVv8fJl3mbzXh33RS+0oW2wvUqiRXiQ69gLWSLpgB5/6sU+r6BlQR0MBILadqTQ==" + }, + "node_modules/lodash.isequal": { + "version": "4.5.0", + "resolved": "https://registry.npmjs.org/lodash.isequal/-/lodash.isequal-4.5.0.tgz", + "integrity": "sha512-pDo3lu8Jhfjqls6GkMgpahsF9kCyayhgykjyLMNFTKWrpVdAQtYyB4muAMWozBB4ig/dtWAmsMxLEI8wuz+DYQ==" + }, + "node_modules/loose-envify": { + "version": "1.4.0", + "resolved": "https://registry.npmjs.org/loose-envify/-/loose-envify-1.4.0.tgz", + "integrity": "sha512-lyuxPGr/Wfhrlem2CL/UcnUc1zcqKAImBDzukY7Y5F/yQiNdko6+fRLevlw1HgMySw7f611UIY408EtxRSoK3Q==", + "dependencies": { + "js-tokens": "^3.0.0 || ^4.0.0" + }, + "bin": { + "loose-envify": "cli.js" + } + }, "node_modules/md5.js": { "version": "1.3.5", "resolved": "https://registry.npmjs.org/md5.js/-/md5.js-1.3.5.tgz", @@ -668,6 +710,14 @@ "vm-browserify": "^1.0.1" } }, + "node_modules/object-assign": { + "version": "4.1.1", + "resolved": "https://registry.npmjs.org/object-assign/-/object-assign-4.1.1.tgz", + "integrity": "sha512-rJgTQnkUnH1sFw8yT6VSU3zD3sWmu6sZhIseY8VX+GRu3P6F7Fu+JNDoXfklElbLJSnc3FUQHVe4cU5hj+BcUg==", + "engines": { + "node": ">=0.10.0" + } + }, "node_modules/object-inspect": { "version": "1.13.1", "resolved": "https://registry.npmjs.org/object-inspect/-/object-inspect-1.13.1.tgz", @@ -770,6 +820,16 @@ "integrity": "sha512-3ouUOpQhtgrbOa17J7+uxOTpITYWaGP7/AhoR3+A+/1e9skrzelGi/dXzEYyvbxubEF6Wn2ypscTKiKJFFn1ag==", "dev": true }, + "node_modules/prop-types": { + "version": "15.8.1", + "resolved": "https://registry.npmjs.org/prop-types/-/prop-types-15.8.1.tgz", + "integrity": "sha512-oj87CgZICdulUohogVAR7AjlC0327U4el4L6eAvOqCeudMDVU0NThNaV+b9Df4dXgSP1gXMTnPdhfe/2qDH5cg==", + "dependencies": { + "loose-envify": "^1.4.0", + "object-assign": "^4.1.1", + "react-is": "^16.13.1" + } + }, "node_modules/public-encrypt": { "version": "4.0.3", "resolved": "https://registry.npmjs.org/public-encrypt/-/public-encrypt-4.0.3.tgz", @@ -839,6 +899,54 @@ "safe-buffer": "^5.1.0" } }, + "node_modules/react": { + "version": "16.13.0", + "resolved": "https://registry.npmjs.org/react/-/react-16.13.0.tgz", + "integrity": "sha512-TSavZz2iSLkq5/oiE7gnFzmURKZMltmi193rm5HEoUDAXpzT9Kzw6oNZnGoai/4+fUnm7FqS5dwgUL34TujcWQ==", + "dependencies": { + "loose-envify": "^1.1.0", + "object-assign": "^4.1.1", + "prop-types": "^15.6.2" + }, + "engines": { + "node": ">=0.10.0" + } + }, + "node_modules/react-ace": { + "version": "10.1.0", + "resolved": "https://registry.npmjs.org/react-ace/-/react-ace-10.1.0.tgz", + "integrity": "sha512-VkvUjZNhdYTuKOKQpMIZi7uzZZVgzCjM7cLYu6F64V0mejY8a2XTyPUIMszC6A4trbeMIHbK5fYFcT/wkP/8VA==", + "dependencies": { + "ace-builds": "^1.4.14", + "diff-match-patch": "^1.0.5", + "lodash.get": "^4.4.2", + "lodash.isequal": "^4.5.0", + "prop-types": "^15.7.2" + }, + "peerDependencies": { + "react": "^0.13.0 || ^0.14.0 || ^15.0.1 || ^16.0.0 || ^17.0.0 || ^18.0.0", + "react-dom": "^0.13.0 || ^0.14.0 || ^15.0.1 || ^16.0.0 || ^17.0.0 || ^18.0.0" + } + }, + "node_modules/react-dom": { + "version": "16.13.0", + "resolved": "https://registry.npmjs.org/react-dom/-/react-dom-16.13.0.tgz", + "integrity": "sha512-y09d2c4cG220DzdlFkPTnVvGTszVvNpC73v+AaLGLHbkpy3SSgvYq8x0rNwPJ/Rk/CicTNgk0hbHNw1gMEZAXg==", + "dependencies": { + "loose-envify": "^1.1.0", + "object-assign": "^4.1.1", + "prop-types": "^15.6.2", + "scheduler": "^0.19.0" + }, + "peerDependencies": { + "react": "^16.0.0" + } + }, + "node_modules/react-is": { + "version": "16.13.1", + "resolved": "https://registry.npmjs.org/react-is/-/react-is-16.13.1.tgz", + "integrity": "sha512-24e6ynE2H+OKt4kqsOvNd8kBpV65zoxbA4BVsEOB3ARVWQki/DHzaUoC5KuON/BiccDaCCTZBuOcfZs70kR8bQ==" + }, "node_modules/readable-stream": { "version": "2.3.8", "resolved": "https://registry.npmjs.org/readable-stream/-/readable-stream-2.3.8.tgz", @@ -908,6 +1016,15 @@ } ] }, + "node_modules/scheduler": { + "version": "0.19.1", + "resolved": "https://registry.npmjs.org/scheduler/-/scheduler-0.19.1.tgz", + "integrity": "sha512-n/zwRWRYSUj0/3g/otKDRPMh6qv2SYMWNq85IEa8iZyAv8od9zDYpGSnpBEjNgcMNq6Scbu5KfIPxNF72R/2EA==", + "dependencies": { + "loose-envify": "^1.1.0", + "object-assign": "^4.1.1" + } + }, "node_modules/set-function-length": { "version": "1.2.2", "resolved": "https://registry.npmjs.org/set-function-length/-/set-function-length-1.2.2.tgz", diff --git a/visualisers/gmvis/package.json b/visualisers/gmvis/package.json index 8aa8913..abc6425 100644 --- a/visualisers/gmvis/package.json +++ b/visualisers/gmvis/package.json @@ -1,12 +1 @@ -{ "name": "gmvis" -, "version": "0.0.1" -, "private": true -, "devDependencies": - { "shadow-cljs": "2.28.3" - } -, "dependencies": - { "react": "16.13.0" - , "react-dom": "16.13.0" - } -} - +{"name":"gmvis","version":"0.0.1","private":true,"devDependencies":{"shadow-cljs":"2.28.3"},"dependencies":{"ace-builds":"^1.32.7","react":"16.13.0","react-ace":"^10.1.0","react-dom":"16.13.0"}} \ No newline at end of file diff --git a/visualisers/gmvis/src/main.cljs b/visualisers/gmvis/src/main.cljs index 97bb499..9b26d1d 100644 --- a/visualisers/gmvis/src/main.cljs +++ b/visualisers/gmvis/src/main.cljs @@ -1,12 +1,59 @@ -(ns main) +(ns main + (:require + ["react-ace$default" :as AceEditor] + ["ace-builds/src-noconflict/mode-haskell"] + ["ace-builds/src-noconflict/theme-solarized_light"] + ["ace-builds/src-noconflict/keybinding-vim"] + [wscljs.client :as ws] + [wscljs.format :as fmt] + [clojure.string :as str] + [cljs.core.match :refer-macros [match]])) + +(defn display-errors [es] + (doseq [{{e :contents} :diagnostic} es] + (let [fmte (map #(str " • " % "\n") e)] + (js/console.warn (apply str "message from rlpc:\n" fmte))))) + +(defn on-message [e] + (let [r (js->clj (js/JSON.parse (.-data e)) :keywordize-keys true)] + (match r + {:tag "Evaluated" :contents c} + (prn c) + :else + (js/console.warn "unrecognised response from rlp")))) + +(def +rlp-socket+ nil) + +(defn send [msg] + (ws/send +rlp-socket+ msg fmt/json)) + +(defn on-open [] + (println "socket opened") + (send {:command "evaluate" + :source (str/join "\n" + ["fac n = case (==#) n 0 of" + " { <1> -> 1" + " ; <0> -> *# n (fac (-# n 1))" + " };" + "" + "main = fac 3;"])})) + +(defn init-rlp-socket [] + (set! +rlp-socket+ (ws/create "ws://127.0.0.1:9002" + {:on-message on-message + :on-open on-open + :on-close #(println "socket closed") + :on-error #(println "error: " %)}))) ;; this is called before any code is reloaded (defn ^:dev/before-load stop [] + (ws/close +rlp-socket+) (js/console.log "stop")) ;; start is called by init and after code reloading finishes (defn ^:dev/after-load start [] - (js/console.log "start")) + (js/console.log "start") + (init-rlp-socket)) ;; init is called ONCE when the page loads ;; this is called in the index.html and must be exported