Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Marlowe Playground Frontend: Separate simulator from marlowe editor #2560

Merged
merged 28 commits into from
Jan 5, 2021
Merged

Marlowe Playground Frontend: Separate simulator from marlowe editor #2560

Changes from 1 commit
Commits
Show all changes
28 commits
Select commit Hold shift + click to select a range
c292b3a
Created a new view for MarloweEditor
hrajchert Dec 11, 2020
aa11123
Fixed keybinding selector for marlowe editor
hrajchert Dec 15, 2020
9aa0b45
Moved linter, holes and initial marker logic from simulation to marlo…
hrajchert Dec 15, 2020
5ab6c74
Fix double provider information
hrajchert Dec 17, 2020
0b8709a
Renamed Simulation modules
hrajchert Dec 18, 2020
01d7715
Separated simulation bottom panel and actions
hrajchert Dec 21, 2020
0df178e
Fix bottom panel in marlowe editor
hrajchert Dec 22, 2020
b965b65
Fix rebasing problems
hrajchert Dec 22, 2020
f040f8b
Fix simulation language color
hrajchert Dec 24, 2020
7525b68
Make the simulation editor readonly
hrajchert Dec 24, 2020
e4ccd72
Renamed _marloweEditorSlot to _simulatorEditorSlot
hrajchert Dec 24, 2020
22172d9
Remove unused imports
hrajchert Dec 24, 2020
d654ac2
Reimplement workflow buttons
hrajchert Dec 28, 2020
641554f
Move select hole to MarloweEditor
hrajchert Dec 28, 2020
371a512
Fix simulation state on refresh
hrajchert Dec 28, 2020
e83d0a7
Remove unused code from simulation bottom panel
hrajchert Dec 28, 2020
d3c1f67
Remove unused code from Marlowe editor bottom panel
hrajchert Dec 28, 2020
dc7f9ca
redesign simulation right pane
hrajchert Dec 29, 2020
b03037d
Remove obsolete FIXMEs
hrajchert Dec 30, 2020
4d75cb5
Applied PR suggestions
hrajchert Dec 30, 2020
a342fae
Fix rebasing problems
hrajchert Dec 30, 2020
4ebcd1e
Fix file actions not being shown in Marlowe editor
hrajchert Dec 30, 2020
69c951f
Added comment on linter
hrajchert Dec 30, 2020
68a36aa
Remove isValidContract from the simulation as it should always be valid
hrajchert Dec 30, 2020
5acb88e
resolved small fixme
hrajchert Dec 30, 2020
3fafe7b
Applied purty
hrajchert Dec 30, 2020
d3751e7
Fix undo button problem
hrajchert Dec 30, 2020
ab1b119
Improved how we show a slot range
hrajchert Dec 30, 2020
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
Prev Previous commit
Next Next commit
Remove unused code from simulation bottom panel
  • Loading branch information
@hrajchert @shmish111
hrajchert authored and shmish111 committed Jan 5, 2021
commit e83d0a7cd2f7ce8d2a8137fe7a5e08e223124451
275 changes: 9 additions & 266 deletions marlowe-playground-client/src/SimulationPage/BottomPanel.purs
View file
Open in desktop
Original file line number Diff line number Diff line change
@@ -1,4 +1,4 @@
module SimulationPage.BottomPanel where
module SimulationPage.BottomPanel (bottomPanel) where

