Skip to content
Permalink
Browse files

Implement provisional printing of input options

  • Loading branch information...
palas committed Mar 14, 2019
1 parent 8616405 commit 23bae576eef7f36353909d5dca4728e9f1ff9055
Showing with 112 additions and 10 deletions.
  1. +8 −0 meadow-client/src/MainFrame.purs
  2. +5 −5 meadow-client/src/Semantics.purs
  3. +99 −5 meadow-client/src/Simulation.purs
@@ -99,6 +99,7 @@ import Semantics
, IdChoice(..)
, IdInput(..)
, IdOracle
, ErrorResult(..)
, MApplicationResult(..)
, Person
, State(..)
@@ -107,6 +108,7 @@ import Semantics
, emptyState
, peopleFromStateAndContract
, readContract
, reduce
, scoutPrimitives
)
import Servant.PureScript.Settings (SPSettings_)
@@ -334,6 +336,10 @@ simulateState state =
case applyTransaction inps sigs bn st c mic of
MSuccessfullyApplied {state: newState, contract: newContract} _ ->
{state: newState, contract: newContract}
MCouldNotApply InvalidInput ->
if inps == Nil
then {state: st, contract: reduce state.blockNum state.state c}
else {state: emptyState, contract: Null}
MCouldNotApply _ -> {state: emptyState, contract: Null}
where
inps = Array.toUnfoldable (state.transaction.inputs)
@@ -466,6 +472,8 @@ evalF (ApplyTrasaction next) = pure next
evalF (NextBlock next) = do
modifying (_marloweState <<< _blockNum) (\x ->
x + ((fromInt 1) :: BigInteger))
currentState <- use _marloweState
assign (_marloweState) $ updateState currentState
pure next

evalF (CompileMarlowe next) = do
@@ -1001,7 +1001,7 @@ reduceRec blockNum state env (Choice obs cont1 cont2) = reduceRec blockNum state
then cont1
else cont2)

reduceRec blockNum state env c@(When obs timeout cont1 cont2) = if isExpired timeout blockNum
reduceRec blockNum state env c@(When obs timeout cont1 cont2) = if isExpired blockNum timeout
then go cont2
else if evalObservation blockNum state obs
then go cont1
@@ -1218,8 +1218,8 @@ fetchPrimitive idAction blockNum state (Commit idActionC idCommit person value _
}
else NoMatch
where
notCurrentCommit = isCurrentCommit idCommit state
notExpiredCommit = isExpiredCommit idCommit state
notCurrentCommit = not (isCurrentCommit idCommit state)
notExpiredCommit = not (isExpiredCommit idCommit state)
actualValue = evalValue blockNum state value

