From f270509bed9b3a043da626f175c386ae20915b49 Mon Sep 17 00:00:00 2001 From: Kris Jenkins Date: Wed, 6 Mar 2019 11:26:23 +0000 Subject: [PATCH] Playground: Adding some HTML `id` attributes to make writing Selenium scripts easier. --- plutus-playground-client/src/Action.purs | 50 ++++++++++++-------- plutus-playground-client/src/Editor.purs | 10 ++-- plutus-playground-client/src/Gists.purs | 7 +-- plutus-playground-client/src/MainFrame.purs | 9 ++-- plutus-playground-client/src/Types.purs | 4 +- plutus-playground-client/src/Validation.purs | 19 +++++--- plutus-playground-client/src/Wallet.purs | 8 ++-- plutus-playground-client/static/main.scss | 2 +- 8 files changed, 65 insertions(+), 44 deletions(-) diff --git a/plutus-playground-client/src/Action.purs b/plutus-playground-client/src/Action.purs index 0568d255570..db1d68f91df 100644 --- a/plutus-playground-client/src/Action.purs +++ b/plutus-playground-client/src/Action.purs @@ -18,7 +18,7 @@ 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)) @@ -26,7 +26,7 @@ import Playground.API (EvaluationResult, SimulatorWallet, _EvaluationResult, _Fn 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,7 +187,7 @@ 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 @@ -188,11 +195,11 @@ actionArgumentField context nested (SimpleObject _ subFields) = 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 ] ] @@ -200,7 +207,7 @@ 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 ] diff --git a/plutus-playground-client/src/Editor.purs b/plutus-playground-client/src/Editor.purs index 74b554f5190..fb3ee0fc389 100644 --- a/plutus-playground-client/src/Editor.purs +++ b/plutus-playground-client/src/Editor.purs @@ -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))) diff --git a/plutus-playground-client/src/Gists.purs b/plutus-playground-client/src/Gists.purs index e7142146e91..bb423f7f973 100644 --- a/plutus-playground-client/src/Gists.purs +++ b/plutus-playground-client/src/Gists.purs @@ -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 diff --git a/plutus-playground-client/src/MainFrame.purs b/plutus-playground-client/src/MainFrame.purs index 3a01488952e..297b809e9aa 100644 --- a/plutus-playground-client/src/MainFrame.purs +++ b/plutus-playground-client/src/MainFrame.purs @@ -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 ] diff --git a/plutus-playground-client/src/Types.purs b/plutus-playground-client/src/Types.purs index da6a77842c7..a20f3f01459 100644 --- a/plutus-playground-client/src/Types.purs +++ b/plutus-playground-client/src/Types.purs @@ -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" ------------------------------------------------------------ diff --git a/plutus-playground-client/src/Validation.purs b/plutus-playground-client/src/Validation.purs index 3cf8a159ac0..1358b69c689 100644 --- a/plutus-playground-client/src/Validation.purs +++ b/plutus-playground-client/src/Validation.purs @@ -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 } diff --git a/plutus-playground-client/src/Wallet.purs b/plutus-playground-client/src/Wallet.purs index 08c62f57b98..9fe93c1adbb 100644 --- a/plutus-playground-client/src/Wallet.purs +++ b/plutus-playground-client/src/Wallet.purs @@ -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 diff --git a/plutus-playground-client/static/main.scss b/plutus-playground-client/static/main.scss index 59322456c54..f16c2d143ad 100644 --- a/plutus-playground-client/static/main.scss +++ b/plutus-playground-client/static/main.scss @@ -72,7 +72,7 @@ h2 { } } -.demos { +#demos { text-align: right; padding: 5px 0; }