From 283c731710ee45c38b35f96752a2f302f0bd2335 Mon Sep 17 00:00:00 2001
From: Tomasz Rybarczyk <tomasz.rybarczyk@iohk.io>
Date: Sat, 28 Oct 2023 16:22:25 +0200
Subject: [PATCH] Add ability to jump into blockly when loading contract from
 URL

Closes: PLT-8331
---
 ...omasz.rybarczyk_switch_to_blockly_param.md | 40 +++++++++++++++++++
 .../src/MainFrame/State.purs                  | 10 +++--
 .../src/Page/MarloweEditor/State.purs         |  9 ++++-
 marlowe-playground-client/src/Router.purs     | 31 ++++++++++++--
 4 files changed, 81 insertions(+), 9 deletions(-)
 create mode 100644 changelog.d/20231028_163530_tomasz.rybarczyk_switch_to_blockly_param.md

diff --git a/changelog.d/20231028_163530_tomasz.rybarczyk_switch_to_blockly_param.md b/changelog.d/20231028_163530_tomasz.rybarczyk_switch_to_blockly_param.md
new file mode 100644
index 000000000..074a43a19
--- /dev/null
+++ b/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.
+
+-->
diff --git a/marlowe-playground-client/src/MainFrame/State.purs b/marlowe-playground-client/src/MainFrame/State.purs
index 67685fde0..f79b12d26 100644
--- a/marlowe-playground-client/src/MainFrame/State.purs
+++ b/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
 
diff --git a/marlowe-playground-client/src/Page/MarloweEditor/State.purs b/marlowe-playground-client/src/Page/MarloweEditor/State.purs
index f92c17e73..a5af37bbd 100644
--- a/marlowe-playground-client/src/Page/MarloweEditor/State.purs
+++ b/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 =
diff --git a/marlowe-playground-client/src/Router.purs b/marlowe-playground-client/src/Router.purs
index b7e143da2..82b07f649 100644
--- a/marlowe-playground-client/src/Router.purs
+++ b/marlowe-playground-client/src/Router.purs
@@ -7,9 +7,10 @@ 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 =
@@ -17,11 +18,34 @@ type Route =
   , 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