fetchPrimitive idAction blockNum state (Pay idActionC idCommit person value _ continuation _) = if (idAction == idActionC)
@@ -1276,8 +1276,8 @@ scoutPrimitivesAux blockNum state (Commit idActionC idCommit person value _ time
then M.insert idActionC (Just (DCommit idCommit person actualValue timeout)) M.empty
else M.empty
where
notCurrentCommit = isCurrentCommit idCommit state
notExpiredCommit = isExpiredCommit idCommit state
notCurrentCommit = not (isCurrentCommit idCommit state)
notExpiredCommit = not (isExpiredCommit idCommit state)
actualValue = evalValue blockNum state value

scoutPrimitivesAux blockNum state (Pay idActionC idCommit person value _ continuation _) =
@@ -3,7 +3,7 @@ module Simulation where
import Data.BigInteger (BigInteger)
import Semantics
import Data.Map (Map)
import Data.List (List)
import Data.List (List(..), concatMap)
import Data.Set (Set)
import Data.Set as Set
import API (RunResult(RunResult))
@@ -28,7 +28,7 @@ import Control.Monad.Eff (Eff)
import Control.Monad.Eff.Class (liftEff)
import Data.Either (Either(..))
import Data.Eq ((==))
import Data.Maybe (Maybe(Just), fromMaybe)
import Data.Maybe (Maybe(..), fromMaybe)
import Data.Tuple (Tuple(..))
import Halogen (HTML, action)
import Halogen.Component (ParentHTML)
@@ -92,12 +92,14 @@ import Types
( ChildQuery
, ChildSlot
, FrontendState
, InputData
, MarloweEditorSlot
( MarloweEditorSlot
)
, MarloweError
( MarloweError
)
, OracleEntry
, Query
( SetSignature
, CompileMarlowe
@@ -204,13 +206,105 @@ inputComposerPane state = div [ classes [ col6
]
] [ paneHeader "Input Composer"
, div [ class_ $ ClassName "wallet"
] [ card_ [ cardBody_ [ h3_ [ text ("Person " <> "3")
]
]
] [ card_ [ cardBody_ (inputComposer (state.marloweState.input))
]
]
]

inputComposer :: forall p. InputData -> Array (HTML p Query)
inputComposer { inputs, choiceData, oracleData } =
Array.concat [ Array.concat (Array.fromFoldable (map (\x -> inputComposerPerson x inputs choiceData) people))
, if (Map.isEmpty oracleData)
then []
else [ h3_ [ text ("Oracles") ] ]
, Array.fromFoldable (map inputComposerOracle oracles)
]
where
ik = Set.fromFoldable (Map.keys inputs)
cdk = Set.fromFoldable (Map.keys choiceData)
people = Set.toUnfoldable (Set.union ik cdk) :: List Person
oracles = Map.toUnfoldable oracleData :: List (Tuple IdOracle OracleEntry)

inputComposerPerson :: forall p. Person -> Map Person (List DetachedPrimitiveWIA)
-> Map Person (Map BigInteger Choice)
-> Array (HTML p Query)
inputComposerPerson person inputs choices =
Array.concat
[ [ h3_ [ text ("Person " <> show person)
] ]
, case Map.lookup person inputs of
Nothing -> []
Just x -> Array.fromFoldable
do y <- x
case y of
DWAICommit idAction idCommit val tim ->
pure (inputCommit person idAction idCommit val tim)
DWAIPay idAction idCommit val ->
pure (inputPay person idAction idCommit val)
, case Map.lookup person choices of
Nothing -> []
Just x -> do (Tuple idChoice choice) <- Map.toUnfoldable x
pure (inputChoice person idChoice choice)
]

inputCommit :: forall p. Person -> IdAction -> IdCommit -> BigInteger -> Timeout
-> HTML p Query
inputCommit person idAction idCommit val tim =
flexRow_ [ button [ class_ $ ClassName "composer-add-button"
-- , onClick <<< input_ <<< UpdatePerson $ promoteAction person idx
] [ text "+"
]
, spanText "Action "
, spanText (show idAction)
, spanText ": Commit "
, spanText (show val)
, spanText " ADA with id "
, spanText (show idCommit)
, spanText " to expire by "
, spanText (show tim)
]

inputPay :: forall p. Person -> IdAction -> IdCommit -> BigInteger -> HTML p Query
inputPay person idAction idCommit val =
flexRow_ [ button [ class_ $ ClassName "composer-add-button"
-- , onClick <<< input_ <<< UpdatePerson $ promoteAction person idx
] [ text "+"
]
, spanText "Action "
, spanText (show idAction)
, spanText ": Claim "
, spanText (show val)
, spanText " ADA from commit "
, spanText (show idCommit)
]

inputChoice :: forall p. Person -> BigInteger -> BigInteger -> HTML p Query
inputChoice person idChoice val =
flexRow_ [ button [ class_ $ ClassName "composer-add-button"
-- , onClick <<< input_ <<< UpdatePerson $ promoteAction person idx
] [ text "+"
]
, spanText "Choice "
, spanText (show idChoice)
, spanText ": Choose value "
, spanText (show val)
]

inputComposerOracle :: forall p. Tuple IdOracle OracleEntry -> HTML p Query
inputComposerOracle (Tuple idOracle {blockNumber, value}) =
flexRow_ [ button [ class_ $ ClassName "composer-add-button"
-- , onClick <<< input_ <<< UpdatePerson $ promoteAction person idx
] [ text "+"
]
, spanText "Oracle "
, spanText (show idOracle)
, spanText ": Provide "
, spanText (show value)
, spanText " as the value for block "
, spanText (show blockNumber)
]


--updateSuggestedAction ::
-- Person ->
-- Int ->

0 comments on commit 23bae57

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