move mainframe into it's own THE module

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

@@ -10,7 +10,7 @@ import Halogen.HTML (HTML, button, div, h1_, h2_, hr_, span, text)
 import Halogen.HTML.Events (onClick)
 import Halogen.HTML.Properties (class_, classes)
 import Projects.Types (Lang(..))
-import Types (ChildSlots)
+import MainFrame.Types (ChildSlots)
 
 render ::
   forall m state.

marlowe-playground-client/src/GistButtons.purs

@@ -10,7 +10,7 @@ import Halogen.SVG (Box(..), Length(..), Linecap(..), RGB(..), circle, clazz, cx
 import Halogen.SVG as SVG
 import Icons (Icon(..), icon)
 import Network.RemoteData (RemoteData(..))
-import Types (Action, FrontendState, _authStatus)
+import MainFrame.Types (Action, FrontendState, _authStatus)
 
 authButton :: forall p. FrontendState -> HTML p Action
 authButton state =

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

@@ -26,7 +26,7 @@ import Simulation.State (_result)
 import Simulation.Types (WebData)
 import StaticData (bufferLocalStorageKey)
 import StaticData as StaticData
-import Types (ChildSlots, _blocklySlot, _haskellEditorSlot)
+import MainFrame.Types (ChildSlots, _blocklySlot, _haskellEditorSlot)
 import Webghc.Server (CompileRequest(..))
 
 handleAction ::

marlowe-playground-client/src/HaskellEditor/View.purs

@@ -24,7 +24,7 @@ import LocalStorage as LocalStorage
 import Monaco (getModel, setValue) as Monaco
 import Network.RemoteData (RemoteData(..), _Loading, isLoading, isSuccess)
 import StaticData as StaticData
-import Types (ChildSlots, _haskellEditorSlot)
+import MainFrame.Types (ChildSlots, _haskellEditorSlot)
 
 render ::
   forall m.

marlowe-playground-client/src/Home.purs

@@ -7,7 +7,7 @@ import Halogen.HTML (button, div, div_, h2_, h3_, img, p_, text)
 import Halogen.HTML.Events (onClick)
 import Halogen.HTML.Properties (class_, classes, src)
 import Prelude (const, (<<<))
-import Types (Action(..), ChildSlots, FrontendState, ModalView(..))
+import MainFrame.Types (ModalView(..), Action(..), ChildSlots, FrontendState)
 
 render :: forall m. FrontendState -> ComponentHTML Action ChildSlots m
 render state =

marlowe-playground-client/src/JSEditor.purs

@@ -15,14 +15,15 @@ import Halogen.HTML.Events (onClick, onSelectedIndexChange)
 import Halogen.HTML.Properties (alt, class_, classes, href, src)
 import Halogen.HTML.Properties as HTML
 import Halogen.Monaco (monacoComponent)
+import JavascriptEditor.Types (JSCompilationState(..))
 import Language.Javascript.Interpreter (CompilationError(..), InterpreterResult(..))
 import Language.Javascript.Monaco as JSM
 import LocalStorage as LocalStorage
+import MainFrame.Types (Action(..), ChildSlots, FrontendState, _jsCompilationResult, _jsEditorKeybindings, _jsEditorSlot, _showBottomPanel)
 import Monaco as Monaco
 import Prelude (bind, bottom, const, map, not, show, unit, ($), (<$>), (<<<), (<>), (==))
 import StaticData as StaticData
 import Text.Pretty (pretty)
-import Types (Action(..), ChildSlots, FrontendState, JSCompilationState(..), _jsCompilationResult, _jsEditorKeybindings, _jsEditorSlot, _showBottomPanel)
 
 render ::
   forall m.

marlowe-playground-client/src/JavascriptEditor/Types.purs

@@ -0,0 +1,10 @@
+module JavascriptEditor.Types where
+
+import Language.Javascript.Interpreter as JS
+import Marlowe.Semantics (Contract)
+
+data JSCompilationState
+  = JSNotCompiled
+  | JSCompiling
+  | JSCompilationError JS.CompilationError
+  | JSCompiledSuccessfully (JS.InterpreterResult Contract)

marlowe-playground-client/src/Main.purs

@@ -1,6 +1,7 @@
 module Main where
 
 import Prelude
+
 import Control.Coroutine (Consumer, Process, connect, consumer, runProcess)
 import Data.Maybe (Maybe(..))
 import Effect (Effect)
@@ -13,13 +14,13 @@ import Halogen.Aff (awaitBody, runHalogenAff)
 import Halogen.VDom.Driver (runUI)
 import LocalStorage (RawStorageEvent)
 import LocalStorage as LocalStorage
-import MainFrame (mkMainFrame)
+import MainFrame.State (mkMainFrame)
+import MainFrame.Types (Query(..))
 import Marlowe (SPParams_(SPParams_))
 import Router as Router
 import Routing.Duplex as Routing
 import Routing.Hash (matchesWith)
 import Servant.PureScript.Settings (SPSettingsDecodeJson_(..), SPSettingsEncodeJson_(..), SPSettings_(..), defaultSettings)
-import Types (Query(..))
 
 ajaxSettings :: SPSettings_ SPParams_
 ajaxSettings = SPSettings_ $ (settings { decodeJson = decodeJson, encodeJson = encodeJson })

marlowe-playground-client/src/MainFrame.purs → marlowe-playground-client/src/MainFrame/State.purs

@@ -1,6 +1,5 @@
-module MainFrame (mkMainFrame) where
+module MainFrame.State (mkMainFrame) where
 
-import Auth (_GithubUser, authStatusAuthRole)
 import Control.Monad.Except (ExceptT(..), lift, runExceptT)
 import Control.Monad.Maybe.Extra (hoistMaybe)
 import Control.Monad.Maybe.Trans (runMaybeT)
@@ -9,75 +8,65 @@ import Data.Array (toUnfoldable)
 import Data.Bifunctor (lmap)
 import Data.Either (Either(..), either, note)
 import Data.Foldable (for_, traverse_)
-import Data.Lens (_Right, assign, has, preview, to, use, view, (^.))
+import Data.Lens (_Right, assign, preview, use, view, (^.))
 import Data.Lens.Extra (peruse)
 import Data.Lens.Index (ix)
 import Data.List (filter, (:))
 import Data.Map as Map
 import Data.Maybe (Maybe(..), fromMaybe)
 import Data.Newtype (unwrap)
 import Demos.Types (Action(..), Demo(..)) as Demos
-import Demos.View (render) as Demos
 import Effect.Aff.Class (class MonadAff)
 import Effect.Class (class MonadEffect)
 import Examples.Haskell.Contracts (example) as HE
 import Examples.JS.Contracts (example) as JE
 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 (Component, get, liftEffect, query, subscribe, subscribe')
 import Halogen as H
 import Halogen.ActusBlockly as ActusBlockly
 import Halogen.Analytics (handleActionWithAnalyticsTracking)
-import Halogen.Blockly (BlocklyMessage(..), blockly)
+import Halogen.Blockly (BlocklyMessage(..))
 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, button, 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.Extra (mapSubmodule)
+import Halogen.HTML (HTML)
 import Halogen.Monaco (KeyBindings(DefaultBindings))
 import Halogen.Monaco as Monaco
 import Halogen.Query (HalogenM)
 import Halogen.Query.EventSource (affEventSource, emit, eventListenerEventSource)
-import Halogen.SVG (GradientUnits(..), Translate(..), d, defs, gradientUnits, linearGradient, offset, path, stop, stopColour, svg, transform, x1, x2, y2)
-import Halogen.SVG as SVG
 import HaskellEditor.State (editorGetValue, editorResize, editorSetValue, handleAction) as HaskellEditor
 import HaskellEditor.Types (Action(..), State, initialState) as HE
 import HaskellEditor.Types (_compilationResult)
-import HaskellEditor.View (otherActions, render) as HaskellEditor
-import Home as Home
-import Icons (Icon(..), icon)
-import JSEditor as JSEditor
+import JavascriptEditor.Types (JSCompilationState(..))
 import Language.Haskell.Interpreter (_InterpreterResult)
 import Language.Haskell.Monaco as HM
 import Language.Javascript.Interpreter as JSI
 import LocalStorage as LocalStorage
+import MainFrame.Types (Action(..), ChildSlots, FrontendState(FrontendState), ModalView(..), Query(..), View(..), _activeJSDemo, _actusBlocklySlot, _authStatus, _blocklySlot, _createGistResult, _gistId, _haskellEditorSlot, _haskellState, _jsCompilationResult, _jsEditorKeybindings, _jsEditorSlot, _loadGistResult, _newProject, _projectName, _projects, _rename, _saveAs, _showBottomPanel, _showModal, _simulationState, _view, _walletSlot)
+import MainFrame.View (render)
 import Marlowe (SPParams_, getApiGistsByGistId)
 import Marlowe as Server
 import Marlowe.ActusBlockly as AMB
-import Marlowe.Blockly as MB
 import Marlowe.Gists (mkNewGist, playgroundFiles)
 import Marlowe.Parser (parseContract)
 import Monaco (isError)
-import Network.RemoteData (RemoteData(..), _Loading, _Success)
+import Network.RemoteData (RemoteData(..), _Success)
 import Network.RemoteData as RemoteData
-import NewProject.State (handleAction, render) as NewProject
+import NewProject.State (handleAction) as NewProject
 import NewProject.Types (Action(..), State, _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 Projects.State (handleAction, render) as Projects
+import Prelude (class Functor, Unit, Void, bind, const, discard, flip, identity, map, mempty, otherwise, pure, show, unit, void, ($), (<$>), (<<<), (<>), (=<<), (==))
+import Projects.State (handleAction) as Projects
 import Projects.Types (Action(..), State, _projects, emptyState) as Projects
 import Projects.Types (Lang(..))
-import Rename.State (handleAction, render) as Rename
+import Rename.State (handleAction) as Rename
 import Rename.Types (Action(..), State, _projectName, emptyState) as Rename
 import Router (Route, SubRoute)
 import Router as Router
 import Routing.Duplex as RD
 import Routing.Duplex as RT
 import Routing.Hash as Routing
-import SaveAs.State (handleAction, render) as SaveAs
+import SaveAs.State (handleAction) as SaveAs
 import SaveAs.Types (Action(..), State, _error, _projectName, emptyState) as SaveAs
 import Servant.PureScript.Ajax (AjaxError, ErrorDescription(..), errorToString, runAjaxError)
 import Servant.PureScript.Settings (SPSettings_)
@@ -88,7 +77,7 @@ import Simulation.Types as ST
 import StaticData (bufferLocalStorageKey, gistIdLocalStorageKey, jsBufferLocalStorageKey, marloweBufferLocalStorageKey)
 import StaticData as StaticData
 import Text.Pretty (pretty)
-import Types (Action(..), ChildSlots, FrontendState(FrontendState), JSCompilationState(..), ModalView(..), Query(..), View(..), WebData, _activeJSDemo, _actusBlocklySlot, _authStatus, _blocklySlot, _createGistResult, _gistId, _haskellEditorSlot, _haskellState, _jsCompilationResult, _jsEditorKeybindings, _jsEditorSlot, _loadGistResult, _newProject, _projectName, _projects, _rename, _saveAs, _showBottomPanel, _showModal, _simulationState, _view, _walletSlot)
+import Types (WebData)
 import Wallet as Wallet
 import Web.HTML (window) as Web
 import Web.HTML.HTMLDocument (toEventTarget)
@@ -658,158 +647,3 @@ selectView view = do
     BlocklyEditor -> void $ query _blocklySlot unit (Blockly.Resize unit)
     WalletEmulator -> pure unit
     ActusBlocklyEditor -> void $ query _actusBlocklySlot unit (ActusBlockly.Resize unit)
-
-render ::
-  forall m.
-  MonadAff m =>
-  SPSettings_ SPParams_ ->
-  FrontendState ->
-  ComponentHTML Action ChildSlots m
-render settings state =
-  div [ class_ (ClassName "site-wrap") ]
-    ( [ header [ classes [ noMargins, aHorizontal ] ]
-          [ div [ classes [ aHorizontal, fullWidth ] ]
-              [ div [ classes [ ClassName "group", aHorizontal, ClassName "marlowe-title-group" ] ]
-                  [ div [ class_ (ClassName "marlowe-logo"), onClick $ const $ Just $ ChangeView HomePage ] [ marloweIcon ]
-                  , h2 [ classes [ spaceLeft, uppercase, spaceRight ] ] [ text "Marlowe Playground" ]
-                  ]
-              , projectTitle
-              , div [ classes [ ClassName "group", ClassName "marlowe-links-group" ] ]
-                  [ a [ href "./tutorial/index.html", target "_blank", classes [ ClassName "external-links" ] ] [ text "Tutorial" ]
-                  , a [ onClick $ const $ Just $ ChangeView ActusBlocklyEditor, classes [ ClassName "external-links" ] ] [ text "Actus Labs" ]
-                  ]
-              ]
-          ]
-      , main []
-          [ topBar
-          , section [ id_ "main-panel" ]
-              [ tabContents HomePage [ Home.render state ]
-              , tabContents Simulation [ renderSubmodule _simulationState SimulationAction Simulation.render state ]
-              , tabContents HaskellEditor [ renderSubmodule _haskellState HaskellAction HaskellEditor.render state ]
-              , tabContents JSEditor [ JSEditor.render state ]
-              , tabContents BlocklyEditor
-                  [ slot _blocklySlot unit (blockly MB.rootBlockName MB.blockDefinitions) unit (Just <<< HandleBlocklyMessage)
-                  , MB.toolbox
-                  , MB.workspaceBlocks
-                  ]
-              , tabContents ActusBlocklyEditor
-                  [ slot _actusBlocklySlot unit (ActusBlockly.blockly AMB.rootBlockName AMB.blockDefinitions) unit (Just <<< HandleActusBlocklyMessage)
-                  , AMB.toolbox
-                  , AMB.workspaceBlocks
-                  ]
-              , tabContents WalletEmulator
-                  [ div [ classes [ ClassName "full-height" ] ]
-                      [ slot _walletSlot unit Wallet.mkComponent unit (Just <<< HandleWalletMessage) ]
-                  ]
-              ]
-          ]
-      , modal state
-      ]
-    )
-  where
-  projectTitle =
-    let
-      title = state ^. _projectName
-
-      isLoading = has (_createGistResult <<< _Loading) state
-
-      spinner = if isLoading then icon Spinner else div [ classes [ ClassName "empty" ] ] []
-    in
-      div [ classes [ ClassName "project-title" ] ] [ h1_ [ text title ], spinner ]
-
-  isActiveView activeView = state ^. _view <<< to (eq activeView)
-
-  isActiveTab activeView = if isActiveView activeView then [ active ] else []
-
-  tabContents activeView contents = if isActiveView activeView then div [ classes [ fullHeight, Classes.scroll ] ] contents else div [ classes [ hide ] ] contents
-
-  topBar = div [ class_ (ClassName "global-actions") ] ([ menuBar state ] <> otherActions (state ^. _view))
-
-  otherActions HaskellEditor = [ renderSubmodule _haskellState HaskellAction HaskellEditor.otherActions state ]
-
-  otherActions Simulation = [ renderSubmodule _simulationState SimulationAction Simulation.otherActions state ]
-
-  otherActions JSEditor = [ JSEditor.otherActions state ]
-
-  otherActions BlocklyEditor =
-    [ div [ classes [ ClassName "group" ] ]
-        [ button
-            [ onClick $ const $ Just SendBlocklyToSimulator
-            ]
-            [ text "Send To Simulator" ]
-        ]
-    ]
-
-  otherActions _ = []
-
-modal ::
-  forall m.
-  MonadAff m =>
-  FrontendState -> ComponentHTML Action ChildSlots m
-modal state = case state ^. _showModal of
-  Nothing -> text ""
-  Just view ->
-    div [ classes [ ClassName "modal" ] ]
-      [ div [ classes [ ClassName "modal-container" ] ]
-          [ div [ classes [ ClassName "modal-content" ] ]
-              [ a [ class_ (ClassName "close"), onClick $ const $ Just CloseModal ] [ text "x" ]
-              , modalContent view
-              ]
-          ]
-      ]
-  where
-  modalContent NewProject = renderSubmodule _newProject NewProjectAction NewProject.render state
-
-  modalContent OpenProject = renderSubmodule _projects ProjectsAction Projects.render state
-
-  modalContent OpenDemo = renderSubmodule identity DemosAction Demos.render state
-
-  modalContent RenameProject = renderSubmodule _rename RenameAction Rename.render state
-
-  modalContent SaveProjectAs = renderSubmodule _saveAs SaveAsAction SaveAs.render state
-
-  modalContent GithubLogin = authButton state
-
-menuBar :: forall p. FrontendState -> HTML p Action
-menuBar state =
-  div [ classes [ ClassName "menu-bar" ] ]
-    [ menuButton (OpenModal NewProject) "New" "New Project"
-    , gistModal (OpenModal OpenProject) "Open" "Open Project"
-    , menuButton (OpenModal OpenDemo) "Open Example" "Open Example"
-    , menuButton (OpenModal RenameProject) "Rename" "Rename Project"
-    , gistModal (GistAction PublishGist) "Save" "Save Project"
-    , gistModal (OpenModal SaveProjectAs) "Save As" "Save As New Project"
-    ]
-  where
-  menuButton action shortName longName =
-    a [ onClick $ const $ Just action ]
-      [ span [ class_ (ClassName "short-text") ] [ text shortName ]
-      , span [ class_ (ClassName "long-text") ] [ text longName ]
-      ]
-
-  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 =
-  svg [ SVG.width (SVG.Length 50.0), SVG.height (SVG.Length 41.628), SVG.viewBox (SVG.Box { x: 0, y: 0, width: 60, height: 42 }) ]
-    [ defs []
-        [ linearGradient [ id_ "marlowe__linear-gradient", x1 (SVG.Length 0.5), x2 (SVG.Length 0.5), y2 (SVG.Length 1.0), gradientUnits ObjectBoundingBox ]
-            [ stop [ offset (SVG.Length 0.221), stopColour "#832dc4" ] []
-            , stop [ offset (SVG.Length 0.377), stopColour "#5e35b8" ] []
-            , stop [ offset (SVG.Length 0.543), stopColour "#3f3dad" ] []
-            , stop [ offset (SVG.Length 0.704), stopColour "#2942a6" ] []
-            , stop [ offset (SVG.Length 0.857), stopColour "#1c45a2" ] []
-            , stop [ offset (SVG.Length 0.994), stopColour "#1746a0" ] []
-            ]
-        ]
-    , path
-        [ id_ "prefix__marlowe-logo"
-        , d "M90.464 35.544c1.02 0 2.232.024 2.736.072V30.4a42.042 42.042 0 00-30.06 10.124c-8.88-7.68-20.784-10.992-29.916-9.96v4.884c.516-.036 1.308-.06 2.208-.06h.048l.156-.012.2.012a19.663 19.663 0 012.264.112h.1c12.324 1.488 21.984 7.212 28.7 17.556a236 236 0 00-3.792 6.3c-.756-1.236-2.832-5.04-3.672-6.444a44.98 44.98 0 012.028-3.06c-1.284-1.26-2.484-2.4-3.732-3.588-.9 1.116-1.62 1.992-2.412 2.964-3.36-2.28-6.576-4.476-10.392-5.628A29.291 29.291 0 0033.2 42.228v29.688h4.98V47.424c5.028.876 10.332 2.736 14.472 6.672a46.733 46.733 0 00-3.9 17.832h5.172a34.82 34.82 0 012.628-13.644 43.568 43.568 0 013.24 7.884 44.62 44.62 0 01.864 5.736h2.3v-8.268h.072a.77.77 0 11.84-.768.759.759 0 01-.684.768h.072V71.9h-.3l.072.012h.228V71.9h2.4a24.792 24.792 0 014.128-13.728 42.589 42.589 0 012.7 13.74h5.296c0-5.088-1.992-14.6-4.092-18.552a22.176 22.176 0 0114.244-5.616c0 4-.012 8 0 12.012.012 4.032-.084 8.076.072 12.144h5.2V42.144a35.632 35.632 0 00-12.012 1.512 33.507 33.507 0 00-10.468 5.664c-1.092-1.9-2.316-3.432-3.564-5.244a37.471 37.471 0 0120.892-8.46c.504-.048 1.392-.072 2.412-.072z"
-        , transform (Translate { x: (negate 33.2), y: (negate 30.301) })
-        ]
-        []
-    ]