Skip to content
Permalink
Browse files

Add number inputs for choices and oracles

  • Loading branch information...
palas committed Mar 14, 2019
1 parent ddc5566 commit 698d46aa05a70e951335bf3181d8353688de8212
Showing with 63 additions and 13 deletions.
  1. +31 −6 meadow-client/src/MainFrame.purs
  2. +29 −7 meadow-client/src/Simulation.purs
  3. +3 −0 meadow-client/src/Types.purs
@@ -260,6 +260,12 @@ toEvent (AddAnyInput _ _) = Nothing

toEvent (RemoveAnyInput _ _) = Nothing

toEvent (SetChoice _ _) = Nothing

toEvent (SetOracleVal _ _) = Nothing

toEvent (SetOracleBn _ _) = Nothing

toEvent (CompileMarlowe _) = Just $ defaultEvent "CompileMarlowe"

saveBuffer ::
@@ -321,7 +327,7 @@ updateOracles cbn (State state) inputs omap =
Just {blockNumber: bn, value}, Just {blockNumber: lbn} ->
if (lbn >= cbn)
then a
else Map.insert idOracle {blockNumber: max lbn bn, value} a
else Map.insert idOracle {blockNumber: max (lbn + fromInt 1) bn, value} a
Just {blockNumber, value}, Nothing ->
Map.insert idOracle {blockNumber: min blockNumber cbn, value} a
Nothing, Just {blockNumber, value} ->
@@ -486,17 +492,36 @@ evalF (NextBlock next) = do
evalF (AddAnyInput {person, anyInput} next) = do
modifying (_marloweState <<< _transaction <<< _inputs) ((flip snoc) anyInput)
case person of
Just per -> modifying (_marloweState <<< _transaction <<< _signatures)
(Map.insert per true)
Nothing -> pure unit
modifying (_marloweState) updateState
pure next
Just per -> do modifying (_marloweState <<< _transaction <<< _signatures)
(Map.insert per true)
modifying (_marloweState) updateState
pure next
Nothing -> do modifying (_marloweState) updateState
pure next

evalF (RemoveAnyInput anyInput next) = do
modifying (_marloweState <<< _transaction <<< _inputs) (delete anyInput)
modifying (_marloweState) updateState
pure next

evalF (SetChoice {idChoice: (IdChoice {choice, person}), value} next) = do
modifying (_marloweState <<< _input <<< _choiceData)
(Map.update (Just <<< (Map.update (const $ Just value) choice)) person)
modifying (_marloweState) updateState
pure next

evalF (SetOracleVal {idOracle, value} next) = do
modifying (_marloweState <<< _input <<< _oracleData)
(Map.update (\x -> Just (x {value = value})) idOracle)
modifying (_marloweState) updateState
pure next

evalF (SetOracleBn {idOracle, blockNumber} next) = do
modifying (_marloweState <<< _input <<< _oracleData)
(Map.update (\x -> Just (x {blockNumber = blockNumber})) idOracle)
modifying (_marloweState) updateState
pure next

evalF (CompileMarlowe next) = do
mContents <- withMarloweEditor Editor.getValue
case mContents of
@@ -1,7 +1,8 @@
module Simulation where

import Data.BigInteger (BigInteger)
import Data.BigInteger (BigInteger, fromString, fromInt)
import Semantics
import Data.Show as Show
import Data.Map (Map)
import Data.List (List(..), concatMap)
import Data.Set (Set)
@@ -63,15 +64,18 @@ import Halogen.HTML
, thead_
, tr
)
import Halogen.HTML.Events (input_, onChecked, onClick, onDragOver, onDrop)
import Halogen.HTML.Events (input_, onChecked, onClick, onDragOver, onDrop, onValueChange)
import Halogen.HTML.Properties
( InputType
( InputCheckbox
, InputNumber
)
, checked
, class_
, classes
, placeholder
, type_
, value
)
import LocalStorage (LOCALSTORAGE)
import Prelude
@@ -108,6 +112,9 @@ import Types
( SetSignature
, AddAnyInput
, RemoveAnyInput
, SetChoice
, SetOracleVal
, SetOracleBn
, CompileMarlowe
, NextBlock
, ApplyTrasaction
@@ -296,7 +303,9 @@ inputChoice person idChoice val =
, spanText "Choice "
, b_ [ spanText (show idChoice) ]
, spanText ": Choose value "
, b_ [ spanText (show val) ]
, marloweActionInput (\x -> SetChoice { idChoice: (IdChoice {choice: idChoice
, person})
, value: x}) val
]

inputComposerOracle :: forall p. Tuple IdOracle OracleEntry -> HTML p Query
@@ -309,11 +318,24 @@ inputComposerOracle (Tuple idOracle {blockNumber, value}) =
, spanText "Oracle "
, b_ [ spanText (show idOracle) ]
, spanText ": Provide "
, b_ [ spanText (show value) ]
, marloweActionInput (\x -> SetOracleVal { idOracle
, value: x}) value
, spanText " as the value for block "
, b_ [ spanText (show blockNumber) ]
, marloweActionInput (\x -> SetOracleBn { idOracle
, blockNumber: x}) blockNumber
]

marloweActionInput f current =
input [ type_ InputNumber
, placeholder "BigInteger"
, class_ $ ClassName "action-input"
, value $ show current
, onValueChange $ (\x -> Just $ HQ.action $ f (case fromString x of
Just y -> y
Nothing -> fromInt 0))
]


flexRow_ ::
forall p.
Array (HTML p Query) ->
@@ -428,9 +450,9 @@ inputRow idInput@(Input (IChoice (IdChoice {choice, person}) val)) =
]
]

inputRow (Input (IOracle idOracle bn val)) =
inputRow idInput@(Input (IOracle idOracle bn val)) =
row_ [ col_ [ button [ class_ $ ClassName "composer-add-button"
-- , onClick <<< input_ <<< UpdatePerson $ demoteAction person idx
, onClick $ input_ $ RemoveAnyInput idInput
] [ text "-"
]
, text "Oracle "
@@ -57,6 +57,9 @@ data Query a
| NextBlock a
| AddAnyInput {person :: Maybe Person, anyInput :: AnyInput} a
| RemoveAnyInput AnyInput a
| SetChoice {idChoice :: IdChoice, value :: Choice} a
| SetOracleVal {idOracle :: IdOracle, value :: BigInteger} a
| SetOracleBn {idOracle :: IdOracle, blockNumber :: BlockNumber} a
| CompileMarlowe a

------------------------------------------------------------

0 comments on commit 698d46a

Please sign in to comment.
You can’t perform that action at this time.