Marlowe refactoring (#2399)

* move mainframe into it's own THE module
* rename FrontendState to State
* rename blockly types

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,9 +10,9 @@ 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, State, _authStatus)
 
-authButton :: forall p. FrontendState -> HTML p Action
+authButton :: forall p. State -> HTML p Action
 authButton state =
   let
     authStatus = state ^. (_authStatus <<< to (map (view authStatusAuthRole)))

marlowe-playground-client/src/Halogen/ActusBlockly.purs

@@ -31,26 +31,26 @@ foreign import sendContractToShiny ::
   String ->
   Effect Unit
 
-type BlocklyState
+type State
   = { actusBlocklyState :: Maybe BT.BlocklyState
     , generator :: Maybe Generator
     , errorMessage :: Maybe String
     , showShiny :: Boolean
     }
 
-_actusBlocklyState :: Lens' BlocklyState (Maybe BT.BlocklyState)
+_actusBlocklyState :: Lens' State (Maybe BT.BlocklyState)
 _actusBlocklyState = prop (SProxy :: SProxy "actusBlocklyState")
 
-_generator :: Lens' BlocklyState (Maybe Generator)
+_generator :: Lens' State (Maybe Generator)
 _generator = prop (SProxy :: SProxy "generator")
 
-_errorMessage :: Lens' BlocklyState (Maybe String)
+_errorMessage :: Lens' State (Maybe String)
 _errorMessage = prop (SProxy :: SProxy "errorMessage")
 
-_showShiny :: Lens' BlocklyState Boolean
+_showShiny :: Lens' State Boolean
 _showShiny = prop (SProxy :: SProxy "showShiny")
 
-data BlocklyQuery a
+data Query a
   = Resize a
   | SetError String a
   | GetWorkspace (XML -> a)
@@ -60,19 +60,19 @@ data ContractFlavour
   = FS
   | F
 
-data BlocklyAction
+data Action
   = Inject String (Array BlockDefinition)
   | GetTerms ContractFlavour
   | RunAnalysis
 
-data BlocklyMessage
+data Message
   = Initialized
   | CurrentTerms ContractFlavour String
 
 type DSL m a
-  = HalogenM BlocklyState BlocklyAction () BlocklyMessage m a
+  = HalogenM State Action () Message m a
 
-blockly :: forall m. MonadEffect m => String -> Array BlockDefinition -> Component HTML BlocklyQuery Unit BlocklyMessage m
+blockly :: forall m. MonadEffect m => String -> Array BlockDefinition -> Component HTML Query Unit Message m
 blockly rootBlockName blockDefinitions =
   mkComponent
     { initialState: const { actusBlocklyState: Nothing, generator: Nothing, errorMessage: Just "(Labs is an experimental feature)", showShiny: false }
@@ -87,7 +87,7 @@ blockly rootBlockName blockDefinitions =
         }
     }
 
-handleQuery :: forall m a. MonadEffect m => BlocklyQuery a -> DSL m (Maybe a)
+handleQuery :: forall m a. MonadEffect m => Query a -> DSL m (Maybe a)
 handleQuery (Resize next) = do
   mState <- use _actusBlocklyState
   case mState of
@@ -120,7 +120,7 @@ handleQuery (LoadWorkspace xml next) = do
   assign _errorMessage Nothing
   pure $ Just next
 
-handleAction :: forall m. MonadEffect m => BlocklyAction -> DSL m Unit
+handleAction :: forall m. MonadEffect m => Action -> DSL m Unit
 handleAction (Inject rootBlockName blockDefinitions) = do
   blocklyState <- liftEffect $ Blockly.createBlocklyInstance rootBlockName (ElementId "actusBlocklyWorkspace") (ElementId "actusBlocklyToolbox")
   let
@@ -182,7 +182,7 @@ handleAction RunAnalysis = do
 blocklyRef :: RefLabel
 blocklyRef = RefLabel "blockly"
 
-render :: forall p. BlocklyState -> HTML p BlocklyAction
+render :: forall p. State -> HTML p Action
 render state =
   div []
     [ section [ classes [ panelSubHeader, aHorizontal ] ]
@@ -206,7 +206,7 @@ render state =
 
 shiny ::
   forall p.
-  BlocklyState -> HTML p BlocklyAction
+  State -> HTML p Action
 shiny state =
   aside [ classes ([ sidebarComposer, expanded false ] <> if state.showShiny then [] else [ hide ]) ]
     [ div [ attr (AttrName "style") "height: 100%;" ]
@@ -220,22 +220,22 @@ shiny state =
         ]
     ]
 
-toCodeButton :: forall p. String -> HTML p BlocklyAction
+toCodeButton :: forall p. String -> HTML p Action
 toCodeButton key =
   button
     [ onClick $ const $ Just $ GetTerms FS
     ]
     [ text key ]
 
