Skip to content

Commit

Permalink
remove input composer
Browse files Browse the repository at this point in the history
  • Loading branch information
@shmish111
shmish111 committed Aug 11, 2020
1 parent 0acb82c commit 52d17cd
Show file tree
Hide file tree
Showing 4 changed files with 63 additions and 187 deletions.
232 changes: 54 additions & 178 deletions marlowe-playground-client/src/Simulation.purs
View file
Expand Up @@ -36,9 +36,9 @@ import Gists (GistAction(..), idPublishGist)
import Gists as Gists
import Halogen (HalogenM, query)
import Halogen as H
import Halogen.Classes (aHorizontal, active, activeClasses, blocklyIcon, bold, closeDrawerIcon, codeEditor, expanded, infoIcon, jFlexStart, minusBtn, noMargins, panelSubHeader, panelSubHeaderMain, panelSubHeaderSide, plusBtn, pointer, sidebarComposer, smallBtn, spaceLeft, spanText, textSecondaryColor, uppercase)
import Halogen.Classes (aHorizontal, active, activeClasses, blocklyIcon, bold, closeDrawerIcon, codeEditor, expanded, infoIcon, jFlexStart, noMargins, panelSubHeader, panelSubHeaderMain, panelSubHeaderSide, plusBtn, pointer, sidebarComposer, smallBtn, spaceLeft, spanText, textSecondaryColor, uppercase)
import Halogen.Classes as Classes
import Halogen.HTML (ClassName(..), ComponentHTML, HTML, a, article, aside, b_, br_, button, div, em_, h2, h6, h6_, img, input, label, li, li_, option, p, p_, section, select, slot, small, span, strong_, text, ul, ul_)
import Halogen.HTML (ClassName(..), ComponentHTML, HTML, a, article, aside, b_, br_, button, div, em_, h6, h6_, img, input, label, li, option, p, p_, section, select, slot, small, span, strong_, text, ul)
import Halogen.HTML.Events (onClick, onSelectedIndexChange, onValueChange, onValueInput)
import Halogen.HTML.Properties (InputType(..), alt, class_, classes, disabled, enabled, href, placeholder, src, type_, value)
import Halogen.HTML.Properties as HTML
Expand All @@ -57,7 +57,7 @@ import Marlowe.Linter as Linter
import Marlowe.Monaco (updateAdditionalContext)
import Marlowe.Monaco as MM
import Marlowe.Parser (parseContract)
import Marlowe.Semantics (AccountId(..), Bound(..), ChoiceId(..), Input(..), Party(..), PubKey, Token, TransactionError, inBounds, showPrettyToken)
import Marlowe.Semantics (AccountId(..), Bound(..), ChoiceId(..), Input(..), Party(..), PubKey, Token, inBounds, showPrettyToken)
import Monaco (IMarker, isError, isWarning)
import Monaco (getModel, getMonaco, setTheme, setValue) as Monaco
import Network.RemoteData (RemoteData(..), _Success)
Expand All @@ -67,7 +67,7 @@ import Reachability (startReachabilityAnalysis, updateWithResponse)
import Servant.PureScript.Ajax (AjaxError, errorToString)
import Servant.PureScript.Settings (SPSettings_)
import Simulation.BottomPanel (bottomPanel)
import Simulation.State (ActionInput(..), ActionInputId, _editorErrors, _editorWarnings, _pendingInputs, _possibleActions, _slot, _state, applyTransactions, emptyMarloweState, hasHistory, updateContractInState, updateMarloweState)
import Simulation.State (ActionInput(..), ActionInputId, _editorErrors, _editorWarnings, _pendingInputs, _possibleActions, _slot, _state, applyInput, emptyMarloweState, hasHistory, updateContractInState, updateMarloweState)
import Simulation.Types (Action(..), AnalysisState(..), Query(..), State, WebData, _activeDemo, _analysisState, _authStatus, _bottomPanelView, _createGistResult, _currentContract, _currentMarloweState, _editorKeybindings, _gistUrl, _helpContext, _loadGistResult, _marloweState, _oldContract, _selectedHole, _showBottomPanel, _showErrorDetail, _showRightPanel, isContractValid)
import StaticData (marloweBufferLocalStorageKey)
import StaticData as StaticData
Expand Down Expand Up @@ -152,25 +152,18 @@ handleAction _ (SetEditorText contents) = do
editorSetValue contents
updateContractInState contents

