Skip to content

Repl API #10

New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Open
wants to merge 35 commits into
base: lamdera-next
Choose a base branch
from
Open
Changes from all commits
Commits
Show all changes
35 commits
Select commit Hold shift + click to select a range
d8ae362
llvm@13 fixes local M1 build, try on buildserver
supermario Sep 11, 2023
15a7069
Patch in repl API functionality for elm-notebook exploration
supermario Sep 14, 2023
c097d3e
change alllowed origins to http://localhost:8007 only
jxxcarlson Sep 17, 2023
b2a2e56
Exclude Jim's experimental files
jxxcarlson Sep 17, 2023
e0d55f0
Change Test.hs so as to talk to elm-notebook
jxxcarlson Oct 2, 2023
7c8f310
Add debug statements
jxxcarlson Oct 2, 2023
8290dee
Added: '_ -> error $ "unreachable:" ++ show e' to function 'watch'. …
jxxcarlson Oct 2, 2023
fa3cfe3
I am committing this, but I can't see what has changed.
jxxcarlson Oct 2, 2023
441f1ce
Add elm-community/list-extra to outlines/repl/elm.json
jxxcarlson Oct 2, 2023
a27d4bb
Remove duplicate elm.json entries
jxxcarlson Oct 4, 2023
d591f19
Add module Endpoint.Package from extra/, (2) Chane Develop (in termin…
jxxcarlson Oct 5, 2023
d1d0cd9
Fix path for writing the elm.json file
jxxcarlson Oct 5, 2023
92c1c80
Fix stray space in word "dependencies"
jxxcarlson Oct 5, 2023
1e775be
Add type ElmPackage and decoder for it.
jxxcarlson Oct 5, 2023
9e57721
Return outlines/repl/elm.json to its original state
jxxcarlson Oct 5, 2023
c9af64d
Introduced a deterministic delay for executing Notebook.Package.nowSe…
jxxcarlson Oct 5, 2023
87727e6
When packages are added to elm.json, report to the client how many we…
jxxcarlson Oct 12, 2023
e544b92
Draft 1
jxxcarlson Oct 13, 2023
48def3e
Draft 2
jxxcarlson Oct 13, 2023
3391d5f
Fix JSON output
jxxcarlson Oct 13, 2023
b727101
Implement dynamic loading of packages submitted to the Elm compiler.
jxxcarlson Oct 14, 2023
8046918
Return outlines/repl/elm.json to its original state
jxxcarlson Oct 14, 2023
3935f9d
fix but in properly computng evalstate before compilation.
jxxcarlson Oct 15, 2023
effbe40
Add debug code to Endpoint/Repl.hs
jxxcarlson Oct 30, 2023
8a8a994
Add 'compiler.iml' to .gitignore
jxxcarlson Oct 30, 2023
bdf9ffc
Return to previous working state
jxxcarlson Oct 30, 2023
7d4f078
add back extra/Artifacts.hs
jxxcarlson Oct 30, 2023
be46c86
Restore elm.json to original state
jxxcarlson Oct 30, 2023
ac87fe8
Renamed: extra/Artifacts.hs -> extra/ReplArtifacts.hs
jxxcarlson Oct 30, 2023
dc1fbe5
Add comment explaining the purpose of module Package
jxxcarlson Oct 30, 2023
b422951
Add comments to explain the purpose and operation of extra/Endpoint/P…
jxxcarlson Oct 30, 2023
14b46e6
More comments
jxxcarlson Oct 30, 2023
20bb71e
Comments for ReplArtifacts
jxxcarlson Oct 30, 2023
9173633
Add clause 'Types.OnConnected sessionId clientId' to Backend.update:
jxxcarlson Jan 17, 2024
1505d77
Merge branch 'lamdera-next' into elm-notebook-repl
supermario Jan 23, 2024
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
4 changes: 4 additions & 0 deletions .gitignore
Original file line number Diff line number Diff line change
@@ -17,3 +17,7 @@ extra/.cache
# @TESTS
elm-home

# Jim
experimental/
.vscode/
compiler.iml
4 changes: 4 additions & 0 deletions elm.cabal
Original file line number Diff line number Diff line change
@@ -316,6 +316,9 @@ Executable lamdera
Test.WebGL
Lamdera.Evergreen.TestMigrationHarness
Lamdera.Evergreen.TestMigrationGenerator
Endpoint.Repl
Artifacts
Cors


-- Debug helpers --
@@ -408,6 +411,7 @@ Executable lamdera
-- Debug
unicode-show,
network-info,
network-uri,

-- Future
conduit-extra,
48 changes: 48 additions & 0 deletions extra/Cors.hs
Original file line number Diff line number Diff line change
@@ -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"
126 changes: 126 additions & 0 deletions extra/Endpoint/Package.hs
Original file line number Diff line number Diff line change
@@ -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

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

For testing the endpoint that returns a list of installed packages, for example:

curl -X POST -H "Content-Length: 0" http://localhost:8000/reportOnInstalledPackages
[{"name":"elm/parser","version":"1.1.0"},{"name":"elm/core","version":"1.0.5"}]

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

Should I not add comments explaining the purpose of this file?

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
304 changes: 304 additions & 0 deletions extra/Endpoint/Repl.hs
Original file line number Diff line number Diff line change
@@ -0,0 +1,304 @@
{-# OPTIONS_GHC -Wall #-}
{-# LANGUAGE OverloadedStrings #-}
module Endpoint.Repl
( endpoint
)
where

{-
The purpose of this endpoint is to provide a REPL for Elm that
is accessible via Http requests. The function `endpoint` of
this module is referenced in the Snap webserver at Develop.runWithRoot
via the code fragment
SnapCore.path "repl" $ Repl.endpoint artifactRef
Function decodeBodyHelp decodes incoming Json requests to the repl.
The Json data has the form
{ "imports": <dictionary of imports>,
"types": <dictionary of types>,
"decls": <dictionary of declarations>,
"entry": <string>
}
where the dictionaries are of the form
{ "name": <string>, "source": <string> }
and "entry" the string representation of the Elm
code to be evaluated.
Here is a typical incoming json object from a request to
evaluate `run (first int (symbol ".")) "42."`:
entry: "run (first int (symbol \".\")) \"42.\""
imports: Dict.fromList [("Parser","import Parser exposing(..)\n")]
decls: Dict.fromList [("first p q","first p q = p |> andThen (\s -> q |> map (\_ -> s))\n"))]
types: Dict.fromList []
NOTES.
1. Repl.endpoint defined here is called by the Snap server Develop.runWithRoot
via the code fragment
SnapCore.path "repl" $ Repl.endpoint artifactRef
2. The value of of artifactRef is set by
initialArtifacts <- ReplArtifacts.loadRepl
in `Develop.runWithRoot`.
3. If `endpoint artifactRef` successfully decodes the request, it
passes the resulting information to
toOutcome :: A.Artifacts -> Repl.State -> String -> Outcome
which in turn passes the information to `compile`. The result
of compilation is handed to `serveOutcome` which (at long last)
replies to the client's request.
-}

import Data.Aeson ((.:))
import qualified Data.Aeson as Aeson
import qualified Data.Aeson.Types as Aeson
import qualified Data.ByteString as BS
import qualified Data.ByteString.Builder as B
import qualified Data.ByteString.Lazy as LBS
import qualified Data.Map as Map
import Data.Map ((!))
import qualified Data.Map.Utils as Map
import qualified Data.Name as N
import qualified Data.NonEmptyList as NE
import Snap.Core
import qualified ReplArtifacts as A
import qualified Cors
import qualified AST.Source as Src
import qualified AST.Canonical as Can
import qualified AST.Optimized as Opt
import qualified Compile
import qualified Elm.Interface as I
import qualified Elm.ModuleName as ModuleName
import qualified Elm.Package as Pkg
import qualified File
import qualified Generate.JavaScript as JS
import qualified Json.Encode as Encode
import qualified Parse.Module as Parse
import qualified Repl
import qualified Reporting.Annotation as A
import qualified Reporting.Error as Error
import qualified Reporting.Error.Import as Import
import qualified Reporting.Exit as Exit
import qualified Reporting.Exit.Help as Help
import qualified Reporting.Render.Type.Localizer as L
import Lamdera as LA
import qualified Data.Text

import Data.IORef


-- ALLOWED ORIGINS


allowedOrigins :: [String]
allowedOrigins =
[ "http://localhost:8007"
]



-- ENDPOINT


endpoint :: IORef A.Artifacts -> Snap ()
endpoint artifactRef =
Cors.allow POST allowedOrigins $
do currentArtifacts <- liftIO $ readIORef artifactRef
body <- readRequestBody (64 * 1024)
case decodeBody body of
Just (state, entry) ->
serveOutcome (toOutcome currentArtifacts state entry)

Nothing ->
do modifyResponse $ setResponseStatus 400 "Bad Request"
modifyResponse $ setContentType "text/html; charset=utf-8"
writeBS "Received unexpected JSON body."



-- TO OUTCOME


data Outcome
= NewImport N.Name
| NewType N.Name
| NewWork B.Builder
--
| Skip
| Indent
| DefStart N.Name
--
| NoPorts
| InvalidCommand
| Failure BS.ByteString Error.Error


toOutcome :: A.Artifacts -> Repl.State -> String -> Outcome
toOutcome artifacts state entry =
case reverse (lines entry) of
[] ->
Skip

prev : rev ->
case Repl.categorize (Repl.Lines prev rev) of
Repl.Done input ->
case input of
Repl.Import name src -> compile artifacts state (ImportEntry name src)
Repl.Type name src -> compile artifacts state (TypeEntry name src)
Repl.Decl name src -> compile artifacts state (DeclEntry name src)
Repl.Expr src -> compile artifacts state (ExprEntry src)
Repl.Port -> NoPorts
Repl.Skip -> Skip
Repl.Reset -> InvalidCommand
Repl.Exit -> InvalidCommand
Repl.Help _ -> InvalidCommand

Repl.Continue prefill ->
case prefill of
Repl.Indent -> Indent
Repl.DefStart name -> DefStart name



-- SERVE OUTCOME


serveOutcome :: Outcome -> Snap ()
serveOutcome outcome =
let
serveString = serveBuilder "text/plain"
in
case outcome of
NewImport name -> serveString $ "add-import:" <> N.toBuilder name
NewType name -> serveString $ "add-type:" <> N.toBuilder name
NewWork js -> serveBuilder "application/javascript" js
Skip -> serveString $ "skip"
Indent -> serveString $ "indent"
DefStart name -> serveString $ "def-start:" <> N.toBuilder name
NoPorts -> serveString $ "no-ports"
InvalidCommand -> serveString $ "invalid-command"
Failure source err ->
serveBuilder "application/json" $ Encode.encodeUgly $ Exit.toJson $
Help.compilerReport "/" (Error.Module N.replModule "/repl" File.zeroTime source err) []


serveBuilder :: BS.ByteString -> B.Builder -> Snap ()
serveBuilder mime builder =
do modifyResponse (setContentType mime)
writeBuilder builder



-- COMPILE


data EntryType
= ImportEntry N.Name BS.ByteString
| TypeEntry N.Name BS.ByteString
| DeclEntry N.Name BS.ByteString
| ExprEntry BS.ByteString


compile :: A.Artifacts -> Repl.State -> EntryType -> Outcome
compile (A.Artifacts interfaces objects) state@(Repl.State imports types decls) entryType =
let
source =
case entryType of
ImportEntry name src -> Repl.toByteString (state { Repl._imports = Map.insert name (B.byteString src) imports }) Repl.OutputNothing
TypeEntry name src -> Repl.toByteString (state { Repl._types = Map.insert name (B.byteString src) types }) Repl.OutputNothing
DeclEntry name src -> Repl.toByteString (state { Repl._decls = Map.insert name (B.byteString src) decls }) (Repl.OutputDecl name)
ExprEntry src -> Repl.toByteString state (Repl.OutputExpr src)
in
case
do modul <- mapLeft Error.BadSyntax $ Parse.fromByteString Parse.Application (LA.debugPassText "@SOURCE" ( Data.Text.pack $ show source) $ source)
ifaces <- mapLeft Error.BadImports $ checkImports interfaces (Src._imports modul)
artifacts <- Compile.compile Pkg.dummyName ifaces modul
return ( modul, artifacts, objects )
of
Left err ->
Failure source err

Right info ->
case entryType of
ImportEntry name _ -> NewImport name
TypeEntry name _ -> NewType name
DeclEntry name _ -> NewWork (toJavaScript info (Just name))
ExprEntry _ -> NewWork (toJavaScript info Nothing)


toJavaScript :: (Src.Module, Compile.Artifacts, Opt.GlobalGraph) -> Maybe N.Name -> B.Builder
toJavaScript (modul, Compile.Artifacts canModule types locals, objects) maybeName =
let
localizer = L.fromModule modul
graph = Opt.addLocalGraph locals objects
home = Can._name canModule
tipe = types ! maybe N.replValueToPrint id maybeName
in
JS.generateForReplEndpoint localizer graph home maybeName tipe


mapLeft :: (x -> y) -> Either x a -> Either y a
mapLeft func result =
either (Left . func) Right result


checkImports :: Map.Map ModuleName.Raw I.Interface -> [Src.Import] -> Either (NE.List Import.Error) (Map.Map ModuleName.Raw I.Interface)
checkImports interfaces imports =
let
importDict = Map.fromValues Src.getImportName imports
missing = Map.difference importDict interfaces
in
case Map.elems missing of
[] ->
Right (Map.intersection interfaces importDict)

i:is ->
let
unimported =
Map.keysSet (Map.difference interfaces importDict)

toError (Src.Import (A.At region name) _ _) =
Import.Error region name unimported Import.NotFound
in
Left (fmap toError (NE.List i is))



-- DECODE BODY


decodeBody :: LBS.ByteString -> Maybe ( Repl.State, String )
decodeBody body =
case Aeson.eitherDecode body of
Right obj ->
Aeson.parseMaybe decodeBodyHelp obj
Left err ->
error $ show err


decodeBodyHelp :: Aeson.Object -> Aeson.Parser ( Repl.State, String )
decodeBodyHelp obj =
let
get key =
do dict <- obj .: key
let f (k,v) = (N.fromChars k, B.stringUtf8 v)
return $ Map.fromList $ map f $ Map.toList dict
in
do imports <- get "imports"
types <- get "types"
decls <- get "decls"
entry <- obj .: "entry"
return ( Repl.State imports types decls, entry )
161 changes: 161 additions & 0 deletions extra/ReplArtifacts.hs
Original file line number Diff line number Diff line change
@@ -0,0 +1,161 @@
{-# OPTIONS_GHC -Wall #-}
module ReplArtifacts
( Artifacts(..)
, loadCompile
, loadRepl
, toDepsInfo
)
where

{-
load artifacts for /extra/Endpoint/Repl. See note (2) in that file.
-}


import Control.Concurrent (readMVar)
import Control.Monad (liftM2)
import qualified Data.ByteString as BS
import qualified Data.ByteString.Builder as B
import qualified Data.ByteString.Lazy as LBS
import qualified Data.Map as Map
import qualified Data.Name as N
import qualified Data.OneOrMore as OneOrMore
import qualified System.Directory as Dir
import System.FilePath ((</>))

import qualified AST.Canonical as Can
import qualified AST.Optimized as Opt
import qualified BackgroundWriter as BW
import qualified Elm.Details as Details
import qualified Elm.Interface as I
import qualified Elm.ModuleName as ModuleName
import qualified Elm.Package as Pkg
import Json.Encode ((==>))
import qualified Json.Encode as E
import qualified Json.String as Json
import qualified Reporting



-- ARTIFACTS


data Artifacts =
Artifacts
{ _ifaces :: Map.Map ModuleName.Raw I.Interface
, _graph :: Opt.GlobalGraph
}


loadCompile :: IO Artifacts
loadCompile =
load ("outlines" </> "compile")


loadRepl :: IO Artifacts
loadRepl =
load ("outlines" </> "repl")



-- LOAD


load :: FilePath -> IO Artifacts
load dir =
BW.withScope $ \scope ->
do putStrLn $ "Loading " ++ dir </> "elm.json"
style <- Reporting.terminal
root <- fmap (</> dir) Dir.getCurrentDirectory
result <- Details.load style scope root
case result of
Left _ ->
error $ "Ran into some problem loading elm.json\nTry running `lamdera make` in: " ++ dir

Right details ->
do omvar <- Details.loadObjects root details
imvar <- Details.loadInterfaces root details
mdeps <- readMVar imvar
mobjs <- readMVar omvar
case liftM2 (,) mdeps mobjs of
Nothing ->
error $ "Ran into some weird problem loading elm.json\nTry running `lamdera make` in: " ++ dir

Just (deps, objs) ->
return $ Artifacts (toInterfaces deps) objs


toInterfaces :: Map.Map ModuleName.Canonical I.DependencyInterface -> Map.Map ModuleName.Raw I.Interface
toInterfaces deps =
Map.mapMaybe toUnique $ Map.fromListWith OneOrMore.more $
Map.elems (Map.mapMaybeWithKey getPublic deps)


getPublic :: ModuleName.Canonical -> I.DependencyInterface -> Maybe (ModuleName.Raw, OneOrMore.OneOrMore I.Interface)
getPublic (ModuleName.Canonical _ name) dep =
case dep of
I.Public iface -> Just (name, OneOrMore.one iface)
I.Private _ _ _ -> Nothing


toUnique :: OneOrMore.OneOrMore a -> Maybe a
toUnique oneOrMore =
case oneOrMore of
OneOrMore.One value -> Just value
OneOrMore.More _ _ -> Nothing



-- TO DEPS INFO


toDepsInfo :: Artifacts -> BS.ByteString
toDepsInfo (Artifacts ifaces _) =
LBS.toStrict $ B.toLazyByteString $ E.encodeUgly $ encode ifaces



-- ENCODE


encode :: Map.Map ModuleName.Raw I.Interface -> E.Value
encode ifaces =
E.dict Json.fromName encodeInterface ifaces


encodeInterface :: I.Interface -> E.Value
encodeInterface (I.Interface pkg values unions aliases binops) =
E.object
[ "pkg" ==> E.chars (Pkg.toChars pkg)
, "ops" ==> E.list E.name (Map.keys binops)
, "values" ==> E.list E.name (Map.keys values)
, "aliases" ==> E.list E.name (Map.keys (Map.filter isPublicAlias aliases))
, "types" ==> E.dict Json.fromName (E.list E.name) (Map.mapMaybe toPublicUnion unions)
]


isPublicAlias :: I.Alias -> Bool
isPublicAlias alias =
case alias of
I.PublicAlias _ -> True
I.PrivateAlias _ -> False


toPublicUnion :: I.Union -> Maybe [N.Name]
toPublicUnion union =
case union of
I.OpenUnion (Can.Union _ variants _ _) ->
Just (map getVariantName variants)

I.ClosedUnion _ ->
Just []

I.PrivateUnion _ ->
Nothing


getVariantName :: Can.Ctor -> N.Name
getVariantName (Can.Ctor name _ _ _) =
name
1 change: 1 addition & 0 deletions outlines/repl/elm.json
Original file line number Diff line number Diff line change
@@ -0,0 +1 @@
{"dependencies":{"direct":{"elm/core":"1.0.5","zwilias/elm-rosetree":"1.5.0"},"indirect":{"elm/json":"1.1.3"}},"elm-version":"0.19.1","source-directories":["../../repl-src"],"test-dependencies":{"direct":{},"indirect":{}},"type":"application"}
Empty file added repl-src/.keep
Empty file.
18 changes: 18 additions & 0 deletions terminal/src/Develop.hs
Original file line number Diff line number Diff line change
@@ -22,6 +22,7 @@ import qualified Data.NonEmptyList as NE
import qualified System.Directory as Dir
import System.FilePath as FP
import Snap.Core hiding (path)
import qualified Snap.Core as SnapCore
import Snap.Http.Server
import Snap.Util.FileServe

@@ -54,6 +55,12 @@ import Control.Concurrent.STM (atomically, newTVarIO, readTVar, writeTVar, TVar)

import StandaloneInstances

import qualified ReplArtifacts
import qualified Endpoint.Repl as Repl
import qualified Endpoint.Package as Package

import Data.IORef

-- RUN THE DEV SERVER


@@ -69,6 +76,7 @@ run () flags = do
Dir.setCurrentDirectory root
runWithRoot root flags

-- currentArtifacts <- liftIO $ readIORef artifactRef

runWithRoot :: FilePath -> Flags -> IO ()
runWithRoot root (Flags maybePort) =
@@ -87,6 +95,10 @@ runWithRoot root (Flags maybePort) =

sentryCache <- liftIO $ Sentry.init

initialArtifacts <- ReplArtifacts.loadRepl
artifactRef <- newIORef initialArtifacts


let
recompile :: [String] -> IO ()
recompile events = do
@@ -121,6 +133,9 @@ runWithRoot root (Flags maybePort) =

Lamdera.ReverseProxy.start

initialArtifacts <- ReplArtifacts.loadRepl
artifactRef <- newIORef initialArtifacts

Live.withEnd liveState $
httpServe (config port) $ gcatchlog "general" $
-- Add /public/* as if it were /* to mirror production, but still render .elm files as an Elm app first
@@ -135,6 +150,9 @@ runWithRoot root (Flags maybePort) =
<|> route [ ("_r/:endpoint", Live.serveRpc liveState port) ]
<|> Live.openEditorHandler root
<|> Live.serveExperimental root
<|> (SnapCore.path "repl" $ Repl.endpoint artifactRef)
<|> (SnapCore.path "packageList" $ Package.handlePost artifactRef)
<|> (SnapCore.path "reportOnInstalledPackages" $ Package.reportOnInstalledPackages)
Copy link
Member Author

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

Now that we know what's needed here, I think it might be nice to namespace this as follows:

  • repl think it makes sense to rename this torepl/js - the repl endpoint specifically for generating JS, because maybe we'll have other modes in future
  • packageList -> repl/setPackages assuming this better reflects what this endpoint does? But now thinking of it, it probably makes sense for this functionality to be merged into repl/js – so you can specify the packages and what you want to compile in one hit, avoiding a race condition if different people want to set different packages and compile different files simultaneously?
  • reportOnInstalledPackages thus probably also should get merged, or maybe it's not longer required if we can be sure the packages we specify will be the context our Elm will get compiled in?

<|> serveAssets -- Compiler packaged static files
<|> Live.serveUnmatchedUrlsToIndex root (serveElm sentryCache) -- Everything else without extensions goes to Lamdera LocalDev harness
<|> error404 -- Will get hit for any non-matching extensioned paths i.e. /hello.blah
2 changes: 1 addition & 1 deletion worker/elm.cabal
Original file line number Diff line number Diff line change
@@ -49,7 +49,7 @@ Executable worker
Main.hs

other-modules:
Artifacts
ReplArtifacts
Cors
Endpoint.Compile
Endpoint.Donate
1 change: 1 addition & 0 deletions worker/src/Endpoint/Compile.hs
Original file line number Diff line number Diff line change
@@ -59,6 +59,7 @@ allowedOrigins :: [String]
allowedOrigins =
[ "https://elm-lang.org"
, "https://package.elm-lang.org"
,"http://localhost:8007"
]