Repl API

.ghci

@@ -1,4 +1,4 @@
 :set -fbyte-code
 :set -fobject-code
 :set -fwarn-name-shadowing
-:def rr const $ return $ unlines ["Ext.Common.killTrackedThreads",":r","Test.target"]
+:def rr const $ return $ unlines ["Ext.Common.killTrackedThreads",":r","Test.target"]

.github/workflows/build-macos-arm64.yml

@@ -22,6 +22,6 @@ jobs:
       - name: Run distribution script
         run: |
           test -x "$(which ghcup)" && curl https://downloads.haskell.org/~ghcup/aarch64-apple-darwin-ghcup -o ~/.local/bin/ghcup && chmod a+x ~/.local/bin/ghcup
-          brew install llvm@12
+          brew install llvm@13
           cd distribution
           ./build-macos-arm64.sh

.github/workflows/build-macos-x86_64.yml

@@ -22,6 +22,5 @@ jobs:
       - name: Run distribution script
         run: |
           test -x "$(which ghcup)" && curl https://downloads.haskell.org/~ghcup/aarch64-apple-darwin-ghcup -o ~/.local/bin/ghcup && chmod a+x ~/.local/bin/ghcup
-          brew install llvm@12
           cd distribution
           ./build-macos-x86_64.sh

.gitignore

@@ -17,3 +17,7 @@ extra/.cache
 # @TESTS
 elm-home
 
+# Jim
+experimental/
+.vscode/
+compiler.iml

distribution/build-macos-arm64.sh

@@ -36,7 +36,7 @@ git submodule init && git submodule update
 ffiLibs="$(xcrun --show-sdk-path)/usr/include/ffi"        # Workaround for GHC9.0.2 bug until we can use GHC9.2.3+
 export C_INCLUDE_PATH=$ffiLibs                            # https://gitlab.haskell.org/ghc/ghc/-/issues/20592#note_436353
 
-export PATH="/opt/homebrew/opt/llvm@12/bin:$PATH"         # The arm64 build currently requires llvm until we get to GHC 9.4+
+export PATH="/opt/homebrew/opt/llvm@13/bin:$PATH"         # The arm64 build currently requires llvm until we get to GHC 9.4+
 
 $stack install --local-bin-path $dist
 

elm.cabal

@@ -309,6 +309,9 @@ Executable lamdera
         Test.Wire
         Lamdera.Evergreen.TestMigrationHarness
         Lamdera.Evergreen.TestMigrationGenerator
+        Endpoint.Repl
+        Artifacts
+        Cors
 
 
         -- Debug helpers --
@@ -397,6 +400,7 @@ Executable lamdera
         -- Debug
         unicode-show,
         network-info,
+        network-uri,
 
         -- Future
         conduit-extra,

ext-sentry/Ext/Filewatch.hs

@@ -37,6 +37,7 @@ watch root action =
                 Modified f _ _ -> f
                 Removed f _ _ -> f
                 Unknown f _ _ _ -> f
+                _ -> error $ "unreachable:" ++ show e
 
           -- @TODO it would be better to not listen to these folders in the `watchTree` when available
           -- https://github.com/haskell-fswatch/hfsnotify/issues/101

extra/Cors.hs

