fixes

marlowe-actus/src/Language/Marlowe/ACTUS/Generator.hs

@@ -8,10 +8,10 @@ module Language.Marlowe.ACTUS.Generator
     )
 where
 
-import qualified Data.List                                               as L (scanl, tail, zip, zip6)
+import qualified Data.List                                               as L (zip6)
 import           Data.Maybe                                              (fromMaybe, isNothing, maybeToList)
 import           Data.String                                             (IsString (fromString))                            
-import           Data.Time                                               (Day, fromGregorian)
+import           Data.Time                                               (Day)
 import Data.Monoid
 import           Language.Marlowe                                        (AccountId (AccountId),
                                                                           Action (Choice, Deposit), Bound (Bound),
@@ -20,7 +20,7 @@ import           Language.Marlowe                                        (Accoun
                                                                           Party (Role), Payee (Party), Slot (..),
                                                                           Value (ChoiceValue, Constant, NegValue, UseValue),
                                                                           ValueId (ValueId), ada)
-import           Language.Marlowe.ACTUS.Definitions.BusinessEvents       (EventType (..), RiskFactors (..))
+import           Language.Marlowe.ACTUS.Definitions.BusinessEvents       (EventType (..))
 import           Language.Marlowe.ACTUS.Definitions.ContractTerms        (ContractTerms(ct_CURS, ct_SD, constraints), Assertions(..), AssertionContext(..))
 import           Language.Marlowe.ACTUS.Definitions.Schedule             (CashFlow (..))
 import           Language.Marlowe.ACTUS.MarloweCompat                    (dayToSlotNumber, constnt, toMarloweFixedPoint)
@@ -121,7 +121,7 @@ genFsContract terms =
                 toAssert = genZeroRiskAssertions terms <$> (assertions =<< maybeToList ctr)
                 compose = appEndo . mconcat . map Endo
             in compose toAssert cont
-            
+
         payoffAt t = ValueId $ fromString $ "payoff_" ++ show t
         schedCfs = genProjectedCashflows terms
         schedEvents = cashEvent <$> schedCfs

marlowe-playground-client/src/MainFrame.purs

@@ -58,7 +58,7 @@ import Marlowe.Monaco as MM
 import Monaco (IMarkerData, markerSeverity)
 import Network.RemoteData (RemoteData(..), _Success)
 import Network.RemoteData as RemoteData
-import Prelude (class Functor, Unit, bind, const, discard, eq, flip, identity, map, mempty, negate, pure, show, unit, void, ($), (<<<), (<>), (>))
+import Prelude (class Functor, Unit, bind, const, discard, eq, flip, identity, map, mempty, negate, pure, show, unit, void, ($), (<<<), (<>), (>), (<$>))
 import Servant.PureScript.Ajax (AjaxError)
 import Servant.PureScript.Ajax (AjaxError, ErrorDescription(..), runAjaxError)
 import Servant.PureScript.Settings (SPSettingsDecodeJson_(..))
@@ -146,6 +146,8 @@ handleRoute Router.HaskellEditor = selectView HaskellEditor
 
 handleRoute Router.Blockly = selectView BlocklyEditor
 
+handleRoute Router.ActusBlocklyEditor = selectView ActusBlocklyEditor
+
 handleRoute Router.Wallets = selectView WalletEmulator
 
 handleQuery ::
@@ -248,10 +250,9 @@ handleAction s (HandleBlocklyMessage (CurrentCode code)) = do
 
 handleAction _ (HandleActusBlocklyMessage ActusBlockly.Initialized) = pure unit
 
-handleAction settings (HandleActusBlocklyMessage (ActusBlockly.CurrentTerms flavour terms)) = do
-  mHasStarted <- query _simulationSlot unit (ST.HasStarted identity)
+handleAction s (HandleActusBlocklyMessage (ActusBlockly.CurrentTerms flavour terms)) = do
+  hasStarted <- use (_simulationState <<< _marloweState <<< to (\states -> (NEL.length states) > 1))
   let
-    hasStarted = fromMaybe false mHasStarted
     parsedTermsEither = AMB.parseActusJsonCode terms
   if hasStarted then
     void $ query _actusBlocklySlot unit (ActusBlockly.SetError "You can't send new code to a running simulation. Please go to the Simulation tab and click \"reset\" first" unit)
@@ -261,26 +262,30 @@ handleAction settings (HandleActusBlocklyMessage (ActusBlockly.CurrentTerms flav
         void $ query _actusBlocklySlot unit (ActusBlockly.SetError ("Couldn't parse contract-terms - " <> (show e)) unit)
       Right parsedTerms -> do
         result <- case flavour of 
-          ActusBlockly.FS -> runAjax $ flip runReaderT settings $ (Server.postActusGenerate parsedTerms)
-          ActusBlockly.F -> runAjax $ flip runReaderT settings $ (Server.postActusGeneratestatic parsedTerms)
+          ActusBlockly.FS -> runAjax $ flip runReaderT s $ (Server.postActusGenerate parsedTerms)
+          ActusBlockly.F -> runAjax $ flip runReaderT s $ (Server.postActusGeneratestatic parsedTerms)
         case result of
           Success contractAST -> do
-            void $ query _simulationSlot unit (ST.SetEditorText contractAST unit)
-            selectSimulationView
+            void $ toSimulation $ Simulation.handleAction s (ST.SetEditorText contractAST)
+            selectView Simulation
           Failure e        -> void $ query _actusBlocklySlot unit (ActusBlockly.SetError ("Server error! " <> (showErrorDescription (runAjaxError e).description)) unit)
           _                -> void $ query _actusBlocklySlot unit (ActusBlockly.SetError "Unknown server error!" unit)
 
 
 ----------
+
 showErrorDescription :: ErrorDescription -> String
 showErrorDescription (DecodingError err@"(\"Unexpected token E in JSON at position 0\" : Nil)") =
   "BadResponse"
 showErrorDescription (DecodingError err) = "DecodingError: " <> err
 showErrorDescription (ResponseFormatError err) = "ResponseFormatError: " <> err
 showErrorDescription (ConnectionError err) = "ConnectionError: " <> err
 
-
-
+runAjax ::
+  forall m a.
+  ExceptT AjaxError (HalogenM FrontendState HAction ChildSlots Message m) a ->
+  HalogenM FrontendState HAction ChildSlots Message m (WebData a)
+runAjax action = RemoteData.fromEither <$> runExceptT action
 
 ------------------------------------------------------------
 selectView ::
@@ -294,6 +299,7 @@ selectView view = do
       HaskellEditor -> Router.HaskellEditor
       BlocklyEditor -> Router.Blockly
       WalletEmulator -> Router.Wallets
+      ActusBlocklyEditor -> Router.ActusBlocklyEditor
   liftEffect $ Routing.setHash (RT.print Router.route route)
   assign _view view
   case view of
@@ -305,6 +311,7 @@ selectView view = do
       void $ query _haskellEditorSlot unit (Monaco.SetTheme HM.daylightTheme.name unit)
     BlocklyEditor -> void $ query _blocklySlot unit (Blockly.Resize unit)
     WalletEmulator -> pure unit
+    ActusBlocklyEditor -> void $ query _actusBlocklySlot unit (ActusBlockly.Resize unit)
 
 render ::
   forall m.

marlowe-playground-client/src/Router.purs

@@ -10,6 +10,7 @@ data Route
   = Home
   | Simulation
   | HaskellEditor
+  | ActusBlocklyEditor
   | Blockly
   | Wallets
 
@@ -25,5 +26,6 @@ route =
         , "Simulation": "simulation" / noArgs
         , "HaskellEditor": "haskell" / noArgs
         , "Blockly": "blockly" / noArgs
+        , "ActusBlocklyEditor": "actus" / noArgs
         , "Wallets": "wallets" / noArgs
         }