-toStaticCodeButton :: forall p. String -> HTML p BlocklyAction
+toStaticCodeButton :: forall p. String -> HTML p Action
 toStaticCodeButton key =
   button
     [ onClick $ const $ Just $ GetTerms F
     , classes ([ alignedButtonInTheMiddle ])
     ]
     [ text key ]
 
-runAnalysis :: forall p. HTML p BlocklyAction
+runAnalysis :: forall p. HTML p Action
 runAnalysis =
   button
     [ onClick $ const $ Just $ RunAnalysis

marlowe-playground-client/src/Halogen/Blockly.purs

@@ -28,44 +28,44 @@ import Text.Extra as Text
 import Text.Pretty (pretty)
 import Type.Proxy (Proxy(..))
 
-type BlocklyState
+type State
   = { blocklyState :: Maybe BT.BlocklyState
     , generator :: Maybe Generator
     , errorMessage :: Maybe String
     }
 
-_blocklyState :: Lens' BlocklyState (Maybe BT.BlocklyState)
+_blocklyState :: Lens' State (Maybe BT.BlocklyState)
 _blocklyState = prop (SProxy :: SProxy "blocklyState")
 
-_generator :: Lens' BlocklyState (Maybe Generator)
+_generator :: Lens' State (Maybe Generator)
 _generator = prop (SProxy :: SProxy "generator")
 
-_errorMessage :: Lens' BlocklyState (Maybe String)
+_errorMessage :: Lens' State (Maybe String)
 _errorMessage = prop (SProxy :: SProxy "errorMessage")
 
-emptyState :: BlocklyState
+emptyState :: State
 emptyState = { blocklyState: Nothing, generator: Nothing, errorMessage: Nothing }
 
-data BlocklyQuery a
+data Query a
   = Resize a
   | SetCode String a
   | SetError String a
   | GetWorkspace (XML -> a)
   | LoadWorkspace XML a
   | GetCodeQuery a
 
-data BlocklyAction
+data Action
   = Inject String (Array BlockDefinition)
   | SetData Unit
   | GetCode
 
-data BlocklyMessage
+data Message
   = CurrentCode String
 
 type DSL slots m a
-  = HalogenM BlocklyState BlocklyAction slots BlocklyMessage m a
+  = HalogenM State Action slots Message m a
 
-blockly :: forall m. MonadEffect m => String -> Array BlockDefinition -> Component HTML BlocklyQuery Unit BlocklyMessage m
+blockly :: forall m. MonadEffect m => String -> Array BlockDefinition -> Component HTML Query Unit Message m
 blockly rootBlockName blockDefinitions =
   mkComponent
     { initialState: const emptyState
@@ -80,7 +80,7 @@ blockly rootBlockName blockDefinitions =
         }
     }
 
-handleQuery :: forall slots m a. MonadEffect m => BlocklyQuery a -> DSL slots m (Maybe a)
+handleQuery :: forall slots m a. MonadEffect m => Query a -> DSL slots m (Maybe a)
 handleQuery (Resize next) = do
   mState <- use _blocklyState
   case mState of
@@ -147,7 +147,7 @@ handleQuery (GetCodeQuery next) = do
   where
   unexpected s = "An unexpected error has occurred, please raise a support issue at https://github.com/input-output-hk/plutus/issues/new: " <> s
 
-handleAction :: forall m slots. MonadEffect m => BlocklyAction -> DSL slots m Unit
+handleAction :: forall m slots. MonadEffect m => Action -> DSL slots m Unit
 handleAction (Inject rootBlockName blockDefinitions) = do
   blocklyState <- liftEffect $ Blockly.createBlocklyInstance rootBlockName (ElementId "blocklyWorkspace") (ElementId "blocklyToolbox")
   let
@@ -189,7 +189,7 @@ handleAction GetCode = do
 blocklyRef :: RefLabel
 blocklyRef = RefLabel "blockly"
 
-render :: forall p. BlocklyState -> HTML p BlocklyAction
+render :: forall p. State -> HTML p Action
 render state =
   div []
     [ div
@@ -200,13 +200,13 @@ render state =
         [ errorMessage state.errorMessage ]
     ]
 
-otherActions :: forall p. BlocklyState -> HTML p BlocklyAction
+otherActions :: forall p. State -> HTML p Action
 otherActions state =
   div []
     [ toCodeButton "Send To Simulator"
     ]
 
