From 0bd14e29e67b43d9252bdaab1d4acba3a23ffa30 Mon Sep 17 00:00:00 2001 From: Thomas Honeyman Date: Tue, 27 Apr 2021 19:38:38 -0700 Subject: [PATCH] Migrate to Halogen (#215) --- client/package.json | 1 + client/packages.dhall | 140 ++-------- client/public/css/index.css | 1 + client/public/index.html | 263 ++++++------------- client/spago.dhall | 10 +- client/src/JQuery/Extras.js | 47 ---- client/src/JQuery/Extras.purs | 40 --- client/src/Main.js | 8 - client/src/Main.purs | 310 +--------------------- client/src/Try/API.purs | 5 +- client/src/Try/Container.js | 4 + client/src/Try/Container.purs | 469 ++++++++++++++++++++++++++++++++++ client/src/Try/Editor.purs | 208 +++++++++++++++ client/src/Try/Session.purs | 22 +- 14 files changed, 794 insertions(+), 734 deletions(-) delete mode 100644 client/src/JQuery/Extras.js delete mode 100644 client/src/JQuery/Extras.purs delete mode 100644 client/src/Main.js create mode 100644 client/src/Try/Container.js create mode 100644 client/src/Try/Container.purs create mode 100644 client/src/Try/Editor.purs diff --git a/client/package.json b/client/package.json index 77c2018a..fc071535 100644 --- a/client/package.json +++ b/client/package.json @@ -5,6 +5,7 @@ "clean": "rimraf output", "test": "spago test --path config/dev/Try.Config.purs", "build": "spago build --path config/dev/Try.Config.purs", + "build:dev": "spago bundle-app --path config/dev/Try.Config.purs --to public/js/index.js", "build:production": "spago bundle-app --path config/prod/Try.Config.purs --purs-args '--censor-lib --strict' --to public/js/index.js" }, "devDependencies": { diff --git a/client/packages.dhall b/client/packages.dhall index d293079b..75331a36 100644 --- a/client/packages.dhall +++ b/client/packages.dhall @@ -1,128 +1,22 @@ -{- -Welcome to your new Dhall package-set! - -Below are instructions for how to edit this file for most use -cases, so that you don't need to know Dhall to use it. - -## Warning: Don't Move This Top-Level Comment! - -Due to how `dhall format` currently works, this comment's -instructions cannot appear near corresponding sections below -because `dhall format` will delete the comment. However, -it will not delete a top-level comment like this one. - -## Use Cases - -Most will want to do one or both of these options: -1. Override/Patch a package's dependency -2. Add a package not already in the default package set - -This file will continue to work whether you use one or both options. -Instructions for each option are explained below. - -### Overriding/Patching a package - -Purpose: -- Change a package's dependency to a newer/older release than the - default package set's release -- Use your own modified version of some dependency that may - include new API, changed API, removed API by - using your custom git repo of the library rather than - the package set's repo - -Syntax: -Replace the overrides' "{=}" (an empty record) with the following idea -The "//" or "⫽" means "merge these two records and - when they have the same value, use the one on the right:" -------------------------------- -let overrides = - { packageName = - upstream.packageName // { updateEntity1 = "new value", updateEntity2 = "new value" } - , packageName = - upstream.packageName // { version = "v4.0.0" } - , packageName = - upstream.packageName // { repo = "https://www.example.com/path/to/new/repo.git" } - } -------------------------------- - -Example: -------------------------------- -let overrides = - { halogen = - upstream.halogen // { version = "master" } - , halogen-vdom = - upstream.halogen-vdom // { version = "v4.0.0" } - } -------------------------------- - -### Additions - -Purpose: -- Add packages that aren't already included in the default package set - -Syntax: -Replace the additions' "{=}" (an empty record) with the following idea: -------------------------------- -let additions = - { package-name = - { dependencies = - [ "dependency1" - , "dependency2" - ] - , repo = - "https://example.com/path/to/git/repo.git" - , version = - "tag ('v4.0.0') or branch ('master')" - } - , package-name = - { dependencies = - [ "dependency1" - , "dependency2" - ] - , repo = - "https://example.com/path/to/git/repo.git" - , version = - "tag ('v4.0.0') or branch ('master')" - } - , etc. - } -------------------------------- +let upstream = + https://github.com/purescript/package-sets/releases/download/psc-0.13.6-20200404/packages.dhall sha256:f239f2e215d0cbd5c203307701748581938f74c4c78f4aeffa32c11c131ef7b6 -Example: -------------------------------- let additions = - { benchotron = - { dependencies = + { ace = + { repo = "https://github.com/purescript-contrib/purescript-ace.git" + , version = "v7.0.0" + , dependencies = [ "arrays" - , "exists" - , "profunctor" - , "strings" - , "quickcheck" - , "lcg" - , "transformers" - , "foldable-traversable" - , "exceptions" - , "node-fs" - , "node-buffer" - , "node-readline" - , "datetime" - , "now" + , "console" + , "effect" + , "foreign" + , "nullable" + , "prelude" + , "refs" + , "web-html" + , "web-uievents" ] - , repo = - "https://github.com/hdgarrood/purescript-benchotron.git" - , version = - "v7.0.0" - } - } -------------------------------- --} - - -let upstream = - https://github.com/purescript/package-sets/releases/download/psc-0.13.6-20200404/packages.dhall sha256:f239f2e215d0cbd5c203307701748581938f74c4c78f4aeffa32c11c131ef7b6 - -let overrides = {=} - -let additions = {=} + } + } -in upstream // overrides // additions +in upstream // additions diff --git a/client/public/css/index.css b/client/public/css/index.css index 1c2b202c..51f7e363 100644 --- a/client/public/css/index.css +++ b/client/public/css/index.css @@ -181,6 +181,7 @@ body { left: 0; right: 0; bottom: 0; + font-size: 13px; } .separator { diff --git a/client/public/index.html b/client/public/index.html index 328a50eb..e9cfef39 100644 --- a/client/public/index.html +++ b/client/public/index.html @@ -1,197 +1,78 @@ - + - - Try PureScript! - - - - - - - - - - - - - - - - - - -
-
- - -
- Your screen size is too small. Code editing has been disabled. -
- -
-
- -
-
- -
- -
-
- -
-
-
-
-
-
-
- - + + + + + + + + + + - - + + + diff --git a/client/spago.dhall b/client/spago.dhall index 2d1e8b70..d8c65090 100644 --- a/client/spago.dhall +++ b/client/spago.dhall @@ -1,10 +1,7 @@ -{- -Welcome to a Spago project! -You can edit this file as you like. --} { name = "try-purescript" , dependencies = - [ "aff" + [ "ace" + , "aff" , "affjax" , "argonaut-codecs" , "arrays" @@ -21,11 +18,10 @@ You can edit this file as you like. , "foreign-object" , "functions" , "functors" - , "generics-rep" , "globals" + , "halogen" , "identity" , "integers" - , "jquery" , "js-timers" , "math" , "maybe" diff --git a/client/src/JQuery/Extras.js b/client/src/JQuery/Extras.js deleted file mode 100644 index 2d42098e..00000000 --- a/client/src/JQuery/Extras.js +++ /dev/null @@ -1,47 +0,0 @@ -"use strict"; - -exports.click = function(jq) { - return function() { - jq.click(); - }; -}; - -exports.empty = function(jq) { - return function() { - jq.empty(); - }; -}; - -exports.fadeIn = function(jq) { - return function() { - jq.fadeIn(); - }; -}; - -exports.fadeOut = function(jq) { - return function() { - jq.fadeOut(); - }; -}; - -exports.filter = function(jq) { - return function(sel) { - return function() { - return jq.filter(sel); - }; - }; -}; - -exports.is = function(jq) { - return function(sel) { - return function() { - return jq.is(sel); - }; - }; -}; - -exports.getValue = function(jq) { - return function() { - return jq.val(); - }; -}; diff --git a/client/src/JQuery/Extras.purs b/client/src/JQuery/Extras.purs deleted file mode 100644 index 4602893f..00000000 --- a/client/src/JQuery/Extras.purs +++ /dev/null @@ -1,40 +0,0 @@ -module JQuery.Extras - ( click - , empty - , fadeIn - , fadeOut - , filter - , is - , getValueMaybe - ) where - -import Prelude - -import Data.Maybe (Maybe) -import Data.Nullable (Nullable, toMaybe) -import Effect (Effect) -import JQuery (JQuery, Selector) - --- | Simulate a click event on the specified element. -foreign import click :: JQuery -> Effect Unit - --- | Remove all elements from the specified container element. -foreign import empty :: JQuery -> Effect Unit - --- | Fade in an element. -foreign import fadeIn :: JQuery -> Effect Unit - --- | Fade out an element. -foreign import fadeOut :: JQuery -> Effect Unit - --- | Filter elements based on an additional selector. -foreign import filter :: JQuery -> Selector -> Effect JQuery - --- | Test whether elements match an additional selector. -foreign import is :: JQuery -> Selector -> Effect Boolean - --- | Get the value of the first element, if it exists. -foreign import getValue :: JQuery -> Effect (Nullable String) - -getValueMaybe :: JQuery -> Effect (Maybe String) -getValueMaybe = map toMaybe <<< getValue diff --git a/client/src/Main.js b/client/src/Main.js deleted file mode 100644 index 7c9d6860..00000000 --- a/client/src/Main.js +++ /dev/null @@ -1,8 +0,0 @@ -"use strict"; - -exports.setEditorContent = setEditorContent; -exports.onEditorChanged = onEditorChanged; -exports.cleanUpMarkers = cleanUpMarkers; -exports.addMarker = addMarker; -exports.setAnnotations = setAnnotations; -exports.setupIFrame = setupIFrame; diff --git a/client/src/Main.purs b/client/src/Main.purs index c7f04979..8c3d781c 100644 --- a/client/src/Main.purs +++ b/client/src/Main.purs @@ -2,309 +2,13 @@ module Main where import Prelude -import Control.Monad.Except.Trans (runExceptT) -import Data.Array (mapMaybe) -import Data.Array as Array -import Data.Either (Either(..)) -import Data.Foldable (elem, fold, for_, intercalate) -import Data.FoldableWithIndex (forWithIndex_) -import Data.Maybe (Maybe(..), fromMaybe) import Effect (Effect) -import Effect.Aff (Aff, launchAff_) -import Effect.Class (liftEffect) -import Effect.Console (error) -import Effect.Uncurried (EffectFn1, EffectFn2, EffectFn5, mkEffectFn1, runEffectFn1, runEffectFn2, runEffectFn5) -import Foreign.Object (Object) -import Foreign.Object as Object -import JQuery as JQuery -import JQuery.Extras as JQueryExtras -import Try.API (CompileError(..), CompileResult(..), CompilerError) -import Try.API as API -import Try.Config as Config -import Try.Gist (getGistById, tryLoadFileFromGist, uploadGist) -import Try.Loader (Loader, makeLoader, runLoader) -import Try.QueryString (getQueryStringMaybe, setQueryStrings) -import Try.Session (createSessionIdIfNecessary, storeSession, tryRetrieveSession) -import Try.Types (JS(..)) -import Web.HTML (window) -import Web.HTML.Location (setHref) -import Web.HTML.Window (alert, confirm, location) - -displayLoadingMessage :: Effect Unit -displayLoadingMessage = JQuery.select "#loading" >>= JQueryExtras.fadeIn - -hideLoadingMessage :: Effect Unit -hideLoadingMessage = JQuery.select "#loading" >>= JQueryExtras.fadeOut - --- | Display a list of errors in the right hand column. -displayErrors :: Array CompilerError -> Effect Unit -displayErrors errs = do - column2 <- JQuery.select "#column2" - JQueryExtras.empty column2 - - forWithIndex_ errs \i { message } -> do - h1 <- JQuery.create "

" - JQuery.addClass "error-banner" h1 - JQuery.setText ("Error " <> show (i + 1) <> " of " <> show (Array.length errs)) h1 - - pre <- JQuery.create "
"
-    code_ <- JQuery.create ""
-    JQuery.append code_ pre
-    JQuery.setText message code_
-
-    JQuery.append h1 column2
-    JQuery.append pre column2
-
--- | Display plain text in the right hand column.
-displayPlainText
-  :: String
-  -> Effect Unit
-displayPlainText s = do
-  column2 <- JQuery.select "#column2"
-  JQueryExtras.empty column2
-  pre <- JQuery.create "
"
-  code_ <- JQuery.create ""
-  JQuery.append code_ pre
-  JQuery.setText s code_
-  JQuery.append pre column2
-
-isShowJsChecked :: Effect Boolean
-isShowJsChecked = JQuery.select "#showjs" >>= \jq -> JQueryExtras.is jq ":checked"
-
-isAutoCompileChecked :: Effect Boolean
-isAutoCompileChecked = JQuery.select "#auto_compile" >>= \jq -> JQueryExtras.is jq ":checked"
-
--- | Update the view mode based on the menu selection
-changeViewMode :: Maybe String -> Effect Unit
-changeViewMode viewMode =
-  for_ viewMode \viewMode_ ->
-    JQuery.select "#editor_view" >>= JQuery.setAttr "data-view-mode" viewMode_
-
-getTextAreaContent :: Effect String
-getTextAreaContent = fold <$> (JQuery.select "#code_textarea" >>= JQueryExtras.getValueMaybe)
-
-setTextAreaContent :: String -> Effect Unit
-setTextAreaContent value = JQuery.select "#code_textarea" >>= JQuery.setValue value
-
--- | Set the editor content to the specified string.
-foreign import setEditorContent :: EffectFn1 String Unit
-
--- | Register a callback for editor change events.
-foreign import onEditorChanged
-  :: EffectFn2 (EffectFn1 String Unit)
-               Int
-               Unit
-
--- | Clean up any global state associated with any visible error markers.
-foreign import cleanUpMarkers :: Effect Unit
-
--- | Add a visible marker at the specified location.
-foreign import addMarker :: EffectFn5 String Int Int Int Int Unit
-
-type Annotation =
-  { row :: Int
-  , column :: Int
-  , type :: String
-  , text :: String
-  }
-
--- | Set the gutter annotations
-foreign import setAnnotations :: EffectFn1 (Array Annotation) Unit
-
-clearAnnotations :: Effect Unit
-clearAnnotations = runEffectFn1 setAnnotations []
-
--- | Set up a fresh iframe in the specified container, and use it
--- | to execute the provided JavaScript code.
-foreign import setupIFrame
-  :: EffectFn2 JQuery.JQuery
-               (Object JS)
-               Unit
-
-loader :: Loader
-loader = makeLoader Config.loaderUrl
-
--- | Compile the current code and execute it.
-compile :: Effect Unit
-compile = do
-  code <- getTextAreaContent
-
-  displayLoadingMessage
-  clearAnnotations
-
-  launchAff_ $ runExceptT (API.compile Config.compileUrl code) >>= \res_ ->
-    case res_ of
-      Left err -> liftEffect $ displayPlainText err
-      Right res -> do
-        liftEffect cleanUpMarkers
-
-        case res of
-          Left err -> liftEffect do
-            hideLoadingMessage
-            displayPlainText "Unable to parse the response from the server"
-            error err
-          Right (CompileSuccess { js, warnings }) -> do
-            showJs <- liftEffect isShowJsChecked
-            if showJs then liftEffect do
-              hideLoadingMessage
-              displayPlainText js
-            else do
-              sources <- runExceptT $ runLoader loader (JS js)
-              liftEffect hideLoadingMessage
-              for_ warnings \warnings_ -> liftEffect do
-                let
-                  toAnnotation { errorCode, position, message } =
-                    position <#> \pos ->
-                      { row: pos.startLine - 1
-                      , column: pos.startColumn - 1
-                      , type: "warning"
-                      , text: message
-                      }
-                runEffectFn1 setAnnotations (mapMaybe toAnnotation warnings_)
-              for_ sources (liftEffect <<< execute (JS js))
-          Right (CompileFailed { error }) -> liftEffect do
-            hideLoadingMessage
-            case error of
-              CompilerErrors errs -> do
-                displayErrors errs
-                let
-                  toAnnotation { position, message } =
-                    position <#> \pos ->
-                      { row: pos.startLine - 1
-                      , column: pos.startColumn - 1
-                      , type: "error"
-                      , text: message
-                      }
-                runEffectFn1 setAnnotations (mapMaybe toAnnotation errs)
-                for_ errs \{ position } ->
-                  for_ position \pos ->
-                    runEffectFn5 addMarker
-                      "error"
-                      pos.startLine
-                      pos.startColumn
-                      pos.endLine
-                      pos.endColumn
-              OtherError err -> displayPlainText err
-
--- | Execute the compiled code in a new iframe.
-execute :: JS -> Object JS -> Effect Unit
-execute js modules = do
-  let eventData = Object.insert "" js modules
-  column2 <- JQuery.select "#column2"
-  runEffectFn2 setupIFrame column2 eventData
-
--- | Setup the editor component and some event handlers.
-setupEditor :: forall r. { code :: String | r } -> Effect Unit
-setupEditor { code } = do
-  loadOptions
-  setTextAreaContent code
-  runEffectFn1 setEditorContent code
-
-  runEffectFn2 onEditorChanged (mkEffectFn1 \value -> do
-    setTextAreaContent value
-    cacheCurrentCode
-    autoCompile <- isAutoCompileChecked
-    when autoCompile do
-      compile) 750
-
-  JQuery.select "#showjs" >>= JQuery.on "change" \e _ ->
-    compile
-
-  JQuery.select "#compile_label" >>= JQuery.on "click" \e _ ->
-    compile
-
-  JQuery.select "#gist_save" >>= JQuery.on "click" \e _ ->
-    launchAff_ publishNewGist
-
-  compile
-  cacheCurrentCode
-
-loadFromGist
-  :: String
-  -> Aff { code :: String }
-loadFromGist id = do
-  runExceptT (getGistById id >>= \gi -> tryLoadFileFromGist gi "Main.purs") >>= case _ of
-    Left err -> do
-      liftEffect $ window >>= alert err
-      pure { code: "" }
-    Right code ->
-      pure { code }
-
-withSession
-  :: String
-  -> Aff { code :: String }
-withSession sessionId = do
-  state <- liftEffect $ tryRetrieveSession sessionId
-  case state of
-    Just state' -> pure state'
-    Nothing -> do
-      gist <- liftEffect $ fromMaybe Config.mainGist <$> getQueryStringMaybe "gist"
-      loadFromGist gist
-
--- | Cache the current code in the session state
-cacheCurrentCode :: Effect Unit
-cacheCurrentCode  = do
-  sessionId <- getQueryStringMaybe "session"
-  case sessionId of
-    Just sessionId_ -> do
-      code <- getTextAreaContent
-      storeSession sessionId_ { code }
-    Nothing -> error "No session ID"
-
--- | Create a new Gist using the current content
-publishNewGist :: Aff Unit
-publishNewGist = do
-  ok <- liftEffect $ window >>= confirm (intercalate "\n"
-          [ "Do you really want to publish this code as an anonymous Gist?"
-          , ""
-          , "Note: this code will be available to anyone with a link to the Gist."
-          ])
-  when ok do
-    content <- liftEffect $ getTextAreaContent
-    runExceptT (uploadGist content) >>= case _ of
-      Left err -> liftEffect do
-        window >>= alert "Failed to create gist"
-        error ("Failed to create gist: " <> err)
-      Right gistId -> liftEffect do
-        setQueryStrings (Object.singleton "gist" gistId)
-
--- | Navigate to the specified URL.
-navigateTo :: String -> Effect Unit
-navigateTo uri = void (window >>= location >>= setHref uri)
-
--- | Read query string options and update the state accordingly
-loadOptions :: Effect Unit
-loadOptions = do
-  viewMode <- getQueryStringMaybe "view"
-  case viewMode of
-    Just viewMode_
-      | viewMode_ `elem` ["sidebyside", "code", "output"]
-      -> changeViewMode viewMode
-    _ -> pure unit
-
-  showJs <- getQueryStringMaybe "js"
-  case showJs of
-    Just showJs_ ->
-      JQuery.select "input:checkbox[name=showjs]" >>= JQuery.setProp "checked" (showJs_ == "true")
-    _ -> pure unit
-
-  autoCompile <- getQueryStringMaybe "compile"
-  case autoCompile of
-    Just autoCompile_ ->
-      JQuery.select "input:checkbox[name=auto_compile]" >>= JQuery.setProp "checked" (autoCompile_ == "true")
-    _ -> pure unit
-
-  gist <- getQueryStringMaybe "gist"
-  case gist of
-    Just gist_ -> JQuery.select ".view_gist" >>= JQuery.attr { href: "https://gist.github.com/" <> gist_ }
-    Nothing -> JQuery.select ".view_gist_li" >>= JQuery.hide
+import Effect.Aff (launchAff_)
+import Halogen.Aff as HA
+import Halogen.VDom.Driver (runUI)
+import Try.Container as Container
 
 main :: Effect Unit
-main = JQuery.ready do
-  JQuery.select "input[name=view_mode]" >>= JQuery.on "change" \_ jq -> do
-    viewMode <- JQueryExtras.filter jq ":checked" >>= JQueryExtras.getValueMaybe
-    changeViewMode viewMode
-
-  createSessionIdIfNecessary \sessionId -> launchAff_ do
-    code <- withSession sessionId
-    liftEffect $ setupEditor code
+main = launchAff_ do
+  body <- HA.awaitBody
+  runUI Container.component unit body
diff --git a/client/src/Try/API.purs b/client/src/Try/API.purs
index 5c2e2145..afe533c6 100644
--- a/client/src/Try/API.purs
+++ b/client/src/Try/API.purs
@@ -25,6 +25,7 @@ import Data.Either (Either(..))
 import Data.Maybe (Maybe(..))
 import Data.Traversable (traverse)
 import Effect.Aff (Aff)
+import Effect.Aff.Class (class MonadAff, liftAff)
 
 -- | The range of text associated with an error
 type ErrorPosition =
@@ -97,8 +98,8 @@ get url = ExceptT $ AX.get AXRF.string url >>= case _ of
     pure $ Right body
 
 -- | POST the specified code to the Try PureScript API, and wait for a response.
-compile :: String -> String -> ExceptT String Aff (Either String CompileResult)
-compile endpoint code = ExceptT $ AX.post AXRF.json (endpoint <> "/compile") requestBody >>= case _ of
+compile :: forall m. MonadAff m => String -> String -> ExceptT String m (Either String CompileResult)
+compile endpoint code = ExceptT $ liftAff $ AX.post AXRF.json (endpoint <> "/compile") requestBody >>= case _ of
   Left e ->
     pure $ Left $ printError e
   Right { status } | status >= StatusCode 400 ->
diff --git a/client/src/Try/Container.js b/client/src/Try/Container.js
new file mode 100644
index 00000000..8c26089e
--- /dev/null
+++ b/client/src/Try/Container.js
@@ -0,0 +1,4 @@
+"use strict";
+
+exports.setupIFrame = setupIFrame;
+exports.teardownIFrame = teardownIFrame;
diff --git a/client/src/Try/Container.purs b/client/src/Try/Container.purs
new file mode 100644
index 00000000..69caa46a
--- /dev/null
+++ b/client/src/Try/Container.purs
@@ -0,0 +1,469 @@
+module Try.Container where
+
+import Prelude
+
+import Ace (Annotation)
+import Control.Monad.Except (runExceptT)
+import Data.Array (fold)
+import Data.Array as Array
+import Data.Either (Either(..), hush)
+import Data.Foldable (for_)
+import Data.FoldableWithIndex (foldMapWithIndex)
+import Data.Maybe (Maybe(..), fromMaybe, isNothing)
+import Data.Symbol (SProxy(..))
+import Effect (Effect)
+import Effect.Aff (Aff)
+import Effect.Class.Console (error)
+import Effect.Uncurried (EffectFn1, runEffectFn1)
+import Foreign.Object (Object)
+import Foreign.Object as Object
+import Halogen as H
+import Halogen.HTML as HH
+import Halogen.HTML.Events as HE
+import Halogen.HTML.Properties as HP
+import Try.API (CompileError(..), CompileResult(..), CompilerError, ErrorPosition)
+import Try.API as API
+import Try.Config as Config
+import Try.Editor (MarkerType(..), toStringMarkerType)
+import Try.Editor as Editor
+import Try.Gist (getGistById, tryLoadFileFromGist)
+import Try.Loader (Loader, makeLoader, runLoader)
+import Try.QueryString (getQueryStringMaybe)
+import Try.Session (createSessionIdIfNecessary, storeSession, tryRetrieveSession)
+import Try.Types (JS(..))
+import Web.HTML (window)
+import Web.HTML.Window (alert)
+
+type Slots = ( editor :: Editor.Slot Unit )
+
+type Settings =
+  { autoCompile :: Boolean
+  , showJs :: Boolean
+  , viewMode :: ViewMode
+  }
+
+defaultSettings :: Settings
+defaultSettings =
+  { autoCompile: true
+  , showJs: false
+  , viewMode: SideBySide
+  }
+
+type State =
+  { settings :: Settings
+  , gistId :: Maybe String
+  , compiled :: Maybe (Either String CompileResult)
+  }
+
+data ViewMode
+  = SideBySide
+  | Code
+  | Output
+
+derive instance eqViewMode :: Eq ViewMode
+
+parseViewModeParam :: String -> Maybe ViewMode
+parseViewModeParam = case _ of
+  "sidebyside" -> Just SideBySide
+  "code" -> Just Code
+  "output" -> Just Output
+  _ -> Nothing
+
+data Action
+  = Initialize
+  | Cache String
+  | UpdateSettings (Settings -> Settings)
+  | Compile (Maybe String)
+  | HandleEditor Editor.Output
+
+_editor :: SProxy "editor"
+_editor = SProxy
+
+loader :: Loader
+loader = makeLoader Config.loaderUrl
+
+foreign import setupIFrame :: EffectFn1 (Object JS) Unit
+foreign import teardownIFrame :: Effect Unit
+
+component :: forall q i o. H.Component HH.HTML q i o Aff
+component = H.mkComponent
+  { initialState
+  , render
+  , eval: H.mkEval $ H.defaultEval
+      { handleAction = handleAction
+      , initialize = Just Initialize
+      }
+  }
+  where
+  initialState :: i -> State
+  initialState _ =
+    { settings: defaultSettings
+    , gistId: Nothing
+    , compiled: Nothing
+    }
+
+  handleAction :: Action -> H.HalogenM State Action Slots o Aff Unit
+  handleAction = case _ of
+    Initialize -> do
+      sessionId <- H.liftEffect $ createSessionIdIfNecessary
+      code <- H.liftAff $ withSession sessionId
+
+      -- Load parameters
+      mbViewModeParam <- H.liftEffect $ getQueryStringMaybe "view"
+      let viewMode = fromMaybe SideBySide $ parseViewModeParam =<< mbViewModeParam
+
+      mbShowJsParam <- H.liftEffect $ getQueryStringMaybe "js"
+      let showJs = mbShowJsParam == Just "true"
+
+      mbAutoCompile <- H.liftEffect $ getQueryStringMaybe "compile"
+      let autoCompile = mbAutoCompile /= Just "false"
+
+      mbGistId <- H.liftEffect $ getQueryStringMaybe "gist"
+
+      H.modify_ _
+        { settings = { viewMode, showJs, autoCompile }
+        , gistId = mbGistId
+        }
+
+      -- Set the editor contents. This will trigger a change event, causing a
+      -- cache + compile step.
+      void $ H.query _editor unit $ H.tell $ Editor.SetEditorContent code
+
+    UpdateSettings k -> do
+      old <- H.get
+      new <- H.modify \state -> state { settings = k state.settings }
+      when (old.settings.showJs /= new.settings.showJs) do
+        if new.settings.showJs then
+          H.liftEffect teardownIFrame
+        else
+          handleAction $ Compile Nothing
+
+    Cache text -> H.liftEffect do
+      sessionId <- getQueryStringMaybe "session"
+      case sessionId of
+        Just sessionId_ -> do
+          storeSession sessionId_ { code: text }
+        Nothing ->
+          error "No session ID"
+
+    Compile mbCode -> do
+      H.modify_ _ { compiled = Nothing }
+      code <- case mbCode of
+        Nothing -> do
+          mbText <- H.query _editor unit $ H.request $ Editor.GetEditorContent
+          pure $ fold $ join mbText
+        Just text ->
+          pure text
+      _ <- H.query _editor unit $ H.tell $ Editor.SetAnnotations []
+      _ <- H.query _editor unit $ H.tell $ Editor.RemoveMarkers
+      runExceptT (API.compile Config.compileUrl code) >>= case _ of
+        Left err -> do
+          H.liftEffect teardownIFrame
+          H.modify_ _ { compiled = Just (Left err) }
+
+        Right (Left err) -> do
+          H.liftEffect teardownIFrame
+          H.liftEffect $ error err
+          H.modify_ _ { compiled = Just (Left err) }
+
+        Right (Right res@(CompileFailed { error })) -> do
+          H.liftEffect teardownIFrame
+          H.modify_ _ { compiled = Just (Right res) }
+          case error of
+            OtherError _ ->
+              pure unit
+            CompilerErrors errs -> do
+              let anns = Array.mapMaybe (toAnnotation MarkerError) errs
+              _ <- H.query _editor unit $ H.tell $ Editor.SetAnnotations anns
+              for_ errs \{ position } ->
+                for_ position \pos -> do
+                  _ <- H.query _editor unit $ H.tell $ Editor.AddMarker MarkerError pos
+                  pure unit
+
+        Right (Right res@(CompileSuccess { js, warnings })) -> do
+          { settings } <- H.modify _ { compiled = Just (Right res) }
+          if settings.showJs then
+            H.liftEffect teardownIFrame
+          else do
+            mbSources <- H.liftAff $ map hush $ runExceptT $ runLoader loader (JS js)
+            for_ warnings \warnings_ -> do
+              let anns = Array.mapMaybe (toAnnotation MarkerWarning) warnings_
+              _ <- H.query _editor unit $ H.tell $ Editor.SetAnnotations anns
+              pure unit
+            for_ mbSources \sources -> do
+              let eventData = Object.insert "" (JS js) sources
+              H.liftEffect $ runEffectFn1 setupIFrame eventData
+
+    HandleEditor (Editor.TextChanged text) -> do
+      _ <- H.fork $ handleAction $ Cache text
+      { autoCompile } <- H.gets _.settings
+      when autoCompile $ handleAction $ Compile $ Just text
+
+  render :: State -> H.ComponentHTML Action Slots Aff
+  render state =
+    HH.div
+      [ HP.id_ "wrapper" ]
+      [ HH.div
+          [ HP.id_ "body" ]
+          [ renderMenu
+          , renderMobileBanner
+          , renderEditor
+          ]
+      ]
+    where
+    renderMenu =
+      HH.ul
+        [ HP.id_ "menu" ]
+        [ HH.a
+            [ HP.class_ $ HH.ClassName "menu-item"
+            , HP.id_ "home_link"
+            , HP.href "/"
+            , HP.title "Try PureScript!"
+            ]
+            [ HH.img
+                [ HP.src "img/favicon-white.svg"
+                , HP.width 40
+                , HP.height 40
+                ]
+            ]
+        , HH.li
+            [ HP.class_ $ HH.ClassName "menu-item menu-dropdown no-mobile" ]
+            [ HH.label
+                [ HP.title "Select a view mode" ]
+                [ HH.text "View Mode" ]
+            , let name = "view_mode" in HH.ul
+                [ HP.id_ name ]
+                [ menuRadio
+                    { checked: state.settings.viewMode == SideBySide
+                    , name
+                    , value: "sidebyside"
+                    , id: "view_sidebyside"
+                    , title: "Show the code and output side by side"
+                    , label: "Side-by-side"
+                    , onClick: UpdateSettings (_ { viewMode = SideBySide })
+                    }
+                , menuRadio
+                    { checked: state.settings.viewMode == Code
+                    , name
+                    , value: "code"
+                    , id: "view_code"
+                    , title: "Show only the code"
+                    , label: "Code"
+                    , onClick: UpdateSettings (_ { viewMode = Code })
+                    }
+                , menuRadio
+                    { checked: state.settings.viewMode == Output
+                    , name
+                    , value: "output"
+                    , id: "view_output"
+                    , title: "Show only the output"
+                    , label: "Output"
+                    , onClick: UpdateSettings (_ { viewMode = Output })
+                    }
+                , maybeElem state.gistId \gistId ->
+                    HH.li
+                      [ HP.class_ $ HH.ClassName "view_gist_li" ]
+                      [ renderGistLink gistId ]
+                ]
+            ]
+        , maybeElem state.gistId \gistId ->
+            HH.li
+              [ HP.class_ $ HH.ClassName "menu-item view_gist_li mobile-only" ]
+              [ renderGistLink gistId ]
+        , HH.li
+            [ HP.class_ $ HH.ClassName "menu-item no-mobile" ]
+            [ HH.label
+                [ HP.id_ "compile_label"
+                , HP.title "Compile Now"
+                , HE.onClick \_ -> Just (Compile Nothing)
+                ]
+                [ HH.text "Compile" ]
+            ]
+        , HH.li
+            [ HP.class_ $ HH.ClassName "menu-item nowrap no-mobile" ]
+            [ HH.input
+                [ HP.id_ "auto_compile"
+                , HP.name "auto_compile"
+                , HP.title "Toggle auto-compilation of the file on code changes"
+                , HP.value "auto_compile"
+                , HP.type_ HP.InputCheckbox
+                , HP.checked state.settings.autoCompile
+                , HE.onChecked \bool -> Just $ UpdateSettings (_ { autoCompile = bool })
+                ]
+            , HH.label
+                [ HP.id_ "auto_compile-label"
+                , HP.for "auto_compile"
+                , HP.title "Compile on code changes"
+                ]
+                [ HH.text "Auto-Compile" ]
+            ]
+        , HH.li
+            [ HP.class_ $ HH.ClassName "menu-item nowrap" ]
+            [ HH.input
+                [ HP.id_ "showjs"
+                , HP.name "showjs"
+                , HP.title "Show resulting JavaScript code instead of output"
+                , HP.value "showjs"
+                , HP.type_ HP.InputCheckbox
+                , HP.checked state.settings.showJs
+                , HE.onChecked \bool -> Just $ UpdateSettings (_ { showJs = bool })
+                ]
+            , HH.label
+                [ HP.id_ "showjs_label"
+                , HP.for "showjs"
+                , HP.title "Show resulting JavaScript code instead of output"
+                ]
+                [ HH.text "Show JS" ]
+            ]
+        , HH.li
+            [ HP.class_ $ HH.ClassName "menu-item" ]
+            [ HH.a
+                [ HP.id_ "helplink"
+                , HP.href "https://github.com/purescript/trypurescript/blob/master/README.md"
+                , HP.target "trypurs_readme"
+                ]
+                [ HH.label
+                    [ HP.id_ "help"
+                    , HP.title "Learn more about Try PureScript"
+                    ]
+                    [ HH.text "Help" ]
+                ]
+            ]
+        ]
+
+    renderMobileBanner =
+      HH.div
+        [ HP.class_ $ HH.ClassName "mobile-only mobile-banner" ]
+        [ HH.text "Your screen size is too small. Code editing has been disabled." ]
+
+    renderEditor =
+      HH.div
+        [ HP.id_ "editor_view"
+        , HP.attr (HH.AttrName "data-view-mode") case state.settings.viewMode of
+            SideBySide -> "sidebyside"
+            Code -> "code"
+            Output -> "output"
+        ]
+        [ HH.div
+            [ HP.id_ "column1"
+            , HP.class_ $ HH.ClassName "no-mobile"
+            ]
+            [ HH.slot _editor unit Editor.component unit (Just <<< HandleEditor) ]
+        , HH.div
+            [ HP.class_ $ HH.ClassName "separator" ]
+            [ ]
+        , HH.div
+            [ HP.id_ "column2_wrapper" ]
+            [ HH.div
+                [ HP.id_ "column2" ]
+                [ maybeElem state.compiled renderCompiled ]
+            , whenElem (isNothing state.compiled) \_ ->
+                HH.div
+                  [ HP.id_ "loading" ]
+                  [ ]
+            ]
+        ]
+
+    renderCompiled = case _ of
+      Left err ->
+        renderPlaintext "Unable to parse the response from the server."
+      Right res -> case res of
+        CompileFailed { error } -> case error of
+          OtherError err ->
+            renderPlaintext err
+          CompilerErrors errs ->
+            HH.div_ $ renderCompilerErrors errs
+        CompileSuccess { js } ->
+          whenElem state.settings.showJs \_ ->
+            renderPlaintext js
+
+whenElem :: forall w i. Boolean -> (Unit -> HH.HTML w i) -> HH.HTML w i
+whenElem cond f = if cond then f unit else HH.text ""
+
+maybeElem :: forall w i a. Maybe a -> (a -> HH.HTML w i) -> HH.HTML w i
+maybeElem val f = case val of
+  Just x -> f x
+  _ -> HH.text ""
+
+renderPlaintext :: forall w i. String -> HH.HTML w i
+renderPlaintext contents = HH.pre_ [ HH.code_ [ HH.text contents ] ]
+
+renderCompilerErrors :: forall w i. Array CompilerError -> Array (HH.HTML w i)
+renderCompilerErrors errors = do
+  let total = Array.length errors
+  errors # foldMapWithIndex \ix { message } ->
+    [ HH.h1
+        [ HP.class_ $ HH.ClassName "error-banner" ]
+        [ HH.text $ "Error " <> show (ix + 1) <> " of " <> show total ]
+    , renderPlaintext message
+    ]
+
+menuRadio
+  :: forall w
+   . { name :: String
+     , id :: String
+     , value :: String
+     , checked :: Boolean
+     , title :: String
+     , label :: String
+     , onClick :: Action
+     }
+  -> HH.HTML w Action
+menuRadio props =
+  HH.li_
+    [ HH.input
+        [ HP.type_ HP.InputRadio
+        , HP.name props.name
+        , HP.value props.value
+        , HP.id_ props.id
+        , HE.onClick \_ -> Just props.onClick
+        , HP.checked props.checked
+        ]
+    , HH.label
+        [ HP.for props.id
+        , HP.title props.title
+        ]
+        [ HH.text props.label ]
+    ]
+
+renderGistLink :: forall w i. String -> HH.HTML w i
+renderGistLink gistId =
+  HH.a
+    [ HP.class_ $ HH.ClassName "view_gist"
+    , HP.href $ "https://gist.github.com/" <> gistId
+    , HP.target "trypurs_gist"
+    ]
+    [ HH.label
+        [ HP.title "Open the original gist in a new window." ]
+        [ HH.text "Gist" ]
+    ]
+
+toAnnotation
+  :: forall r
+   . MarkerType
+  -> { position :: Maybe ErrorPosition, message :: String | r }
+  -> Maybe Annotation
+toAnnotation markerType { position, message } =
+  position <#> \pos ->
+    { row: pos.startLine - 1
+    , column: pos.startColumn - 1
+    , type: toStringMarkerType markerType
+    , text: message
+    }
+
+withSession :: String -> Aff String
+withSession sessionId = do
+  state <- H.liftEffect $ tryRetrieveSession sessionId
+  case state of
+    Just state' -> pure state'.code
+    Nothing -> do
+      gist <- H.liftEffect $ fromMaybe Config.mainGist <$> getQueryStringMaybe "gist"
+      loadFromGist gist
+  where
+  loadFromGist id = do
+    runExceptT (getGistById id >>= \gi -> tryLoadFileFromGist gi "Main.purs") >>= case _ of
+      Left err -> do
+        H.liftEffect $ window >>= alert err
+        pure ""
+      Right code ->
+        pure code
diff --git a/client/src/Try/Editor.purs b/client/src/Try/Editor.purs
new file mode 100644
index 00000000..54c83d4d
--- /dev/null
+++ b/client/src/Try/Editor.purs
@@ -0,0 +1,208 @@
+module Try.Editor
+  ( Slot
+  , Query(..)
+  , MarkerType(..)
+  , toStringMarkerType
+  , Output(..)
+  , component
+  ) where
+
+import Prelude
+
+import Ace (Annotation, Range)
+import Ace as Ace
+import Ace.EditSession as EditSession
+import Ace.Editor as Edit
+import Ace.Editor as Editor
+import Ace.Range as Range
+import Ace.Types (Editor)
+import Ace.VirtualRenderer as Renderer
+import Data.Foldable (for_, traverse_)
+import Data.Int as Int
+import Data.List (List(..))
+import Data.Maybe (Maybe(..))
+import Data.Newtype (class Newtype)
+import Data.Time.Duration (Milliseconds(..))
+import Data.Traversable (traverse)
+import Effect (Effect)
+import Effect.Aff.Class (class MonadAff)
+import Effect.Ref as Ref
+import Effect.Timer (clearTimeout, setTimeout)
+import Halogen as H
+import Halogen.HTML as HH
+import Halogen.HTML.Properties as HP
+import Halogen.Query.EventSource as ES
+import Try.API (ErrorPosition)
+import Web.HTML (HTMLElement)
+
+type Slot = H.Slot Query Output
+
+data Query a
+  = GetEditorContent (Maybe String -> a)
+  | SetEditorContent String a
+  | SetAnnotations (Array Annotation) a
+  | AddMarker MarkerType ErrorPosition a
+  | RemoveMarkers a
+
+data Output = TextChanged String
+
+data MarkerType = MarkerError | MarkerWarning
+
+toStringMarkerType :: MarkerType -> String
+toStringMarkerType = case _ of
+  MarkerError -> "error"
+  MarkerWarning -> "warning"
+
+newtype MarkerId = MarkerId Int
+derive instance newtypeMarkerId :: Newtype MarkerId _
+
+derive instance eqMarkerType :: Eq MarkerType
+
+debounceTime :: Milliseconds
+debounceTime = Milliseconds 750.0
+
+type State =
+  { editor :: Maybe Editor
+  , markers :: List MarkerId
+  }
+
+data Action
+  = Initialize
+  | Finalize
+  | ClearMarkers
+  | HandleChange
+
+component :: forall i m. MonadAff m => H.Component HH.HTML Query i Output m
+component = H.mkComponent
+  { initialState
+  , render
+  , eval: H.mkEval $ H.defaultEval
+      { handleAction = handleAction
+      , handleQuery = handleQuery
+      , initialize = Just Initialize
+      , finalize = Just Finalize
+      }
+  }
+  where
+  initialState :: i -> State
+  initialState _ =
+    { editor: Nothing
+    , markers: Nil
+    }
+
+  -- As we're embedding a 3rd party component we only need to create a placeholder
+  -- div here and attach the ref property which will let us reference the element.
+  render :: State -> H.ComponentHTML Action () m
+  render _ =
+    HH.div
+      [ HP.ref $ H.RefLabel "ace"
+      , HP.id_ "code"
+      ]
+      [ ]
+
+  handleAction :: Action -> H.HalogenM State Action () Output m Unit
+  handleAction = case _ of
+    Initialize -> do
+      H.getHTMLElementRef (H.RefLabel "ace") >>= traverse_ \element -> do
+        editor <- H.liftEffect $ setupEditor element
+        H.modify_ _ { editor = Just editor }
+        session <- H.liftEffect $ Editor.getSession editor
+        void $ H.subscribe $ ES.effectEventSource \emitter -> do
+          emit <- debounce debounceTime \_ -> ES.emit emitter HandleChange
+          EditSession.onChange session emit
+          pure mempty
+
+    Finalize -> do
+      handleAction ClearMarkers
+      H.modify_ _ { editor = Nothing }
+
+    ClearMarkers -> do
+      { editor: mbEditor, markers } <- H.get
+      for_ mbEditor \editor -> H.liftEffect do
+        session <- Editor.getSession editor
+        let cleanup (MarkerId n) = EditSession.removeMarker n session
+        traverse_ cleanup markers
+
+    HandleChange -> do
+      H.gets _.editor >>= traverse_ \editor -> do
+        text <- H.liftEffect (Editor.getValue editor)
+        H.raise $ TextChanged text
+
+  handleQuery :: forall a. Query a -> H.HalogenM State Action () Output m (Maybe a)
+  handleQuery = case _ of
+    GetEditorContent reply -> do
+      contents <- H.gets _.editor >>= traverse (Editor.getValue >>> H.liftEffect)
+      pure (Just (reply contents))
+
+    SetEditorContent text next -> do
+      H.gets _.editor >>= traverse_ \editor -> H.liftEffect do
+        current <- Editor.getValue editor
+        when (text /= current) do
+          session <- Edit.getSession editor
+          EditSession.setValue text session
+      pure (Just next)
+
+    SetAnnotations annotations next -> do
+      H.gets _.editor >>= traverse_ \editor -> H.liftEffect do
+        session <- Editor.getSession editor
+        EditSession.setAnnotations annotations session
+      pure (Just next)
+
+    AddMarker markerType position next -> do
+      H.gets _.editor >>= traverse_ \editor -> do
+        markerId <- H.liftEffect do
+          session <- Editor.getSession editor
+          range <- rangeFromPosition position
+          let mt = toStringMarkerType markerType
+          EditSession.addMarker range mt "text" true session
+        H.modify_ \st -> st { markers = Cons (MarkerId markerId) st.markers }
+      pure (Just next)
+
+    RemoveMarkers next -> do
+      handleAction ClearMarkers
+      pure (Just next)
+
+setupEditor :: HTMLElement -> Effect Editor
+setupEditor element = do
+  editor <- Ace.editNode element Ace.ace
+  Editor.setShowPrintMargin false editor
+  Editor.setTheme "ace/theme/dawn" editor
+
+  renderer <- Editor.getRenderer editor
+  Renderer.setShowGutter true renderer
+
+  session <- H.liftEffect $ Editor.getSession editor
+  EditSession.setMode "ace/mode/haskell" session
+  EditSession.setTabSize 2 session
+  EditSession.setUseSoftTabs true session
+
+  pure editor
+
+rangeFromPosition :: ErrorPosition -> Effect Range
+rangeFromPosition pos = do
+  let
+    -- Ensure ranges are at least one character wide
+    { startLine, startColumn, endLine, endColumn } =
+      if pos.startLine == pos.endLine && pos.endColumn <= pos.startColumn then
+        if pos.startColumn > 0 then do
+          pos { startColumn = pos.endColumn - 1 }
+        else
+          pos { endColumn = pos.startColumn + 1 }
+      else
+        pos
+
+  Range.create
+    (startLine - 1)
+    (startColumn - 1)
+    (endLine - 1)
+    (endColumn - 1)
+
+debounce :: forall a. Milliseconds -> (a -> Effect Unit) -> Effect (a -> Effect Unit)
+debounce (Milliseconds wait) k = do
+  tidRef <- Ref.new Nothing
+  pure \a -> do
+    Ref.read tidRef >>= traverse_ clearTimeout
+    tid <- setTimeout (Int.floor wait) do
+      Ref.write Nothing tidRef
+      k a
+    Ref.write (Just tid) tidRef
diff --git a/client/src/Try/Session.purs b/client/src/Try/Session.purs
index 2262bf26..5f54ed00 100644
--- a/client/src/Try/Session.purs
+++ b/client/src/Try/Session.purs
@@ -28,10 +28,7 @@ randomGuid =
     s4 = padLeft <<< toStringAs hexadecimal <$> randomInt 0 (256 * 256)
     padLeft s = String.drop (String.length s - 1) ("000" <> s)
 
-foreign import storeSession_
-  :: EffectFn2 String
-               { code :: String }
-               Unit
+foreign import storeSession_ :: EffectFn2 String { code :: String } Unit
 
 -- | Store the current session state in local storage
 storeSession
@@ -40,20 +37,19 @@ storeSession
   -> Effect Unit
 storeSession sessionId values = runEffectFn2 storeSession_ sessionId values
 
-foreign import tryRetrieveSession_
-  :: EffectFn1 String
-               (Nullable { code :: String })
+foreign import tryRetrieveSession_ :: EffectFn1 String (Nullable { code :: String })
 
 -- | Retrieve the session state from local storage
 tryRetrieveSession :: String -> Effect (Maybe { code :: String })
 tryRetrieveSession sessionId = toMaybe <$> runEffectFn1 tryRetrieveSession_ sessionId
 
 -- | Look up the session by ID, or create a new session ID.
-createSessionIdIfNecessary
-  :: (String -> Effect Unit)
-  -> Effect Unit
-createSessionIdIfNecessary k = do
+createSessionIdIfNecessary :: Effect String
+createSessionIdIfNecessary = do
   sessionId <- getQueryStringMaybe "session"
   case sessionId of
-    Just sessionId_ -> k sessionId_
-    Nothing -> randomGuid >>= setQueryString "session"
+    Just sessionId_ -> pure sessionId_
+    Nothing -> do
+      id <- randomGuid
+      setQueryString "session" id
+      pure id