@@ -0,0 +1,48 @@
+{-# OPTIONS_GHC -Wall #-}
+module Cors
+  ( allow
+  )
+  where
+
+
+import qualified Data.HashSet as HashSet
+import Network.URI (parseURI)
+import Snap.Core (Snap, Method, method)
+import Snap.Util.CORS (CORSOptions(..), HashableMethod(..), OriginList(Origins), applyCORS, mkOriginSet)
+
+
+
+-- ALLOW
+
+
+allow :: Method -> [String] -> Snap () -> Snap ()
+allow method_ origins snap =
+  applyCORS (toOptions method_ origins) $ method method_ $
+    snap
+
+
+
+-- TO OPTIONS
+
+
+toOptions :: (Monad m) => Method -> [String] -> CORSOptions m
+toOptions method_ origins =
+  let
+    allowedOrigins = toOriginList origins
+    allowedMethods = HashSet.singleton (HashableMethod method_)
+  in
+  CORSOptions
+    { corsAllowOrigin = return allowedOrigins
+    , corsAllowCredentials = return True
+    , corsExposeHeaders = return HashSet.empty
+    , corsAllowedMethods = return allowedMethods
+    , corsAllowedHeaders = return
+    }
+
+
+toOriginList :: [String] -> OriginList
+toOriginList origins =
+  Origins $ mkOriginSet $
+    case traverse parseURI origins of
+      Just uris -> uris
+      Nothing -> error "invalid entry given to toOriginList list"

extra/Endpoint/Package.hs

@@ -0,0 +1,126 @@
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE DeriveGeneric #-}
+
+module Endpoint.Package (handlePost, reportOnInstalledPackages) where
+
+{-
+  1.
+
+  This endpoint will respond to POST requests to "https://repl.lamdera.com/packageList"
+  with a JSON body of the form:
+  [
+    { "name": "elm/core", "version": "1.0.5" },
+    { "name": "elm/html", "version": "1.0.0" }
+  ]
+  It will write an elm.json file to the repl directory, and then reload the repl.
+  This response is mediate by function `handlePost` below.
+
+  2.
+
+  In additon, this endpoint will respond to GET requests to "https://repl.lamdera.com/reportOnInstalledPackages"
+  with a JSON body of the form:
+  [
+    { "name": "elm/core", "version": "1.0.5" },
+    { "name": "elm/html", "version": "1.0.0" }
+  ]
+  The json body reports on the packages that are currently installed in the repl.
+  This response is mediated by function `reportOnInstalledPackages` below.
+
+  NOTE.  handlePost and reportOnInstalledPackages
+         are referenced in the Snap webserver at Develop.runWithRoot
+         via the code fragments
+
+             SnapCore.path "packageList" $ Package.handlePost artifactRef)
+             SnapCore.path "reportOnInstalledPackages" $ Package.reportOnInstalledPackages)
+-}
+
+
+import GHC.Generics (Generic)
+import Snap.Core
+import Snap.Http.Server
+import Data.Aeson (FromJSON, eitherDecode, encode, ToJSON, toJSON, object, (.=))
+import Data.ByteString (ByteString)
+import Data.ByteString.Lazy (toStrict)
+import qualified Data.ByteString.Lazy.Char8 as BL
+import qualified Data.ByteString.Char8 as ByteString
+import GHC.Generics
+import System.IO (writeFile)
+import Control.Monad.IO.Class (liftIO)
+import qualified Data.Map as Map
+---
+import Snap.Util.FileServe
+import qualified Data.ByteString.Lazy as LBS
+import qualified Data.HashMap.Strict as HM
+import Data.Text.Encoding (decodeUtf8)
+import Snap.Http.Server.Config (setPort, defaultConfig)
+import qualified ReplArtifacts
+import Data.IORef
+
+
+data Package = Package { name :: String, version :: String } deriving (Show, Generic)
+
+instance FromJSON Package
+instance ToJSON Package
+
+
+type PackageList = [Package]
+
+writeElmJson :: PackageList -> IO ()
+writeElmJson pkgs = do
+    let directDeps = Map.fromList $ ("elm/core", "1.0.5"):[(name p, version p) | p <- pkgs]
+        elmJson = object [
+            "type" .= ("application" :: String),
+            "source-directories" .= (["../../repl-src"] :: [String]),
+            "elm-version" .= ("0.19.1" :: String),
+            "dependencies" .= object [
+                "direct" .= directDeps,
+                "indirect" .= object [
+                    "elm/json" .= ("1.1.3" :: String)
+                ]
+            ],
+            "test-dependencies" .= object [
+                "direct" .= (Map.empty :: Map.Map String String),
+                "indirect" .= (Map.empty :: Map.Map String String)
+            ]
+          ]
+    writeFile "./outlines/repl/elm.json" ( BL.unpack $ encode elmJson)
+
+
+handlePost :: IORef ReplArtifacts.Artifacts -> Snap ()
+handlePost artifactRef = do
+    body <- readRequestBody 10000
+    let maybePackageList = eitherDecode body :: Either String PackageList
+    case maybePackageList of
+        Left err -> writeBS $ "Error: Could not decode JSON: " <> (ByteString.pack err)
+        Right packages -> do
+            liftIO $ writeElmJson packages
+            let message = ByteString.pack $ "Packages added: " ++ (show $ length packages)
+            writeBS message
+            newArtifacts <- liftIO ReplArtifacts.loadRepl
+            liftIO $ writeIORef artifactRef newArtifacts
+
+
+
+data Dependencies = Dependencies {
+    direct :: HM.HashMap String String
+  } deriving (Generic, Show)
+
+data TopLevel = TopLevel {
+    dependencies :: Dependencies
+  } deriving (Generic, Show)
+
+instance FromJSON TopLevel
+
+instance FromJSON Dependencies
+
+--- curl -X POST -H "Content-Length: 0" http://localhost:8000/reportOnInstalledPackages
+
+reportOnInstalledPackages :: Snap ()
+reportOnInstalledPackages = do
+    jsonData <- liftIO $ LBS.readFile "./outlines/repl/elm.json"
+    case eitherDecode jsonData :: Either String TopLevel of
+        Left err -> writeBS $ "Failed to parse JSON: " <> (LBS.toStrict jsonData)
+        Right topLevel -> do
+            let directDeps = HM.toList $ direct $ dependencies topLevel
+            let outputList = map (\(name, version) -> object ["name" .= name, "version" .= version]) directDeps
+            writeBS . LBS.toStrict . encode $ outputList