handleAction _ ApplyTransaction = do
saveInitialState
applyTransactions
mCurrContract <- use _currentContract
case mCurrContract of
Just currContract -> editorSetValue (show $ genericPretty currContract)
Nothing -> pure unit

handleAction _ NextSlot = do
saveInitialState
updateMarloweState (over _slot (add one))

handleAction _ (AddInput person input bounds) = do
when validInput do
updateMarloweState (over _pendingInputs ((flip snoc) (Tuple input person)))
currContract <- editorGetValue
case currContract of
saveInitialState
applyInput ((flip snoc) (Tuple input person))
mCurrContract <- use _currentContract
case mCurrContract of
Just currContract -> editorSetValue (show $ genericPretty currContract)
Nothing -> pure unit
Just contract -> updateContractInState contract
where
validInput = case input of
(IChoice _ chosenNum) -> inBounds chosenNum bounds
Expand Down Expand Up @@ -491,13 +484,7 @@ sidebar state =
showRightPanel = state ^. _showRightPanel
in
aside [ classes [ sidebarComposer, expanded showRightPanel ] ]
[ div [ class_ aHorizontal ]
[ h6 [ classes [ ClassName "input-composer-heading", noMargins ] ]
[ small [ classes [ textSecondaryColor, bold, uppercase ] ] [ text "Input Composer" ] ]
, a [ onClick $ const $ Just $ ChangeHelpContext InputComposerHelp ] [ img [ src infoIcon, alt "info book icon" ] ]
]
, inputComposer state
, div [ classes [ aHorizontal, ClassName "transaction-composer" ] ]
[ div [ classes [ aHorizontal, ClassName "transaction-composer" ] ]
[ h6 [ classes [ ClassName "input-composer-heading", noMargins ] ]
[ small [ classes [ textSecondaryColor, bold, uppercase ] ] [ text "Transaction Composer" ] ]
, a [ onClick $ const $ Just $ ChangeHelpContext TransactionComposerHelp ] [ img [ src infoIcon, alt "info book icon" ] ]
Expand All @@ -507,21 +494,62 @@ sidebar state =
(toHTML (state ^. _helpContext))
]

inputComposer ::
transactionComposer ::
forall p.
State ->
HTML p Action
inputComposer state =
div [ classes [ ClassName "input-composer", ClassName "composer" ] ]
transactionComposer state =
div [ classes [ ClassName "transaction-composer", ClassName "composer" ] ]
[ ul [ class_ (ClassName "participants") ]
if (Map.isEmpty possibleActions) then
[ text "No valid inputs can be added to the transaction" ]
else
(actionsForParties possibleActions)
, div [ class_ (ClassName "transaction-btns") ]
[ ul [ classes [ ClassName "demo-list", aHorizontal ] ]
[ li [ classes [ bold, pointer ] ]
[ a
[ onClick
$ if hasHistory state then
Just <<< const Undo
else
const Nothing
, class_ (Classes.disabled $ not isEnabled)
]
[ text "Undo" ]
]
, li [ classes [ bold, pointer ] ]
[ a
[ onClick
$ if hasHistory state then
Just <<< const ResetSimulator
else
const Nothing
, class_ (Classes.disabled $ not isEnabled)
]
[ text "Reset" ]
]
, li [ classes [ bold, pointer ] ]
[ a
[ onClick
$ if isEnabled then
Just <<< const NextSlot
else
const Nothing
, class_ (Classes.disabled $ not isEnabled)
]
[ text $ "Next Slot (" <> show currentBlock <> ")" ]
]
]
]
]
where
currentBlock = state ^. (_marloweState <<< _Head <<< _slot)

isEnabled = isContractValid state

pendingInputs = state ^. (_marloweState <<< _Head <<< _pendingInputs)

possibleActions = view (_marloweState <<< _Head <<< _possibleActions) state

kvs :: forall k v. Map k v -> Array (Tuple k v)
Expand Down Expand Up @@ -662,158 +690,6 @@ renderDeposit (AccountId accountNumber accountOwner) party tok money =
, b_ [ spanText (show party) ]
]

transactionComposer ::
forall p.
State ->
HTML p Action
transactionComposer state =
div [ classes [ ClassName "transaction-composer", ClassName "composer" ] ]
[ ul [ class_ (ClassName "participants") ]
if Array.null pendingInputs then
[ text "Empty transaction" ]
else
[ transaction state isEnabled ]
, div [ class_ (ClassName "transaction-btns") ]
[ ul [ classes [ ClassName "demo-list", aHorizontal ] ]
[ li [ classes [ bold, pointer ] ]
[ a
[ onClick
$ if hasHistory state then
Just <<< const Undo
else
const Nothing
, class_ (Classes.disabled $ not isEnabled)
]
[ text "Undo" ]
]
, li [ classes [ bold, pointer ] ]
[ a
[ onClick
$ if hasHistory state then
Just <<< const ResetSimulator
else
const Nothing
, class_ (Classes.disabled $ not isEnabled)
]
[ text "Reset" ]
]
, li [ classes [ bold, pointer ] ]
[ a
[ onClick
$ if isEnabled then
Just <<< const NextSlot
else
const Nothing
, class_ (Classes.disabled $ not isEnabled)
]
[ text $ "Next Slot (" <> show currentBlock <> ")" ]
]
, li_
[ button
[ onClick $ Just <<< const ApplyTransaction
, enabled isEnabled
, class_ (Classes.disabled $ not isEnabled)
]
[ text "Apply" ]
]
]
]
]
where
currentBlock = state ^. (_marloweState <<< _Head <<< _slot)

isEnabled = isContractValid state

pendingInputs = state ^. (_marloweState <<< _Head <<< _pendingInputs)

transaction ::
forall p.
State ->
Boolean ->
HTML p Action
transaction state isEnabled =
li [ classes [ ClassName "participant-a", noMargins ] ]
[ ul
[]
(map (transactionRow state isEnabled) (state ^. (_marloweState <<< _Head <<< _pendingInputs)))
]

transactionRow ::
forall p.
State ->
Boolean ->
Tuple Input (Maybe PubKey) ->
HTML p Action
transactionRow state isEnabled (Tuple input@(IDeposit (AccountId accountNumber accountOwner) party token money) person) =
li [ classes [ ClassName "choice-a", aHorizontal ] ]
[ p_
[ text "Deposit "
, strong_ [ text (show money) ]
, text " units of "
, strong_ [ text (showPrettyToken token) ]
, text " into account "
, strong_ [ text (show accountOwner <> " (" <> show accountNumber <> ")") ]
, text " as "
, strong_ [ text (show party) ]
]
, button
[ classes [ minusBtn, smallBtn, bold, (Classes.disabled $ not isEnabled) ]
, enabled isEnabled
, onClick $ const $ Just $ RemoveInput person input
]
[ text "-" ]
]

transactionRow state isEnabled (Tuple input@(IChoice (ChoiceId choiceName choiceOwner) chosenNum) person) =
li [ classes [ ClassName "choice-a", aHorizontal ] ]
[ p_
[ text "Participant "
, strong_ [ text (show choiceOwner) ]
, text " chooses the value "
, strong_ [ text (show chosenNum) ]
, text " for choice with id "
, strong_ [ text (show choiceName) ]
]
, button
[ classes [ minusBtn, smallBtn, bold, (Classes.disabled $ not isEnabled) ]
, enabled isEnabled
, onClick $ const $ Just $ RemoveInput person input
]
[ text "-" ]
]

transactionRow state isEnabled (Tuple INotify person) =
li [ classes [ ClassName "choice-a", aHorizontal ] ]
[ p_
[ text "Notification"
]
, button
[ classes [ minusBtn, smallBtn, bold, (Classes.disabled $ not isEnabled) ]
, enabled isEnabled
, onClick $ const $ Just $ RemoveInput person INotify
]
[ text "-" ]
]

-- TODO: Need to make these errors nice explanations - function in smeantics utils
printTransError :: forall p. TransactionError -> Array (HTML p Action)
printTransError error = [ ul_ [ li_ [ text (show error) ] ] ]

transactionErrors :: forall p. Maybe TransactionError -> Array (HTML p Action)
transactionErrors Nothing = []

transactionErrors (Just error) =
[ div
[ classes
[ ClassName "invalid-transaction"
, ClassName "transaction-composer"
]
]
( [ h2 [] [ text "The transaction is invalid:" ] ]
<> printTransError error
)
]

authButton :: forall p. State -> HTML p Action
authButton state =
let
Expand Down
9 changes: 8 additions & 1 deletion marlowe-playground-client/src/Simulation/State.purs
View file
Expand Up @@ -24,7 +24,7 @@ import Marlowe.Linter as L
import Marlowe.Parser (parseContract)
import Marlowe.Semantics (AccountId, Action(..), Assets, Bound, ChoiceId(..), ChosenNum, Contract(..), Environment(..), Input, Party, Payment, PubKey, Slot, SlotInterval(..), State, Token, TransactionError, TransactionInput(..), TransactionOutput(..), TransactionWarning, _minSlot, boundFrom, computeTransaction, emptyState, evalValue, extractRequiredActionsWithTxs, moneyInContract)
import Monaco (IMarker)
import Prelude (class Eq, class Ord, Unit, append, map, mempty, min, zero, ($), (<<<), (<))
import Prelude (class Eq, class Ord, Unit, append, map, mempty, min, zero, ($), (<), (<<<))

data ActionInputId
= DepositInputId AccountId Party Token BigInteger
Expand Down Expand Up @@ -262,5 +262,12 @@ updateContractInState contents = modifying _currentMarloweState (updatePossibleA
applyTransactions :: forall s m. MonadState { marloweState :: NonEmptyList MarloweState | s } m => m Unit
applyTransactions = modifying _marloweState (extendWith (updatePossibleActions <<< updateStateP))

applyInput ::
forall s m.
MonadState { marloweState :: NonEmptyList MarloweState | s } m =>
(Array (Tuple Input (Maybe String)) -> Array (Tuple Input (Maybe String))) ->
m Unit
applyInput inputs = modifying _marloweState (extendWith (updatePossibleActions <<< updateStateP <<< (over _pendingInputs inputs)))

hasHistory :: forall s. { marloweState :: NonEmptyList MarloweState | s } -> Boolean
hasHistory state = state ^. (_marloweState <<< to NEL.length <<< to ((<) 1))
2 changes: 0 additions & 2 deletions marlowe-playground-client/src/Simulation/Types.purs
View file
Expand Up @@ -180,7 +180,6 @@ data Action
| CheckAuthStatus
| GistAction GistAction
-- marlowe actions
| ApplyTransaction
| NextSlot
| AddInput (Maybe PubKey) Input (Array Bound)
| RemoveInput (Maybe PubKey) Input
Expand Down Expand Up @@ -214,7 +213,6 @@ instance isEventAction :: IsEvent Action where
toEvent CheckAuthStatus = Just $ defaultEvent "CheckAuthStatus"
toEvent (LoadScript script) = Just $ (defaultEvent "LoadScript") { label = Just script }
toEvent (SetEditorText _) = Just $ (defaultEvent "SetEditorText")
toEvent ApplyTransaction = Just $ defaultEvent "ApplyTransaction"
toEvent NextSlot = Just $ defaultEvent "NextBlock"
toEvent (AddInput _ _ _) = Just $ defaultEvent "AddInput"
toEvent (RemoveInput _ _) = Just $ defaultEvent "RemoveInput"
Expand Down
7 changes: 1 addition & 6 deletions marlowe-playground-client/static/css/panels.css
View file
Expand Up @@ -166,12 +166,7 @@
padding: 0 0.1rem;
}

.transaction-composer .participants {
display: flex;
flex-flow: wrap;
}

.input-composer ul li ul {
.transaction-composer ul li ul {
display: flex;
}

Expand Down

0 comments on commit 52d17cd

Please sign in to comment.