Skip to content
Permalink
Browse files

Merge pull request #687 from input-output-hk/playground-selenium

Playground: Adding some HTML `id` attributes to make writing Selenium scripts easier.
  • Loading branch information...
krisajenkins committed Mar 14, 2019
2 parents 15c87bf + f270509 commit 073ceb7c1682c6590e0ad923b557c412f5aa4a54
@@ -18,15 +18,15 @@ import Halogen.HTML (ClassName(ClassName), br_, button, code_, div, div_, form,
import Halogen.HTML.Elements.Keyed as Keyed
import Halogen.HTML.Events (input_, onClick, onValueInput)
import Halogen.HTML.Events as HE
import Halogen.HTML.Properties (InputType(InputText, InputNumber), class_, classes, disabled, for, placeholder, required, type_, value)
import Halogen.HTML.Properties (InputType(InputText, InputNumber), class_, classes, disabled, for, id_, placeholder, required, type_, value)
import Halogen.Query as HQ
import Icons (Icon(..), icon)
import Network.RemoteData (RemoteData(Loading, NotAsked, Failure, Success))
import Playground.API (EvaluationResult, SimulatorWallet, _EvaluationResult, _Fn, _FunctionSchema)
import Prelude (map, pure, show, ($), (+), (/=), (<$>), (<<<), (<>))
import Servant.PureScript.Affjax (AjaxError)
import Types (Action(..), ActionEvent(..), Blockchain, ChildQuery, ChildSlot, FormEvent(..), Query(..), SimpleArgument(..), Simulation, _argumentSchema, _functionName, _resultBlockchain, _simulatorWalletWallet)
import Validation (ValidationError, WithPath, addPath, validate)
import Validation (ValidationError, WithPath, joinPath, showPathValue, validate)
import Wallet (walletIdPane, walletsPane)

simulationPane ::
@@ -61,7 +61,7 @@ actionPane :: forall p. Int -> Action -> Tuple String (HTML p Query)
actionPane index action =
Tuple (show index) $
col4_
[ div [ class_ $ ClassName "action" ]
[ div [ classes [ ClassName "action", ClassName ("action-" <> show index) ] ]
[ div [ class_ card ]
[ cardBody_
[ div
@@ -90,6 +90,7 @@ actionPane index action =
, col_ [
input
[ type_ InputNumber
, classes [ formControl, ClassName $ "action-argument-0-blocks" ]
, value $ show blocks
, placeholder "Int"
, onValueInput $ map (HQ.action <<< ModifyActions <<< SetWaitTime index) <<< Int.fromString
@@ -110,49 +111,55 @@ validationClasses ::
validationClasses arg Nothing = [ ClassName "error" ]
validationClasses arg (Just _) = []

actionArgumentClass :: Array String -> Array ClassName
actionArgumentClass ancestors =
[ ClassName "action-argument"
, ClassName $ "action-argument-" <> Array.intercalate "-" ancestors
]

actionArgumentForm :: forall p. Int -> Array SimpleArgument -> HTML p Query
actionArgumentForm index arguments =
form [ class_ $ ClassName "was-validated" ]
(Array.mapWithIndex
(\i argument -> PopulateAction index i <$> actionArgumentField ("Field " <> show i) false argument)
(\i argument -> PopulateAction index i <$> actionArgumentField [ show i ] false argument)
arguments)

actionArgumentField ::
forall p. Warn "We're still not handling the Unknowable case."
=> String
=> Array String
-> Boolean
-> SimpleArgument
-> HTML p FormEvent
actionArgumentField context _ arg@(SimpleInt n) =
actionArgumentField ancestors _ arg@(SimpleInt n) =
div_ [
input
[ type_ InputNumber
, class_ formControl
, classes (Array.cons formControl (actionArgumentClass ancestors))
, value $ maybe "" show n
, required true
, placeholder "Int"
, onValueInput $ (Just <<< HQ.action <<< SetIntField <<< Int.fromString)
]
, validationFeedback (addPath context <$> validate arg)
, validationFeedback (joinPath ancestors <$> validate arg)
]
actionArgumentField context _ arg@(SimpleString s) =
actionArgumentField ancestors _ arg@(SimpleString s) =
div_ [
input
[ type_ InputText
, class_ formControl
, classes (Array.cons formControl (actionArgumentClass ancestors))
, value $ fromMaybe "" s
, required true
, placeholder "String"
, onValueInput $ HE.input SetStringField
]
, validationFeedback (addPath context <$> validate arg)
, validationFeedback (joinPath ancestors <$> validate arg)
]
actionArgumentField context nested (SimpleTuple (subFieldA /\subFieldB)) =
actionArgumentField ancestors nested (SimpleTuple (subFieldA /\subFieldB)) =
row_
[ col_ [ SetSubField 1 <$> actionArgumentField "_1" true subFieldA ]
, col_ [ SetSubField 2 <$> actionArgumentField "_2" true subFieldB ]
[ col_ [ SetSubField 1 <$> actionArgumentField (Array.snoc ancestors "_1") true subFieldA ]
, col_ [ SetSubField 2 <$> actionArgumentField (Array.snoc ancestors "_2") true subFieldB ]
]
actionArgumentField context nested (SimpleArray schema subFields) =
actionArgumentField ancestors nested (SimpleArray schema subFields) =
div_ [(if nested
then Keyed.div [ classes [ ClassName "nested" ] ]
else Keyed.div_) (mapWithIndex subFormContainer subFields)
@@ -169,7 +176,7 @@ actionArgumentField context nested (SimpleArray schema subFields) =
formGroup_ [
row_
[ col10_
[ SetSubField i <$> actionArgumentField (show i) true field ]
[ SetSubField i <$> actionArgumentField (Array.snoc ancestors (show i)) true field ]
, col2_
[ button
[ classes [ btn, btnLink ]
@@ -180,27 +187,27 @@ actionArgumentField context nested (SimpleArray schema subFields) =
]
]

actionArgumentField context nested (SimpleObject _ subFields) =
actionArgumentField ancestors nested (SimpleObject _ subFields) =
(if nested
then div [ classes [ ClassName "nested" ] ]
else div_) $ mapWithIndex (\i field -> map (SetSubField i) (subForm field)) subFields
where
subForm (name /\ arg) =
(formGroup_
[ label [ for name ] [ text name ]
, actionArgumentField name true arg
, actionArgumentField (Array.snoc ancestors name) true arg
]
)
actionArgumentField _ _ (Unknowable { context, description }) =
div_ [ text $ "Unsupported: " <> context
div_ [ text $ "Unsupported: " <> context
, code_ [ text description ]
]

validationFeedback :: forall p i. Array (WithPath ValidationError) -> HTML p i
validationFeedback [] =
validFeedback_ [ nbsp ]
validationFeedback errors =
invalidFeedback_ (div_ <<< pure <<< text <<< show <$> errors)
invalidFeedback_ (div_ <<< pure <<< text <<< showPathValue <$> errors)

addWaitActionPane :: forall p. Tuple String (HTML p Query)
addWaitActionPane =
@@ -223,7 +230,8 @@ evaluateActionsPane :: forall p. RemoteData AjaxError Blockchain -> Array Action
evaluateActionsPane evaluationResult actions =
col_
[ button
[ classes [ btn, btnClass evaluationResult hasErrors ]
[ id_ "evaluate"
, classes [ btn, btnClass evaluationResult hasErrors ]
, disabled hasErrors
, onClick $ input_ EvaluateActions
]
@@ -23,7 +23,7 @@ import Halogen (HTML, action)
import Halogen.Component (ParentHTML)
import Halogen.HTML (ClassName(ClassName), br_, button, code_, div, div_, h3_, pre_, slot', small, strong_, text)
import Halogen.HTML.Events (input, input_, onClick, onDragOver, onDrop)
import Halogen.HTML.Properties (class_, classes, disabled)
import Halogen.HTML.Properties (class_, classes, disabled, id_)
import Icons (Icon(..), icon)
import Language.Haskell.Interpreter (CompilationError(CompilationError, RawError))
import LocalStorage (LOCALSTORAGE)
@@ -62,7 +62,8 @@ editorPane state =
div_
[ demoScriptsPane
, div
[ onDragOver $ Just <<< action <<< HandleDragEvent
[ id_ "editor"
, onDragOver $ Just <<< action <<< HandleDragEvent
, onDrop $ Just <<< action <<< HandleDropEvent
]
[ slot' cpEditor EditorSlot
@@ -76,7 +77,8 @@ editorPane state =
[ gistControls (view _authStatus state) (view _createGistResult state) ]
, div_
[ button
[ classes [ btn, btnClass ]
[ id_ "compile"
, classes [ btn, btnClass ]
, onClick $ input_ CompileProgram
, disabled (isLoading state.compilationResult)
]
@@ -117,7 +119,7 @@ editorPane state =

demoScriptsPane :: forall p. HTML p Query
demoScriptsPane =
div [ class_ $ ClassName "demos" ]
div [ id_ "demos" ]
(Array.cons
(strong_ [ text "Demos: " ])
(demoScriptButton <$> Array.fromFoldable (Map.keys StaticData.demoFiles)))
@@ -14,10 +14,10 @@ import Data.Maybe (Maybe(..))
import Gist (Gist, NewGist(NewGist), NewGistFile(NewGistFile), gistHtmlUrl)
import Halogen.HTML (ClassName(ClassName), HTML, a, br_, div, div_, text)
import Halogen.HTML.Events (input_, onClick)
import Halogen.HTML.Properties (class_, classes, href, target)
import Halogen.HTML.Properties (class_, classes, href, id_, target)
import Icons (Icon(..), icon)
import Network.RemoteData (RemoteData(NotAsked, Loading, Failure, Success))
import Prelude (Unit, ($), (<$>))
import Prelude (Unit, ($), (<$>), (<>))
import Servant.PureScript.Affjax (AjaxError)
import Types (Query(..))

@@ -28,7 +28,8 @@ gistControls ::
-> HTML p (Query Unit)
gistControls authStatus createGistResult =
div_
[ a publishAttributes publishContent
[ a ([ id_ "publish-gist" ] <> publishAttributes)
publishContent
, br_
, div_
[ case createGistResult of
@@ -45,7 +45,7 @@ import Halogen.ECharts (EChartsEffects)
import Halogen.ECharts as EC
import Halogen.HTML (ClassName(ClassName), HTML, a, div, div_, h1, strong_, text)
import Halogen.HTML.Events (onClick)
import Halogen.HTML.Properties (class_, classes, href)
import Halogen.HTML.Properties (class_, classes, href, id_)
import Halogen.Query (HalogenM)
import Icons (Icon(..), icon)
import Language.Haskell.Interpreter (CompilationError(CompilationError, RawError))
@@ -472,10 +472,13 @@ mainTabBar activeView =
, Simulation /\ "Simulation"
, Transactions /\ "Transactions"
]
mkTab (link /\ title ) =

mkTab :: Tuple View String -> HTML p (Query Unit)
mkTab (link /\ title) =
navItem_ [
a
[ classes $ [ navLink ] <> activeClass
[ id_ $ "tab-" <> String.toLower (show link)
, classes $ [ navLink ] <> activeClass
, onClick $ const $ Just $ action $ ChangeView link
]
[ text title ]
@@ -269,7 +269,9 @@ derive instance eqView :: Eq View
derive instance genericView :: Generic View

instance showView :: Show View where
show = gShow
show Editor = "Editor"
show Simulation = "Simulation"
show Transactions = "Transactions"

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

@@ -2,10 +2,9 @@ module Validation where

import Prelude

import Data.Array as Array
import Data.Foldable (class Foldable)
import Data.Generic (class Generic)
import Data.List (List(..))
import Data.List as List

class Validation a where
validate :: a -> Array (WithPath ValidationError)
@@ -23,20 +22,26 @@ instance showValidationError :: Show ValidationError where

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

newtype WithPath a = WithPath { path :: List String, value :: a }
newtype WithPath a = WithPath { path :: Array String, value :: a }

derive instance eqWithPath :: Eq a => Eq (WithPath a)

derive instance functorWithPath :: Functor WithPath

instance showWithPath :: Show a => Show (WithPath a) where
show (WithPath { path, value }) = List.intercalate "." path <> ": " <> show value
show (WithPath { path, value }) = Array.intercalate "." path <> ": " <> show value

showPathValue :: forall a. Show a => WithPath a -> String
showPathValue (WithPath {value}) = show value

noPath :: forall a. a -> WithPath a
noPath value = WithPath { path: Nil, value }
noPath value = WithPath { path: [], value }

withPath :: forall a f. Foldable f => f String -> a -> WithPath a
withPath path value = WithPath { path: List.fromFoldable path, value }
withPath path value = WithPath { path: Array.fromFoldable path, value }

addPath :: forall a. String -> WithPath a -> WithPath a
addPath parent (WithPath {path, value}) = WithPath { path: Cons parent path, value }
addPath parent (WithPath {path, value}) = WithPath { path: Array.cons parent path, value }

joinPath :: forall a. Array String -> WithPath a -> WithPath a
joinPath ancestors (WithPath {path, value}) = WithPath { path: ancestors <> path, value }
@@ -2,7 +2,7 @@ module Wallet where

import Types

import Bootstrap (btn, btnSecondary, btnSmall, card, cardBody_, cardTitle_, card_, col4_, col_, pullRight, row, row_)
import Bootstrap (btn, btnSecondary, btnSmall, card, cardBody_, cardTitle_, card_, col4_, col_, formControl, pullRight, row, row_)
import Data.Array (mapWithIndex)
import Data.Array as Array
import Data.Int as Int
@@ -18,7 +18,7 @@ import Halogen.Query as HQ
import Icons (Icon(..), icon)
import Ledger.Ada.TH (Ada(..))
import Playground.API (FunctionSchema, SimulatorWallet, SimpleArgumentSchema, _Fn, _FunctionSchema)
import Prelude (map, show, ($), (<$>), (<<<))
import Prelude (map, show, ($), (<$>), (<<<), (<>))
import Wallet.Emulator.Types (Wallet)

walletsPane ::
@@ -44,8 +44,7 @@ walletPane ::
walletPane signatures index simulatorWallet =
Tuple (show index) $
col4_
[ div
[class_ $ ClassName "wallet"]
[ div [ classes [ ClassName "wallet", ClassName ("wallet-" <> show index) ] ]
[ card_
[ cardBody_
[ button
@@ -59,6 +58,7 @@ walletPane signatures index simulatorWallet =
, col_ [
input
[ type_ InputNumber
, class_ formControl
, value $ show $ view (_simulatorWalletBalance <<< _ada) simulatorWallet
, placeholder "Int"
, onValueInput $ map (HQ.action <<< SetBalance (view _simulatorWalletWallet simulatorWallet) <<< \v -> Ada {getAda: v}) <<< Int.fromString
@@ -72,7 +72,7 @@ h2 {
}
}

.demos {
#demos {
text-align: right;
padding: 5px 0;
}

0 comments on commit 073ceb7

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