-toCodeButton :: forall p. String -> HTML p BlocklyAction
+toCodeButton :: forall p. String -> HTML p Action
 toCodeButton key =
   button
     [ onClick $ const $ Just GetCode

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

@@ -3,13 +3,13 @@ module Home where
 import Data.Maybe (Maybe(..))
 import Halogen (ClassName(..), ComponentHTML)
 import Halogen.Classes (blocklyIconColour, flex, fullWidth, haskellIcon, horizontalFlip, javascriptIcon, marloweLogo2, rightArrow, scroll, simulationIcon)
-import Halogen.HTML (button, div, div_, h2_, h3_, img, p_, text)
+import Halogen.HTML (button, div, div_, h2_, 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, State)
 
-render :: forall m. FrontendState -> ComponentHTML Action ChildSlots m
+render :: forall m. State -> ComponentHTML Action ChildSlots m
 render state =
   div [ classes [ scroll, ClassName "homepage-container" ] ]
     [ div [ classes [ ClassName "marlowe-intro-container" ] ]
@@ -40,7 +40,7 @@ render state =
         ]
     ]
 
-startWithHaskell :: forall m. FrontendState -> ComponentHTML Action ChildSlots m
+startWithHaskell :: forall m. State -> ComponentHTML Action ChildSlots m
 startWithHaskell state =
   div [ classes [ ClassName "start-with-haskell", ClassName "even-item" ] ]
     [ div [ classes [ ClassName "group", ClassName "compilers-group" ] ]
@@ -69,7 +69,7 @@ startWithHaskell state =
         ]
     ]
 
-startWithMarlowe :: forall m. FrontendState -> ComponentHTML Action ChildSlots m
+startWithMarlowe :: forall m. State -> ComponentHTML Action ChildSlots m
 startWithMarlowe state =
   div [ classes [ ClassName "start-with-marlowe" ] ]
     [ marloweBlocklyBox state
@@ -80,7 +80,7 @@ startWithMarlowe state =
         ]
     ]
 
-marloweBlocklyBox :: forall m. FrontendState -> ComponentHTML Action ChildSlots m
+marloweBlocklyBox :: forall m. State -> ComponentHTML Action ChildSlots m
 marloweBlocklyBox state =
   div [ classes [ ClassName "marlowe-blockly-box" ] ]
     [ div [ classes [ ClassName "t-align-center" ] ]

marlowe-playground-client/src/JSEditor.purs

@@ -15,19 +15,20 @@ 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, State, _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.
   MonadAff m =>
-  FrontendState ->
+  State ->
   ComponentHTML Action ChildSlots m
 render state =
   div_
@@ -38,20 +39,20 @@ render state =
     , bottomPanel state
     ]
 
-otherActions :: forall p. FrontendState -> HTML p Action
+otherActions :: forall p. State -> HTML p Action
 otherActions state =
   div [ classes [ ClassName "group" ] ]
     [ editorOptions state
     , compileButton state
     , sendButton state
     ]
 
-sendButton :: forall p. FrontendState -> HTML p Action
+sendButton :: forall p. State -> HTML p Action
 sendButton state = case view _jsCompilationResult state of
   JSCompiledSuccessfully _ -> button [ onClick $ const $ Just SendResultJSToSimulator ] [ text "Send To Simulator" ]
   _ -> text ""
 
-editorOptions :: forall p. FrontendState -> HTML p Action
+editorOptions :: forall p. State -> HTML p Action
 editorOptions state =
   div [ class_ (ClassName "editor-options") ]
     [ select
@@ -71,7 +72,7 @@ editorOptions state =
 jsEditor ::
   forall m.
   MonadAff m =>
-  FrontendState ->
+  State ->
   ComponentHTML Action ChildSlots m
 jsEditor state = slot _jsEditorSlot unit component unit (Just <<< JSHandleEditorMessage)
   where
@@ -85,7 +86,7 @@ jsEditor state = slot _jsEditorSlot unit component unit (Just <<< JSHandleEditor
 
   component = monacoComponent $ JSM.settings setup
 
-bottomPanel :: forall p. FrontendState -> HTML p Action
+bottomPanel :: forall p. State -> HTML p Action
 bottomPanel state =
   div
     ( [ classes
@@ -115,7 +116,7 @@ bottomPanel state =
   where
   showingBottomPanel = state ^. _showBottomPanel
 
-compileButton :: forall p. FrontendState -> HTML p Action
+compileButton :: forall p. State -> HTML p Action
 compileButton state =
   button [ onClick $ const $ Just CompileJSProgram ]
     [ text (if state ^. _jsCompilationResult <<< to isLoading then "Compiling..." else "Compile") ]
@@ -124,7 +125,7 @@ compileButton state =
 
   isLoading _ = false
 
-resultPane :: forall p. FrontendState -> Array (HTML p Action)
+resultPane :: forall p. State -> Array (HTML p Action)
 resultPane state =
   if state ^. _showBottomPanel then case view _jsCompilationResult state of
     JSCompiledSuccessfully (InterpreterResult result) ->

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)