more lints

marlowe-playground-client/src/Examples/JS/Contracts.purs

@@ -1,5 +1,12 @@
 module Examples.JS.Contracts where
 
+example :: String
+example =
+  """
+Close
+
+"""
+
 escrow :: String
 escrow =
   """/* Parties */

marlowe-playground-client/src/MainFrame.purs

@@ -17,10 +17,12 @@ import Data.List.NonEmpty as NEL
 import Data.Map as Map
 import Data.Maybe (Maybe(..), fromMaybe)
 import Data.Newtype (unwrap)
-import Demos.View (render) as Demos
 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(..))
@@ -44,8 +46,8 @@ 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.Types as HE
 import HaskellEditor.View (otherActions, render) as HaskellEditor
 import Home as Home
 import Icons (Icon(..), icon)
@@ -70,7 +72,7 @@ import Projects.State (handleAction, render) as Projects
 import Projects.Types (Action(..), State, _projects, emptyState) as Projects
 import Projects.Types (Lang(..))
 import Rename.State (handleAction, render) as Rename
-import Rename.Types (Action(..), State, _error, _projectName, emptyState) as Rename
+import Rename.Types (Action(..), State, _projectName, emptyState) as Rename
 import Router (Route, SubRoute)
 import Router as Router
 import Routing.Duplex as RD
@@ -287,6 +289,7 @@ handleAction s (SimulationAction action) = do
       selectView BlocklyEditor
     ST.EditHaskell -> selectView HaskellEditor
     ST.EditJavascript -> selectView JSEditor
+    ST.EditActus -> selectView ActusBlocklyEditor
     ST.Save -> pure unit
     _ -> pure unit
 
@@ -358,6 +361,10 @@ handleAction s SendResultJSToSimulator = do
             Simulation.handleAction s (ST.SetEditorText (show $ pretty contract))
             Simulation.handleAction s ST.ResetContract
 
+handleAction _ (ChangeView ActusBlocklyEditor) = do
+  assign (_simulationState <<< ST._source) Actus
+  selectView ActusBlocklyEditor
+
 handleAction _ (ChangeView view) = selectView view
 
 handleAction _ (ShowBottomPanel val) = do
@@ -419,7 +426,14 @@ handleAction s (NewProjectAction action@(NewProject.CreateProject lang)) = do
   assign _gistId Nothing
   assign _createGistResult NotAsked
   liftEffect $ LocalStorage.setItem gistIdLocalStorageKey mempty
+  toHaskellEditor $ HaskellEditor.editorSetValue HE.example
+  liftEffect $ LocalStorage.setItem bufferLocalStorageKey HE.example
+  void $ query _jsEditorSlot unit (Monaco.SetText JE.example unit)
+  liftEffect $ LocalStorage.setItem jsBufferLocalStorageKey JE.example
+  toSimulation $ Simulation.editorSetValue "?new_contract"
+  liftEffect $ LocalStorage.setItem marloweBufferLocalStorageKey "?new_contract"
   traverse_ selectView $ selectLanguageView lang
+  assign (_simulationState <<< ST._source) lang
   assign _showModal Nothing
   toNewProject $ NewProject.handleAction s action
 
@@ -435,16 +449,9 @@ handleAction s (DemosAction action@(Demos.LoadDemo lang (Demos.Demo key))) = do
   traverse_ selectView $ selectLanguageView lang
 
 handleAction s (RenameAction action@Rename.SaveProject) = do
-  currentName <- use _projectName
   projectName <- use (_rename <<< Rename._projectName)
   assign _projectName projectName
-  handleGistAction s PublishGist
-  res <- peruse (_createGistResult <<< _Success)
-  case res of
-    Just gist -> assign _showModal Nothing
-    Nothing -> do
-      assign (_rename <<< Rename._error) (Just "Could not save project")
-      assign _projectName currentName
+  assign _showModal Nothing
   toRename $ Rename.handleAction s action
 
 handleAction s (RenameAction action) = toRename $ Rename.handleAction s action
@@ -497,6 +504,8 @@ selectLanguageView Blockly = Just BlocklyEditor
 
 selectLanguageView Javascript = Just JSEditor
 
+selectLanguageView Actus = Just ActusBlocklyEditor
+
 ----------
 showErrorDescription :: ErrorDescription -> String
 showErrorDescription (DecodingError err@"(\"Unexpected token E in JSON at position 0\" : Nil)") = "BadResponse"
@@ -762,7 +771,7 @@ menuBar state =
     , gistModal (OpenModal OpenProject) "Open" "Open Project"
     , menuButton (OpenModal OpenDemo) "Open Demo" "Open Demo"
     , menuButton (OpenModal RenameProject) "Rename" "Rename Project"
-    , menuButton (GistAction PublishGist) "Save" "Save Project"
+    , gistModal (GistAction PublishGist) "Save" "Save Project"
     , gistModal (OpenModal SaveProjectAs) "Save As" "Save As New Project"
     ]
   where

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

@@ -16,6 +16,7 @@ data Lang
   | Haskell
   | Javascript
   | Blockly
+  | Actus
 
 derive instance eqLang :: Eq Lang
 

marlowe-playground-client/src/Simulation.purs

@@ -27,7 +27,7 @@ import Effect.Aff.Class (class MonadAff, liftAff)
 import Effect.Class (class MonadEffect, liftEffect)
 import FileEvents (readFileFromDragEvent)
 import FileEvents as FileEvents
-import Halogen (ClassName(..), HalogenM, query)
+import Halogen (HalogenM, query)
 import Halogen.Classes (aHorizontal, activeClasses, bold, closeDrawerIcon, codeEditor, expanded, fullHeight, infoIcon, noMargins, panelSubHeaderSide, plusBtn, pointer, scroll, sidebarComposer, smallBtn, spanText, textSecondaryColor, uppercase)
 import Halogen.Classes as Classes
 import Halogen.HTML (ClassName(..), ComponentHTML, HTML, a, article, aside, b_, br_, button, div, em_, h6, h6_, img, input, li, option, p, p_, section, select, slot, small, strong_, text, ul)
@@ -224,6 +224,8 @@ handleAction _ EditHaskell = pure unit
 
 handleAction _ EditJavascript = pure unit
 
+handleAction _ EditActus = pure unit
+
 handleAction settings AnalyseContract = do
   currContract <- use _currentContract
   maybeExecutionState <- use (_currentMarloweState <<< _executionState)
@@ -373,6 +375,11 @@ otherActions state =
             else
               []
           )
+        <> ( if state ^. (_source <<< to (eq Actus)) then
+              [ actusSourceButton state ]
+            else
+              []
+          )
     )
 
 sendToBlocklyButton :: forall p. State -> HTML p Action
@@ -400,6 +407,13 @@ javascriptSourceButton state =
     ]
     [ text "Edit Javascript Source" ]
 
+actusSourceButton :: forall p. State -> HTML p Action
+actusSourceButton state =
+  button
+    [ onClick $ const $ Just $ EditActus
+    ]
+    [ text "Edit Actus Source" ]
+
 editorOptions :: forall p. State -> HTML p Action
 editorOptions state =
   div [ class_ (ClassName "editor-options") ]

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

@@ -179,6 +179,7 @@ data Action
   | SetBlocklyCode
   | EditHaskell
   | EditJavascript
+  | EditActus
   -- websocket
   | AnalyseContract
   | AnalyseReachabilityContract
@@ -214,6 +215,7 @@ instance isEventAction :: IsEvent Action where
   toEvent SetBlocklyCode = Just $ defaultEvent "SetBlocklyCode"
   toEvent EditHaskell = Just $ defaultEvent "EditHaskell"
   toEvent EditJavascript = Just $ defaultEvent "EditJavascript"
+  toEvent EditActus = Just $ defaultEvent "EditActus"
   toEvent AnalyseContract = Just $ defaultEvent "AnalyseContract"
   toEvent AnalyseReachabilityContract = Just $ defaultEvent "AnalyseReachabilityContract"
   toEvent Save = Just $ defaultEvent "Save"

marlowe-playground-client/src/StaticData.purs

@@ -13,9 +13,9 @@ import Data.Map (Map)
 import Data.Map as Map
 import Data.Semigroup ((<>))
 import Data.Tuple.Nested ((/\), type (/\))
-import Examples.Haskell.Contracts (contractForDifference, escrow, zeroCouponBond, couponBondGuaranteed, swap) as HE
-import Examples.Marlowe.Contracts (contractForDifference, escrow, zeroCouponBond, option, swap) as ME
-import Examples.JS.Contracts (cfd, escrow, zeroCouponBond, couponBondGuaranteed, swap) as JSE
+import Examples.Haskell.Contracts (contractForDifference, couponBondGuaranteed, escrow, example, swap, zeroCouponBond) as HE
+import Examples.JS.Contracts (cfd, couponBondGuaranteed, escrow, example, swap, zeroCouponBond) as JSE
+import Examples.Marlowe.Contracts (contractForDifference, escrow, example, option, swap, zeroCouponBond) as ME
 import LocalStorage as LocalStorage
 
 type Label
@@ -28,7 +28,8 @@ demoFiles ::
   Map Label Contents
 demoFiles =
   Map.fromFoldable
-    [ "Escrow" /\ HE.escrow
+    [ "Example" /\ HE.example
+    , "Escrow" /\ HE.escrow
     , "ZeroCouponBond" /\ HE.zeroCouponBond
     , "CouponBondGuaranteed" /\ HE.couponBondGuaranteed
     , "Swap" /\ HE.swap
@@ -53,7 +54,8 @@ demoFilesJS ::
   Map Label Contents
 demoFilesJS =
   Map.fromFoldable
-    [ "Escrow" /\ addHeader JSE.escrow
+    [ "Example" /\ addHeader JSE.example
+    , "Escrow" /\ addHeader JSE.escrow
     , "ZeroCouponBond" /\ addHeader JSE.zeroCouponBond
     , "CouponBondGuaranteed" /\ addHeader JSE.couponBondGuaranteed
     , "Swap" /\ addHeader JSE.swap
@@ -63,12 +65,12 @@ demoFilesJS =
 marloweContracts ::
   Array (Label /\ Contents)
 marloweContracts =
-  [ "Escrow" /\ ME.escrow
+  [ "Example" /\ ME.example
+  , "Escrow" /\ ME.escrow
   , "ZeroCouponBond" /\ ME.zeroCouponBond
   , "Option" /\ ME.option
   , "Swap" /\ ME.swap
   , "CFD" /\ ME.contractForDifference
-  , "Empty" /\ "?empty_contract"
   ]
 
 marloweContract ::

marlowe-playground-server/app/PSGenerator.hs

@@ -30,6 +30,7 @@ import qualified Data.Set                                         as Set ()
 import qualified Data.Text.Encoding                               as T ()
 import qualified Data.Text.IO                                     as T ()
 import qualified Escrow
+import qualified Example
 import           Language.Haskell.Interpreter                     (CompilationError, InterpreterError,
                                                                    InterpreterResult, SourceCode, Warning)
 import           Language.Marlowe
@@ -45,7 +46,7 @@ import           Language.PureScript.Bridge.CodeGenSwitches       (ForeignOption
 import           Language.PureScript.Bridge.PSTypes               (psNumber, psString)
 import           Language.PureScript.Bridge.TypeParameters        (A)
 import           Marlowe.Contracts                                (contractForDifference, couponBondGuaranteed, escrow,
-                                                                   swap, zeroCouponBond)
+                                                                   swap, zeroCouponBond, example)
 import qualified Marlowe.Symbolic.Server                          as MS
 import qualified Marlowe.Symbolic.Types.Request                   as MSReq
 import qualified Marlowe.Symbolic.Types.Response                  as MSRes
@@ -183,7 +184,8 @@ psModule name body = "module " <> name <> " where" <> body
 writeUsecases :: FilePath -> IO ()
 writeUsecases outputDir = do
     let haskellUsecases =
-            multilineString "escrow" escrow
+            multilineString "example" example
+         <> multilineString "escrow" escrow
          <> multilineString "zeroCouponBond" zeroCouponBond
          <> multilineString "couponBondGuaranteed" couponBondGuaranteed
          <> multilineString "swap" swap
@@ -193,7 +195,8 @@ writeUsecases outputDir = do
     BS.writeFile (outputDir </> "Examples" </> "Haskell" </> "Contracts.purs") haskellUsecasesModule
     let contractToString = BS8.pack . show . pretty
         marloweUsecases =
-            multilineString "escrow" (contractToString Escrow.contract)
+            multilineString "example" (contractToString Example.contract)
+         <> multilineString "escrow" (contractToString Escrow.contract)
          <> multilineString "zeroCouponBond" (contractToString ZeroCouponBond.contract)
          <> multilineString "option" (contractToString Option.contract)
          <> multilineString "swap" (contractToString Swap.contract)

marlowe-playground-server/marlowe-playground-server.cabal

@@ -75,6 +75,7 @@ executable marlowe-playground-server
         PSGenerator
         Types
         Escrow
+        Example
         CouponBondGuaranteed
         ZeroCouponBond
         Swap

marlowe-playground-server/src/Marlowe/Contracts.hs

@@ -5,6 +5,9 @@ module Marlowe.Contracts where
 import           Data.ByteString (ByteString)
 import           Data.FileEmbed  (embedFile, makeRelativeToProject)
 
+example :: ByteString
+example = $(makeRelativeToProject "contracts/Example.hs" >>= embedFile)
+
 escrow :: ByteString
 escrow = $(makeRelativeToProject "contracts/Escrow.hs" >>= embedFile)