import Control.Alternative (map)
import Data.Array (concatMap, reverse)
Expand All @@ -8,24 +8,22 @@ import Data.Either (Either(..), either)
import Data.Eq (eq, (==))
import Data.Foldable (foldMap)
import Data.HeytingAlgebra (not, (||))
import Data.Lens (_Just, has, only, previewOn, to, (^.))
import Data.Lens (has, only, previewOn, to, (^.))
import Data.Lens.NonEmptyList (_Head)
import Data.List (List, toUnfoldable)
import Data.List as List
import Data.Map as Map
import Data.Maybe (Maybe(..), isJust, isNothing)
import Data.Maybe (Maybe(..), isJust)
import Data.Newtype (unwrap)
import Data.Tuple (Tuple(..))
import Data.Tuple.Nested ((/\))
import Halogen.Classes (aHorizontal, accentBorderBottom, active, activeClass, closeDrawerArrowIcon, collapsed, first, flex, flexLeft, flexTen, footerPanelBg, minimizeIcon, rTable, rTable4cols, rTableCell, rTableDataRow, rTableEmptyRow)
import Halogen.Classes as Classes
import Halogen.HTML (ClassName(..), HTML, a, a_, b_, div, h2, img, li, li_, ol, section, span_, strong_, text, ul)
import Halogen.HTML (ClassName(..), HTML, a, a_, div, img, li, section, span_, strong_, text, ul)
import Halogen.HTML.Events (onClick)
import Halogen.HTML.Properties (alt, class_, classes, src)
import Marlowe.Semantics (Assets(..), ChoiceId(..), Input(..), Party, Payment(..), Slot(..), SlotInterval(..), Token(..), TransactionInput(..), TransactionWarning(..), ValueId(..), _accounts, _boundValues, _choices, timeouts)
import Prelude (bind, const, mempty, pure, show, zero, ($), (<<<), (<>))
import Pretty (renderPrettyParty, renderPrettyPayee, renderPrettyToken, showPrettyMoney)
import SimulationPage.Types (Action(..), BottomPanelView(..), MarloweEvent(..), State, _SimulationNotStarted, _SimulationRunning, _bottomPanelView, _contract, _editorErrors, _editorWarnings, _executionState, _initialSlot, _log, _marloweState, _showBottomPanel, _slot, _state, _transactionError, _transactionWarnings)
import Marlowe.Semantics (Assets(..), ChoiceId(..), Input(..), Party, Payment(..), SlotInterval(..), Token(..), TransactionInput(..), ValueId(..), _accounts, _boundValues, _choices, timeouts)
import Prelude (const, mempty, show, zero, ($), (<<<), (<>))
import Pretty (renderPrettyParty, renderPrettyToken, showPrettyMoney)
import SimulationPage.Types (Action(..), BottomPanelView(..), MarloweEvent(..), State, _SimulationNotStarted, _SimulationRunning, _bottomPanelView, _contract, _executionState, _initialSlot, _log, _marloweState, _showBottomPanel, _slot, _state, _transactionError, _transactionWarnings)

bottomPanel :: forall p. State -> HTML p Action
bottomPanel state =
Expand Down Expand Up @@ -71,12 +69,6 @@ bottomPanel state =
where
isActive view = state ^. _bottomPanelView <<< (activeClass (eq view))

-- FIXME: probably remove
warnings = state ^. (_marloweState <<< _Head <<< _editorWarnings)

-- FIXME: probably remove
errors = state ^. (_marloweState <<< _Head <<< _editorErrors)

-- FIXME: check how to reach this
hasRuntimeWarnings = has (_marloweState <<< _Head <<< _executionState <<< _SimulationRunning <<< _transactionWarnings <<< to Array.null <<< only false) state

