wip

default.nix

@@ -178,6 +178,15 @@ in rec {
         --set GHC_RTS "-M2G"
     '';
 
+  webCommon = pkgs.lib.cleanSourceWith { 
+    filter = pkgs.lib.cleanSourceFilter;
+    src = lib.cleanSourceWith {
+      filter = (path: type: !(pkgs.lib.elem (baseNameOf path)
+                            [".spago" ".spago2nix" "generated" "generated-docs" "output" "dist" "node_modules" ".psci_modules" ".vscode"]));
+      src = ./web-common;
+    };
+  };
+
   plutus-playground = pkgs.recurseIntoAttrs (rec {
     playground-exe = set-git-rev haskell.packages.plutus-playground-server.components.exes.plutus-playground-server;
     server-invoker = let
@@ -206,7 +215,7 @@ in rec {
     client =
       pkgs.callPackage ./nix/purescript.nix rec {
         inherit (sources) nodejs-headers;
-        inherit easyPS;
+        inherit easyPS webCommon;
         psSrc = generated-purescript;
         src = ./plutus-playground-client;
         packageJSON = ./plutus-playground-client/package.json;
@@ -249,7 +258,7 @@ in rec {
     client =
       pkgs.callPackage ./nix/purescript.nix rec {
         inherit (sources) nodejs-headers;
-        inherit easyPS;
+        inherit easyPS webCommon;
         psSrc = generated-purescript;
         src = ./marlowe-playground-client;
         packageJSON = ./marlowe-playground-client/package.json;

marlowe-playground-client/src/Demos/State.purs

@@ -43,6 +43,7 @@ demoFile key name description =
         [ span [ class_ (ClassName "description") ] [ text description ]
         , div [ classes [ ClassName "group", ClassName "open-buttons" ] ]
             [ button [ onClick $ const $ Just $ LoadDemo Haskell key ] [ text "Haskell" ]
+            , button [ onClick $ const $ Just $ LoadDemo Javascript key ] [ text "Javascript" ]
             , button [ onClick $ const $ Just $ LoadDemo Marlowe key ] [ text "Marlowe" ]
             , button [ onClick $ const $ Just $ LoadDemo Blockly key ] [ text "Blockly" ]
             ]

marlowe-playground-client/src/GistButtons.purs

@@ -2,21 +2,15 @@ module GistButtons where
 
 import Prelude hiding (div)
 import Auth (AuthRole(..), authStatusAuthRole)
-import Data.Either (Either(..))
 import Data.Lens (to, view, (^.))
-import Data.Maybe (Maybe(..))
-import Gist (Gist)
-import Gists (GistAction(..), idPublishGist)
-import Halogen.Classes (aHorizontal)
-import Halogen.HTML (ClassName(..), HTML, a, button, div, span, text)
-import Halogen.HTML.Events (onClick)
+import Gists (idPublishGist)
+import Halogen.HTML (ClassName(..), HTML, a, button, div, div_, p_, text)
 import Halogen.HTML.Properties (class_, classes, disabled, href)
 import Halogen.SVG (Box(..), Length(..), Linecap(..), RGB(..), circle, clazz, cx, cy, d, fill, height, path, r, strokeLinecap, strokeWidth, svg, viewBox)
 import Halogen.SVG as SVG
 import Icons (Icon(..), icon)
 import Network.RemoteData (RemoteData(..))
-import Servant.PureScript.Ajax (AjaxError)
-import Types (Action(..), FrontendState, _authStatus, _createGistResult)
+import Types (Action, FrontendState, _authStatus)
 
 authButton :: forall p. FrontendState -> HTML p Action
 authButton state =
@@ -31,15 +25,19 @@ authButton state =
           [ text "Failed to login" ]
       Success Anonymous ->
         div [ class_ (ClassName "auth-button-container") ]
-          [ a
-              [ idPublishGist
-              , classes [ ClassName "auth-button" ]
-              , href "/api/oauth/github"
-              ]
-              [ text "Save to GitHub"
+          [ p_ [ text "We use gists to save your projects, in order to save and load your projects you will need to login to Github." ]
+          , p_ [ text "If you don't wish to login you can still use the Marlowe Playground however you won't be able to save your work." ]
+          , div_
+              [ a
+                  [ idPublishGist
+                  , classes [ ClassName "auth-button" ]
+                  , href "/api/oauth/github"
+                  ]
+                  [ text "Login"
+                  ]
               ]
           ]
-      Success GithubUser -> gistSection state
+      Success GithubUser -> text ""
       Loading ->
         button
           [ idPublishGist
@@ -72,30 +70,3 @@ errorIcon :: forall p a. HTML p a
 errorIcon =
   svg [ clazz (ClassName "error-icon"), SVG.width (Px 20), height (Px 20), viewBox (Box { x: 0, y: 0, width: 24, height: 24 }) ]
     [ path [ fill (Hex "#ff0000"), d "M13,13H11V7H13M12,17.3A1.3,1.3 0 0,1 10.7,16A1.3,1.3 0 0,1 12,14.7A1.3,1.3 0 0,1 13.3,16A1.3,1.3 0 0,1 12,17.3M15.73,3H8.27L3,8.27V15.73L8.27,21H15.73L21,15.73V8.27L15.73,3Z" ] [] ]
-
-gistButtonIcon :: forall p a. HTML p a -> Either String (RemoteData AjaxError Gist) -> HTML p a
-gistButtonIcon _ (Left _) = errorIcon
-
-gistButtonIcon _ (Right (Failure _)) = errorIcon
-
-gistButtonIcon arrow (Right (Success _)) = arrow
-
-gistButtonIcon _ (Right Loading) = spinner
-
-gistButtonIcon arrow (Right NotAsked) = arrow
-
-gistSection :: forall p. FrontendState -> HTML p Action
-gistSection state =
-  div [ classes [ ClassName "save-button-group" ] ]
-    [ button
-        [ onClick $ const $ Just $ GistAction PublishGist ]
-        [ text saveText ]
-    , span [ class_ (ClassName "error") ] [ text error ]
-    ]
-  where
-  error = case state ^. _createGistResult of
-    (Failure _) -> "Failed to save project"
-    _ -> ""
-  saveText = case state ^. _createGistResult of
-    Loading -> "Saving..."
-    _ -> "Save"

marlowe-playground-client/src/MainFrame.purs

@@ -8,7 +8,7 @@ import Control.Monad.Reader (runReaderT)
 import Data.Bifunctor (lmap)
 import Data.Either (Either(..), either, note)
 import Data.Foldable (for_, traverse_)
-import Data.Lens (_Right, assign, has, preview, previewOn, to, use, view, (^.))
+import Data.Lens (_Right, assign, has, is, preview, previewOn, to, use, view, (^.))
 import Data.Lens.Extra (peruse)
 import Data.Lens.Index (ix)
 import Data.List.NonEmpty as NEL
@@ -20,9 +20,10 @@ import Demos.Types (Action(..), Demo(..)) as Demos
 import Effect.Aff.Class (class MonadAff)
 import Effect.Class (class MonadEffect)
 import Gist (Gist, _GistId, gistDescription, gistId)
+import GistButtons (authButton)
 import Gists (GistAction(..))
 import Gists as Gists
-import Halogen (Component, ComponentHTML, get, liftEffect, query, subscribe, subscribe')
+import Halogen (ClassName(..), Component, ComponentHTML, get, liftEffect, query, subscribe, subscribe')
 import Halogen as H
 import Halogen.ActusBlockly as ActusBlockly
 import Halogen.Analytics (handleActionWithAnalyticsTracking)
@@ -31,7 +32,7 @@ import Halogen.Blockly as Blockly
 import Halogen.Classes (aHorizontal, active, fullHeight, fullWidth, hide, noMargins, spaceLeft, spaceRight, uppercase)
 import Halogen.Classes as Classes
 import Halogen.Extra (mapSubmodule, renderSubmodule)
-import Halogen.HTML (ClassName(ClassName), HTML, a, div, h1_, h2, header, main, section, slot, text)
+import Halogen.HTML (ClassName(ClassName), HTML, a, div, h1_, h2, header, main, section, slot, span, text)
 import Halogen.HTML.Events (onClick)
 import Halogen.HTML.Properties (class_, classes, href, id_, target)
 import Halogen.Monaco (KeyBindings(DefaultBindings))
@@ -60,8 +61,8 @@ import Marlowe.Parser (parseContract)
 import Network.RemoteData (RemoteData(..), _Loading, _Success)
 import Network.RemoteData as RemoteData
 import NewProject.State (handleAction, render) as NewProject
-import NewProject.Types (Action(..), State, _error, _projectName, emptyState) as NewProject
-import Prelude (class Functor, Unit, Void, bind, const, discard, eq, flip, identity, map, mempty, negate, otherwise, pure, show, unit, void, ($), (/=), (<$>), (<<<), (<>), (=<<), (==), (>))
+import NewProject.Types (Action(..), State, _projectName, emptyState) as NewProject
+import Prelude (class Functor, Unit, Void, bind, const, discard, eq, flip, identity, map, mempty, negate, not, otherwise, pure, show, unit, void, ($), (/=), (<$>), (<<<), (<>), (=<<), (==), (>))
 import Projects.State (handleAction, render) as Projects
 import Projects.Types (Action(..), State, _projects, emptyState) as Projects
 import Projects.Types (Lang(..))
@@ -406,24 +407,13 @@ handleAction s (ProjectsAction action@(Projects.LoadProject lang gistId)) = do
 handleAction s (ProjectsAction action) = toProjects $ Projects.handleAction s action
 
 handleAction s (NewProjectAction action@(NewProject.CreateProject lang)) = do
-  -- we want to keep the current poject details in case creating a new project fails
-  currentProject <- use _projectName
-  currentGistId <- use _gistId
   description <- use (_newProject <<< NewProject._projectName)
   assign _projectName description
   assign _gistId Nothing
-  handleGistAction s PublishGist
-  res <- peruse (_createGistResult <<< _Success)
-  case res of
-    Just gist -> do
-      liftEffect $ LocalStorage.setItem gistIdLocalStorageKey (gist ^. (gistId <<< _GistId))
-      assign _gistId $ Just (gist ^. gistId)
-      traverse_ selectView $ selectLanguageView lang
-      assign _showModal Nothing
-    Nothing -> do
-      assign (_newProject <<< NewProject._error) (Just "Could not create new project")
-      assign _projectName currentProject
-      assign _gistId currentGistId
+  assign _createGistResult NotAsked
+  liftEffect $ LocalStorage.setItem gistIdLocalStorageKey mempty
+  traverse_ selectView $ selectLanguageView lang
+  assign _showModal Nothing
   toNewProject $ NewProject.handleAction s action
 
 handleAction s (NewProjectAction action) = toNewProject $ NewProject.handleAction s action
@@ -483,6 +473,11 @@ handleAction settings (OpenModal OpenProject) = do
   assign _showModal $ Just OpenProject
   toProjects $ Projects.handleAction settings Projects.LoadProjects
 
+handleAction _ (OpenModal RenameProject) = do
+  currentName <- use _projectName
+  assign (_rename <<< Rename._projectName) currentName
+  assign _showModal $ Just RenameProject
+
 handleAction _ (OpenModal modalView) = assign _showModal $ Just modalView
 
 handleAction _ CloseModal = assign _showModal Nothing
@@ -496,7 +491,7 @@ selectLanguageView Marlowe = Just Simulation
 
 selectLanguageView Blockly = Just BlocklyEditor
 
-selectLanguageView Javascript = Nothing
+selectLanguageView Javascript = Just JSEditor
 
 ----------
 showErrorDescription :: ErrorDescription -> String
@@ -742,29 +737,26 @@ modal state = case state ^. _showModal of
 
   modalContent SaveProjectAs = renderSubmodule _saveAs SaveAsAction SaveAs.render state
 
-  modalContent GithubLogin = text "GithubLogin"
+  modalContent GithubLogin = authButton state
 
 menuBar :: forall p. FrontendState -> HTML p Action
 menuBar state =
   div [ classes [ ClassName "menu-bar" ] ]
-    ( [ openModal NewProject "New Project"
-      , openModal OpenProject "Open Project"
-      , openModal OpenDemo "Open Demo"
-      , openModal RenameProject "Rename"
-      ]
-        <> save (previewOn state (_authStatus <<< _Success <<< authStatusAuthRole <<< _GithubUser))
-        <> saveAs (previewOn state (_authStatus <<< _Success <<< authStatusAuthRole <<< _GithubUser))
-    )
+    [ menuButton (OpenModal NewProject) "New" " Project"
+    , gistModal (OpenModal OpenProject) "Open" " Project"
+    , menuButton (OpenModal OpenDemo) "Open Demo" ""
+    , menuButton (OpenModal RenameProject) "Rename" " Project"
+    , menuButton (GistAction PublishGist) "Save" " Project"
+    , gistModal (OpenModal SaveProjectAs) "Save As" ""
+    ]
   where
-  openModal modalView name = a [ onClick $ const $ Just $ OpenModal modalView ] [ text name ]
-
-  save Nothing = [ openModal GithubLogin "Save" ]
-
-  save _ = [ a [ onClick $ const $ Just $ GistAction PublishGist ] [ text "Save" ] ]
-
-  saveAs Nothing = [ openModal GithubLogin "Save As" ]
+  menuButton action shortName restOfName = a [ onClick $ const $ Just action ] [ text shortName, span [ class_ (ClassName "long-text") ] [ text restOfName ] ]
 
-  saveAs _ = [ openModal SaveProjectAs "Save As" ]
+  gistModal action shortName restOfName =
+    if has (_authStatus <<< _Success <<< authStatusAuthRole <<< _GithubUser) state then
+      menuButton action shortName restOfName
+    else
+      menuButton (OpenModal GithubLogin) shortName restOfName
 
 marloweIcon :: forall p a. HTML p a
 marloweIcon =

marlowe-playground-client/src/NewProject/State.purs

@@ -34,7 +34,7 @@ render state =
     [ input [ value (state ^. _projectName), onValueChange (Just <<< ChangeProjectName) ]
     , hr_
     , h2_ [ text "Choose your initial coding environment" ]
-    , div [ classes [ flex, ClassName "language-links" ] ] (map link [ Haskell, Marlowe, Blockly ])
+    , div [ classes [ flex, ClassName "language-links" ] ] (map link [ Haskell, Marlowe, Blockly, Javascript ])
     , renderError (state ^. _error)
     ]
   where

marlowe-playground-client/src/Projects/State.purs

@@ -109,6 +109,7 @@ gistRow gist =
     , td_
         [ div [ classes [ flex, ClassName "language-links" ] ]
             [ a [ onClick (const <<< Just $ LoadProject Haskell (gist ^. gistId)) ] [ text "Haskell" ]
+            , a [ onClick (const <<< Just $ LoadProject Javascript (gist ^. gistId)) ] [ text "Javascript" ]
             , a [ onClick (const <<< Just $ LoadProject Marlowe (gist ^. gistId)) ] [ text "Marlowe" ]
             , a [ onClick (const <<< Just $ LoadProject Blockly (gist ^. gistId)) ] [ text "Blockly" ]
             ]

marlowe-playground-client/src/Simulation.purs

@@ -27,8 +27,8 @@ import Effect.Aff.Class (class MonadAff, liftAff)
 import Effect.Class (class MonadEffect, liftEffect)
 import FileEvents (readFileFromDragEvent)
 import FileEvents as FileEvents
-import Halogen (HalogenM, query)
-import Halogen.Classes (aHorizontal, activeClasses, bold, closeDrawerIcon, codeEditor, expanded, infoIcon, noMargins, panelSubHeaderSide, plusBtn, pointer, sidebarComposer, smallBtn, spanText, textSecondaryColor, uppercase)
+import Halogen (ClassName(..), HalogenM, query)
+import Halogen.Classes (aHorizontal, activeClasses, bold, closeDrawerIcon, codeEditor, expanded, fullHeight, infoIcon, noMargins, panelSubHeaderSide, plusBtn, pointer, scroll, sidebarComposer, smallBtn, spanText, textSecondaryColor, uppercase)
 import Halogen.Classes as Classes
 import Halogen.HTML (ClassName(..), ComponentHTML, HTML, a, article, aside, b_, br_, button, div, em_, h6, h6_, img, input, li, option, p, p_, section, select, slot, small, strong_, text, ul)
 import Halogen.HTML.Events (onClick, onSelectedIndexChange, onValueChange)
@@ -330,7 +330,7 @@ render ::
   State ->
   ComponentHTML Action ChildSlots m
 render state =
-  div []
+  div [ classes [ fullHeight, scroll, ClassName "simulation-panel" ] ]
     [ section [ class_ (ClassName "code-panel") ]
         [ div [ classes (codeEditor $ state ^. _showBottomPanel) ]
             [ marloweEditor state ]

marlowe-playground-client/static/css/css_var_globals.scss

@@ -7,4 +7,5 @@
 }
 
 $breakpoint-tablet: 768px;
+$breakpoint-mid: 1024px;
 $breakpoint-wide: 1360px;

marlowe-playground-client/static/css/demos.scss

@@ -8,6 +8,8 @@
 .group.open-buttons {
   padding: 1rem 0rem;
   display: flex;
-  width: 24rem;
-  justify-content: space-between;
+  justify-content: flex-start;
+  button {
+    margin-right: 1rem;
+  }
 }

marlowe-playground-client/static/css/header.scss

@@ -44,11 +44,13 @@ header {
 .project-title i {
   height: 1em;
   width: 1em;
+  margin-left: 1rem;
 }
 
 .project-title .empty {
   height: 1em;
   width: 1em;
+  margin-left: 1rem;
 }
 
 .external-links {

marlowe-playground-client/static/css/main-tabs.scss

@@ -21,8 +21,13 @@
 
 #main-panel {
   background: var(--bg-light);
-  padding: 0rem 2rem;
+  // padding: 0rem 2rem;
   width: 100%;
+  height: 100%;
+}
+
+.simulation-panel {
+  padding: 0rem 2rem;
 }
 
 #main-panel div.panel-content {

marlowe-playground-client/static/css/main.scss

@@ -69,6 +69,11 @@ a:hover {
 .auth-button-container {
     margin-top: 5px;
 }
+
+.auth-button-container div {
+    margin-top: 5px;
+}
+
 .auth-button {
     padding: 0.4rem 1.5rem;
     cursor: pointer;

marlowe-playground-client/static/css/panel-mobile.scss

@@ -106,4 +106,10 @@
   .simulation-bottom-panel {
     width: 90%;
   }
+}
+
+@media (max-width: $breakpoint-mid - 1) {
+  .menu-bar a .long-text {
+    display: none;
+  }
 }