Merge pull request #54 from input-output-hk/switch-to-blockly-param

PLT-8331 - Add ability to jump into blockly when loading contract from URL

changelog.d/20231028_163530_tomasz.rybarczyk_switch_to_blockly_param.md

@@ -0,0 +1,40 @@
+<!--
+A new scriv changelog fragment.
+
+Uncomment the section that is right (remove the HTML comment wrapper).
+-->
+
+<!--
+### Removed
+
+- A bullet item for the Removed category.
+
+-->
+### Added
+
+- A parameter `marlowe-view=(blockly|editor)` to contract import route.
+
+<!--
+### Changed
+
+- A bullet item for the Changed category.
+
+-->
+<!--
+### Deprecated
+
+- A bullet item for the Deprecated category.
+
+-->
+<!--
+### Fixed
+
+- A bullet item for the Fixed category.
+
+-->
+<!--
+### Security
+
+- A bullet item for the Security category.
+
+-->

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

@@ -113,7 +113,7 @@ import Page.Simulation.State as Simulation
 import Page.Simulation.Types as ST
 import Rename.State (handleAction) as Rename
 import Rename.Types (Action(..), State, emptyState) as Rename
-import Router (Route, SubRoute)
+import Router (MarloweView(..), Route, SubRoute)
 import Router as Router
 import Routing.Duplex as RD
 import Routing.Hash as Routing
@@ -257,10 +257,12 @@ handleSubRoute Router.Simulation = selectView Simulation
 
 handleSubRoute Router.MarloweEditor = selectView MarloweEditor
 
-handleSubRoute (Router.ImportContract contract) = do
+handleSubRoute (Router.ImportContract props) = do
   handleActionWithoutNavigationGuard
-    (MarloweEditorAction (ME.ImportCompressedContract contract))
-  selectView MarloweEditor
+    (MarloweEditorAction (ME.ImportCompressedContract props.contract))
+  case props."marlowe-view" of
+    MarloweEditorView -> selectView MarloweEditor
+    MarloweBlocklyView -> selectView BlocklyEditor
 
 handleSubRoute Router.HaskellEditor = selectView HaskellEditor
 

marlowe-playground-client/src/Page/MarloweEditor/State.purs

@@ -59,8 +59,8 @@ import Page.MarloweEditor.Types
   , _selectedHole
   , _showErrorDetail
   )
+import Router (MarloweView(..), printSubRoute)
 import Router (SubRoute(..)) as Route
-import Router (printSubRoute)
 import Servant.PureScript (class MonadAjax)
 import SessionStorage as SessionStorage
 import StaticAnalysis.Reachability
@@ -198,7 +198,12 @@ handleAction _ CopyContractLink = do
   composeURL :: String -> String -> Maybe String
   composeURL url compCont = do
     baseUrl <- removeSuffix url (printSubRoute Route.MarloweEditor)
-    pure $ baseUrl <> (printSubRoute (Route.ImportContract compCont))
+    let
+      subroute = Route.ImportContract
+        { contract: compCont
+        , "marlowe-view": MarloweEditorView
+        }
+    pure $ baseUrl <> printSubRoute subroute
 
   removeSuffix :: String -> String -> Maybe String
   removeSuffix str suffix =

marlowe-playground-client/src/Router.purs

@@ -7,21 +7,45 @@ import Data.Newtype (unwrap)
 import Data.Profunctor (dimap)
 import Gists.Extra (GistId(..))
 import Routing.Duplex (RouteDuplex', optional, param, record, root, (:=))
+import Routing.Duplex as RD
 import Routing.Duplex as Route
 import Routing.Duplex.Generic (noArgs, sum)
-import Routing.Duplex.Generic.Syntax ((/))
+import Routing.Duplex.Generic.Syntax ((/), (?))
 import Type.Proxy (Proxy(..))
 
 type Route =
   { subroute :: SubRoute
   , gistId :: Maybe GistId
   }
 
+data MarloweView = MarloweBlocklyView | MarloweEditorView
+
+derive instance Eq MarloweView
+
+derive instance Generic MarloweView _
+
+marloweViewToString :: MarloweView -> String
+marloweViewToString = case _ of
+  MarloweBlocklyView -> "blockly"
+  MarloweEditorView -> "editor"
+
+marloweViewFromString :: String -> Either String MarloweView
+marloweViewFromString = case _ of
+  "blockly" -> Right MarloweBlocklyView
+  "editor" -> Right MarloweEditorView
+  val -> Left $ "Not a Marlowe view: " <> val
+
+marloweView :: RouteDuplex' String -> RouteDuplex' MarloweView
+marloweView = RD.as marloweViewToString marloweViewFromString
+
 data SubRoute
   = Home
   | Simulation
   | MarloweEditor
-  | ImportContract String
+  | ImportContract
+      { contract :: String
+      , "marlowe-view" :: MarloweView
+      }
   | HaskellEditor
   | JSEditor
   | Blockly
@@ -41,7 +65,8 @@ route =
           { "Home": noArgs
           , "Simulation": "simulation" / noArgs
           , "MarloweEditor": "marlowe" / noArgs
-          , "ImportContract": "importContract" / (param "contract")
+          , "ImportContract": "importContract" ?
+              { contract: RD.string, "marlowe-view": marloweView }
           , "HaskellEditor": "haskell" / noArgs
           , "JSEditor": "javascript" / noArgs
           , "Blockly": "blockly" / noArgs