Allow importing Marlowe Extended contracts with holes

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

@@ -259,7 +259,7 @@ handleSubRoute Router.MarloweEditor = selectView MarloweEditor
 
 handleSubRoute (Router.ImportContract contract) = do
   handleActionWithoutNavigationGuard
-    (MarloweEditorAction (ME.ImportCompressedJSON contract))
+    (MarloweEditorAction (ME.ImportCompressedContract contract))
   selectView MarloweEditor
 
 handleSubRoute Router.HaskellEditor = selectView HaskellEditor

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

@@ -20,7 +20,7 @@ import Data.Lens (assign, modifying, over, preview, set, use)
 import Data.Lens.Index (ix)
 import Data.Map as Map
 import Data.Map.Ordered.OMap as OMap
-import Data.Maybe (fromMaybe)
+import Data.Maybe (fromMaybe, maybe)
 import Data.String (Pattern(..), codePointFromChar, contains, length, splitAt)
 import Data.String as String
 import Data.Time.Duration (Minutes(..))
@@ -151,12 +151,14 @@ handleAction _ (LoadScript key) = do
 
 handleAction _ (SetEditorText contents) = editorSetValue contents
 
-handleAction _ (ImportCompressedJSON contents) = do
+handleAction _ (ImportCompressedContract contents) = do
   let
-    decodedContract = case parseDecodeJson (decompressFromURI contents) of
-      Right contract -> contract
-      Left _ -> Extended.Close
-    termContract = toTerm decodedContract :: Holes.Term Holes.Contract
+    decompressedInput = decompressFromURI contents
+    termContract = case parseDecodeJson decompressedInput of
+      Right contract -> toTerm (contract :: Extended.Contract)
+      Left _ -> case parseContract decompressedInput of
+        Right hcontract -> hcontract
+        Left _ -> toTerm Extended.Close
     prettyContents = show $ pretty termContract
   editorSetValue prettyContents
   liftEffect $ SessionStorage.setItem marloweBufferLocalStorageKey
@@ -181,8 +183,11 @@ handleAction _ CopyContractLink = do
   mResult <-
     ( runMaybeT $ do
         contents <- MaybeT $ editorGetValue
-        contract <- hoistMaybe $ parseContract' contents
-        let compressedContract = compressToURI $ stringify $ encodeJson contract
+        encodedContract <- hoistMaybe $ maybe
+          (show <$> (hush $ parseContract contents))
+          (Just <<< stringify <<< encodeJson)
+          (parseContract' contents)
+        let compressedContract = compressToURI encodedContract
         hoistMaybe $ composeURL url compressedContract
     )
   case mResult of

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

@@ -32,7 +32,7 @@ data Action
   | MoveToPosition Pos Pos
   | LoadScript String
   | SetEditorText String
-  | ImportCompressedJSON String
+  | ImportCompressedContract String
   | BottomPanelAction (BottomPanel.Action BottomPanelView Action)
   | ShowErrorDetail Boolean
   | SendToSimulator
@@ -61,7 +61,8 @@ instance actionIsEvent :: IsEvent Action where
   toEvent (LoadScript script) = Just $ (defaultEvent "LoadScript")
     { label = Just script }
   toEvent (SetEditorText _) = Just $ defaultEvent "SetEditorText"
-  toEvent (ImportCompressedJSON _) = Just $ defaultEvent "ImportCompressedJSON"
+  toEvent (ImportCompressedContract _) = Just $ defaultEvent
+    "ImportCompressedContract"
   toEvent (BottomPanelAction action) = A.toEvent action
   toEvent (ShowErrorDetail _) = Just $ defaultEvent "ShowErrorDetail"
   toEvent SendToSimulator = Just $ defaultEvent "SendToSimulator"

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

@@ -162,11 +162,11 @@ copyLink state =
     , tooltip tooltipMessage (RefId "copyContractLink") Bottom
     ]
   where
-  disabled' = contractHasErrors state || contractHasHoles state
+  disabled' = contractHasErrors state
 
   tooltipMessage =
     if disabled' then
-      "A contract link can only be generated if the contract has no errors and no holes"
+      "A contract link can only be generated if the contract has no errors"
     else
       "Copy a link to the Marlowe editor with the current contract encoded in the URL"