Expand All @@ -88,8 +80,7 @@ panelContents :: forall p. State -> BottomPanelView -> HTML p Action
panelContents state CurrentStateView =
div [ class_ Classes.panelContents ]
[ div [ classes [ rTable, rTable4cols, ClassName "panel-table" ] ]
( warningsRow <> errorRow
<> eitherRow "Current Slot" (slotText)
( eitherRow "Current Slot" (slotText)
<> dataRow "Expiration Slot" (state ^. (_marloweState <<< _Head <<< _contract <<< to contractMaxTime))
<> tableRow
{ title: "Accounts"
Expand Down Expand Up @@ -120,35 +111,12 @@ panelContents state CurrentStateView =
in
if t == zero then "Closed" else show t

warnings = state ^. (_marloweState <<< _Head <<< _executionState <<< _SimulationRunning <<< _transactionWarnings)

warningsRow =
if Array.null warnings then
[]
else
(headerRow "Warnings" ("type" /\ "details" /\ mempty)) <> foldMap displayWarning' warnings

error = previewOn state (_marloweState <<< _Head <<< _executionState <<< _SimulationRunning <<< _transactionError <<< _Just)

errorRow =
if isNothing error then
[]
else
(headerRow "Errors" ("details" /\ mempty /\ mempty)) <> displayError error

slotText = case previewOn state (_marloweState <<< _Head <<< _executionState <<< _SimulationNotStarted <<< _initialSlot) of
Just initialSlot -> Right $ show initialSlot
Nothing -> case previewOn state (_marloweState <<< _Head <<< _executionState <<< _SimulationRunning <<< _slot) of
Just slot -> Right $ show slot
Nothing -> Left "Slot number not defined"

displayError Nothing = []

displayError (Just err) =
[ div [ classes [ rTableCell, first ] ] []
, div [ classes [ rTableCell, ClassName "Rtable-single-column-row" ] ] [ text $ show err ]
]

accountsData =
let
(accounts :: Array (Tuple (Tuple Party Token) BigInteger)) = state ^. (_marloweState <<< _Head <<< _executionState <<< _SimulationRunning <<< _state <<< _accounts <<< to Map.toUnfoldable)
Expand Down Expand Up @@ -199,81 +167,6 @@ panelContents state CurrentStateView =

eitherRow title = either (emptyRow title) (dataRow title)

displayWarning' (TransactionNonPositiveDeposit party owner tok amount) =
[ div [ classes [ rTableCell, first ] ] []
, div [ class_ (ClassName "RTable-2-cells") ] [ text "TransactionNonPositiveDeposit" ]
, div [ class_ (ClassName "RTable-4-cells") ]
[ text $ "Party "
, renderPrettyParty party
, text $ " is asked to deposit "
<> showPrettyMoney amount
<> " units of "
, renderPrettyToken tok
, text " into account of "
, renderPrettyParty owner
, text "."
]
]

displayWarning' (TransactionNonPositivePay owner payee tok amount) =
[ div [ classes [ rTableCell, first ] ] []
, div [ class_ (ClassName "RTable-2-cells") ] [ text "TransactionNonPositivePay" ]
, div [ class_ (ClassName "RTable-4-cells") ]
( [ text $ "The contract is supposed to make a payment of "
<> showPrettyMoney amount
<> " units of "
, renderPrettyToken tok
, text $ " from account of "
<> show owner
<> " to "
]
<> renderPrettyPayee payee
<> [ text "." ]
)
]

displayWarning' (TransactionPartialPay owner payee tok amount expected) =
[ div [ classes [ rTableCell, first ] ] []
, div [ class_ (ClassName "RTable-2-cells") ] [ text "TransactionPartialPay" ]
, div [ class_ (ClassName "RTable-4-cells") ]
( [ text $ "The contract is supposed to make a payment of "
<> showPrettyMoney expected
<> " units of "
, renderPrettyToken tok
, text " from account of "
, renderPrettyParty owner
, text $ " to "
]
<> renderPrettyPayee payee
<> [ text $ "."
<> " but there is only "
<> showPrettyMoney amount
<> "."
]
)
]

displayWarning' (TransactionShadowing valId oldVal newVal) =
[ div [ classes [ rTableCell, first ] ] []
, div [ class_ (ClassName "RTable-2-cells") ] [ text "TransactionShadowing" ]
, div [ class_ (ClassName "RTable-4-cells") ]
[ text $ "The contract defined the value with id "
<> show valId
<> " before, it was assigned the value "
<> show oldVal
<> " and now it is being assigned the value "
<> show newVal
<> "."
]
]

displayWarning' TransactionAssertionFailed =
[ div [ classes [ rTableCell, first ] ] []
, div [ class_ (ClassName "RTable-2-cells") ] [ text "TransactionAssertionFailed" ]
, div [ class_ (ClassName "RTable-4-cells") ]
[ text $ "An assertion in the contract did not hold." ]
]

panelContents state MarloweLogView =
section
[ classes [ ClassName "panel-sub-header", aHorizontal, Classes.panelContents, flexLeft ]
Expand All @@ -290,156 +183,6 @@ panelContents state MarloweLogView =
, ul [] (reverse inputLines)
]

displayTransactionList :: forall p. Array TransactionInput -> HTML p Action
displayTransactionList transactionList =
ol [ classes [ ClassName "indented-enum" ] ]
( do
( TransactionInput
{ interval: SlotInterval (Slot from) (Slot to)
, inputs: inputList
}
) <-
transactionList
pure
( li_
[ span_
[ b_ [ text "Transaction" ]
, text " with slot interval "
, b_ [ text $ (show from <> " to " <> show to) ]
, if List.null inputList then
text " and no inputs (empty transaction)."
else
text " and inputs:"
]
, if List.null inputList then
text ""
else
displayInputList inputList
]
)
)

displayInputList :: forall p. List Input -> HTML p Action
displayInputList inputList =
ol [ classes [ ClassName "indented-loweralpha-enum" ] ]
( do
input <- (toUnfoldable inputList)
pure (li_ (displayInput input))
)

displayInput :: forall p i. Input -> Array (HTML p i)
displayInput (IDeposit owner party tok money) =
[ b_ [ text "IDeposit" ]
, text " - Party "
, b_ [ renderPrettyParty party ]
, text " deposits "
, b_ [ text $ showPrettyMoney money ]
, text " units of "
, b_ [ renderPrettyToken tok ]
, text " into account of "
, b_ [ renderPrettyParty owner ]
, text "."
]

displayInput (IChoice (ChoiceId choiceId party) chosenNum) =
[ b_ [ text "IChoice" ]
, text " - Party "
, b_ [ renderPrettyParty party ]
, text " chooses number "
, b_ [ text $ showPrettyMoney chosenNum ]
, text " for choice "
, b_ [ text $ show choiceId ]
, text "."
]

displayInput (INotify) =
[ b_ [ text "INotify" ]
, text " - The contract is notified that an observation became "
, b_ [ text "True" ]
]

displayWarningList :: forall p. Array TransactionWarning -> HTML p Action
displayWarningList transactionWarnings =
ol [ classes [ ClassName "indented-enum" ] ]
( do
warning <- transactionWarnings
pure (li_ (displayWarning warning))
)

displayWarnings :: forall p. Array TransactionWarning -> HTML p Action
displayWarnings [] = text mempty

displayWarnings warnings =
div
[ classes
[ ClassName "invalid-transaction"
, ClassName "input-composer"
]
]
[ h2 [] [ text "Warnings" ]
, ol
[]
$ foldMap (\warning -> [ li_ (displayWarning warning) ]) warnings
]

displayWarning :: forall p. TransactionWarning -> Array (HTML p Action)
displayWarning (TransactionNonPositiveDeposit party owner tok amount) =
[ b_ [ text "Non-Positive Deposit" ]
, text " - Party "
, b_ [ renderPrettyParty party ]
, text " is asked to deposit "
, b_ [ text $ showPrettyMoney amount ]
, text " units of "
, b_ [ renderPrettyToken tok ]
, text " into account of "
, b_ [ renderPrettyParty owner ]
, text "."
]

displayWarning (TransactionNonPositivePay owner payee tok amount) =
[ b_ [ text "Non-Positive Pay" ]
, text " - The contract is supposed to make a payment of "
, b_ [ text $ showPrettyMoney amount ]
, text " units of "
, b_ [ renderPrettyToken tok ]
, text " from account of "
, b_ [ renderPrettyParty owner ]
, text " to "
, b_ $ renderPrettyPayee payee
, text "."
]

displayWarning (TransactionPartialPay owner payee tok amount expected) =
[ b_ [ text "Partial Pay" ]
, text " - The contract is supposed to make a payment of "
, b_ [ text $ showPrettyMoney expected ]
, text " units of "
, b_ [ renderPrettyToken tok ]
, text " from account of "
, b_ [ renderPrettyParty owner ]
, text " to "
, b_ $ renderPrettyPayee payee
, text " but there is only "
, b_ [ text $ showPrettyMoney amount ]
, text "."
]

displayWarning (TransactionShadowing valId oldVal newVal) =
[ b_ [ text "Value Shadowing" ]
, text " - The contract defined the value with id "
, b_ [ text (show valId) ]
, text " before, it was assigned the value "
, b_ [ text (show oldVal) ]
, text " and now it is being assigned the value "
, b_ [ text (show newVal) ]
, text "."
]

displayWarning TransactionAssertionFailed =
[ b_ [ text "Assertion Failed" ]
, text " - An assertion in the contract did not hold."
]

logToLines :: forall p a. MarloweEvent -> Array (HTML p a)
logToLines (InputEvent (TransactionInput { interval, inputs })) = Array.fromFoldable $ map (inputToLine interval) inputs

Expand Down