SCP-433 - Resize bottom panel of Marlowe Simulation and Haskell Editor

Also fix issue with choice wrapping for a longer choice name

marlowe-playground-client/src/Halogen/Classes.purs

@@ -197,3 +197,9 @@ minimizeIcon :: Boolean -> Array ClassName
 minimizeIcon true = [ ClassName "minimize-icon", ClassName "expanded" ]
 
 minimizeIcon false = [ ClassName "minimize-icon" ]
+
+footerPanelBg :: ClassName
+footerPanelBg = ClassName "footer-panel-bg"
+
+analysisPanel :: ClassName
+analysisPanel = ClassName "analysis-panel"

marlowe-playground-client/src/HaskellEditor.purs

@@ -12,7 +12,7 @@ import Data.String as String
 import Effect.Aff.Class (class MonadAff)
 import Examples.Haskell.Contracts as HE
 import Halogen (ClassName(..), ComponentHTML, liftEffect)
-import Halogen.Classes (aHorizontal, accentBorderBottom, activeClasses, closeDrawerArrowIcon, codeEditor, jFlexStart, minimizeIcon, panelSubHeader, panelSubHeaderMain, spaceLeft)
+import Halogen.Classes (aHorizontal, accentBorderBottom, activeClasses, analysisPanel, closeDrawerArrowIcon, codeEditor, footerPanelBg, jFlexStart, minimizeIcon, panelSubHeader, panelSubHeaderMain, spaceLeft)
 import Halogen.HTML (HTML, a, button, code_, div, div_, img, li, option, pre, pre_, section, select, slot, small_, text, ul)
 import Halogen.HTML.Events (onClick, onSelectedIndexChange)
 import Halogen.HTML.Properties (alt, class_, classes, disabled, src)
@@ -25,7 +25,7 @@ import Monaco as Monaco
 import Network.RemoteData (RemoteData(..), isLoading, isSuccess)
 import Prelude (bind, bottom, const, eq, map, not, show, unit, ($), (<$>), (<<<), (<>), (==), (||))
 import StaticData as StaticData
-import Types (ChildSlots, FrontendState, HAction(..), View(..), _activeHaskellDemo, _compilationResult, _haskellEditorKeybindings, _haskellEditorSlot, _showBottomPanel, analysisPanel, footerPanelBg, isActiveTab)
+import Types (ChildSlots, FrontendState, HAction(..), _activeHaskellDemo, _compilationResult, _haskellEditorKeybindings, _haskellEditorSlot, _showBottomPanel, bottomPanelHeight)
 
 render ::
   forall m.
@@ -85,8 +85,9 @@ haskellEditor state = slot _haskellEditorSlot unit component unit (Just <<< Hask
 
 bottomPanel :: forall p. FrontendState -> HTML p HAction
 bottomPanel state =
-  div [ classes (analysisPanel state) ]
-    [ div [ classes (footerPanelBg (state ^. _showBottomPanel) HaskellEditor <> isActiveTab state HaskellEditor) ]
+  div ([ classes [ analysisPanel ] ] <> [ bottomPanelHeight (state ^. _showBottomPanel) ])
+    [ div
+        [ classes [ footerPanelBg, ClassName "flip-x" ] ]
         [ section [ classes [ ClassName "panel-header", aHorizontal ] ]
             [ div [ classes [ ClassName "panel-sub-header-main", aHorizontal, accentBorderBottom ] ]
                 [ div [ class_ (ClassName "minimize-icon-container") ]

marlowe-playground-client/src/Simulation.purs

@@ -40,7 +40,7 @@ import Halogen as H
 import Halogen.Analytics (handleActionWithAnalyticsTracking)
 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 as Classes
-import Halogen.HTML (ClassName(..), ComponentHTML, HTML, a, article, aside, b_, button, div, em_, h2, h6, h6_, img, input, label, li, li_, option, p, p_, section, select, slot, small, small_, span, strong_, text, ul, ul_)
+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, small_, span, strong_, text, ul, 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
@@ -606,24 +606,32 @@ inputItem isEnabled person (DepositInput accountId party token value) =
 inputItem isEnabled person (ChoiceInput choiceId@(ChoiceId choiceName choiceOwner) bounds chosenNum) =
   div
     [ classes [ aHorizontal, ClassName "flex-wrap" ] ]
-    [ div []
-        [ p [ class_ (ClassName "choice-input") ]
-            [ spanText "Choice "
-            , b_ [ spanText (show choiceName) ]
-            , spanText ": Choose value "
-            , marloweActionInput isEnabled (SetChoice choiceId) chosenNum
-            ]
-        , p [ class_ (ClassName "choice-error") ] error
-        ]
-    , button
-        [ classes [ plusBtn, smallBtn, (Classes.disabled $ not isEnabled) ]
-        , enabled (isEnabled && inBounds chosenNum bounds)
-        , onClick $ const $ Just
-            $ AddInput (Just person) (IChoice (ChoiceId choiceName choiceOwner) chosenNum) bounds
-        ]
-        [ text "+" ]
-    ]
+    ( [ div []
+          [ p [ class_ (ClassName "choice-input") ]
+              [ spanText "Choice "
+              , b_ [ spanText (show choiceName <> ":") ]
+              , br_
+              , spanText "Choose value "
+              , marloweActionInput isEnabled (SetChoice choiceId) chosenNum
+              ]
+          , p [ class_ (ClassName "choice-error") ] error
+          ]
+      ]
+        <> addButton
+    )
   where
+  addButton =
+    if isEnabled && inBounds chosenNum bounds then
+      [ button
+          [ classes [ plusBtn, smallBtn ]
+          , onClick $ const $ Just
+              $ AddInput (Just person) (IChoice (ChoiceId choiceName choiceOwner) chosenNum) bounds
+          ]
+          [ text "+" ]
+      ]
+    else
+      []
+
   error = if inBounds chosenNum bounds then [] else [ text boundsError ]
 
   boundsError = "Choice must be between " <> intercalate " or " (map boundError bounds)

marlowe-playground-client/src/Simulation/BottomPanel.purs

@@ -18,9 +18,9 @@ import Data.String (take)
 import Data.String.Extra (unlines)
 import Data.Tuple (Tuple(..))
 import Data.Tuple.Nested ((/\))
-import Halogen.Classes (aHorizontal, accentBorderBottom, active, activeClass, closeDrawerArrowIcon, first, flex, flexLeft, flexTen, minimizeIcon, rTable, rTable6cols, rTableCell, rTableDataRow, rTableEmptyRow, spanText, underline)
+import Halogen.Classes (aHorizontal, accentBorderBottom, active, activeClass, closeDrawerArrowIcon, first, flex, flexLeft, flexTen, footerPanelBg, minimizeIcon, rTable, rTable6cols, rTableCell, rTableDataRow, rTableEmptyRow, spanText, underline)
 import Halogen.Classes as Classes
-import Halogen.HTML (ClassName(..), HTML, a, a_, b_, button, code_, div, h2, h3, img, li, li_, ol, pre, section, span_, strong_, text, ul)
+import Halogen.HTML (AttrName(..), ClassName(..), HTML, a, a_, attr, b_, button, code_, div, h2, h3, img, li, li_, ol, pre, section, span_, strong_, text, ul, ul_)
 import Halogen.HTML.Events (onClick)
 import Halogen.HTML.Properties (alt, class_, classes, enabled, src)
 import Marlowe.Parser (transactionInputList, transactionWarningList)
@@ -32,25 +32,16 @@ import Simulation.State (MarloweEvent(..), _contract, _editorErrors, _editorWarn
 import Simulation.Types (Action(..), BottomPanelView(..), State, _analysisState, _bottomPanelView, _marloweState, _showBottomPanel, _showErrorDetail, isContractValid)
 import Text.Parsing.StringParser (runParser)
 import Text.Parsing.StringParser.Basic (lines)
-
-simulationBottomPanel :: State -> Array ClassName
-simulationBottomPanel state = if state ^. _showBottomPanel then [ ClassName "simulation-bottom-panel" ] else [ ClassName "simulation-bottom-panel", ClassName "collapse" ]
-
-footerPanelBg :: Boolean -> Array ClassName
-footerPanelBg display =
-  if display then
-    [ ClassName "footer-panel-bg", ClassName "expanded" ]
-  else
-    [ ClassName "footer-panel-bg" ]
+import Types (bottomPanelHeight)
 
 bottomPanel :: forall p. State -> HTML p Action
 bottomPanel state =
-  div [ classes (simulationBottomPanel state) ]
-    [ div [ class_ flex ]
+  div ([ classes [ ClassName "simulation-bottom-panel" ] ] <> [ bottomPanelHeight (state ^. _showBottomPanel) ])
+    [ div [ classes [ flex, ClassName "flip-x", ClassName "full-height" ] ]
         [ div [ class_ flexTen ]
-            [ div [ classes (footerPanelBg (state ^. _showBottomPanel) <> [ active ]) ]
+            [ div [ classes [ footerPanelBg, active ] ]
                 [ section [ classes [ ClassName "panel-header", aHorizontal ] ]
-                    [ div [ classes ([ ClassName "panel-sub-header-main", aHorizontal ] <> (if state ^. _showBottomPanel then [ accentBorderBottom ] else [])) ]
+                    [ div [ classes [ ClassName "panel-sub-header-main", aHorizontal, accentBorderBottom ] ]
                         [ ul [ class_ (ClassName "start-item") ]
                             [ li [ class_ (ClassName "minimize-icon-container") ]
                                 [ a [ onClick $ const $ Just $ ShowBottomPanel (state ^. _showBottomPanel <<< to not) ]
@@ -314,7 +305,7 @@ panelContents state MarloweWarningsView =
           [ div [] [ text "Description" ]
           , div [] [ text "Line Number" ]
           ]
-      , ul [] (map renderWarning warnings)
+      , ul_ (map renderWarning warnings)
       ]
 
   renderWarning warning =
@@ -343,7 +334,7 @@ panelContents state MarloweErrorsView =
           [ div [] [ text "Description" ]
           , div [] [ text "Line Number" ]
           ]
-      , ul [] (map renderError errors)
+      , ul_ (map renderError errors)
       ]
 
   renderError error =

marlowe-playground-client/src/Types.purs

@@ -12,10 +12,11 @@ import Data.Lens.Record (prop)
 import Data.Maybe (Maybe(..))
 import Data.Newtype (class Newtype)
 import Data.Symbol (SProxy(..))
-import Halogen (ClassName(..))
+import Halogen (AttrName(..), ClassName)
 import Halogen as H
 import Halogen.Blockly (BlocklyMessage, BlocklyQuery)
 import Halogen.Classes (activeClass)
+import Halogen.HTML (IProp, attr)
 import Halogen.Monaco (KeyBindings)
 import Halogen.Monaco as Monaco
 import Language.Haskell.Interpreter (InterpreterError, InterpreterResult)
@@ -147,18 +148,6 @@ _value = prop (SProxy :: SProxy "value")
 isActiveTab :: FrontendState -> View -> Array ClassName
 isActiveTab state activeView = state ^. _view <<< (activeClass (eq activeView))
 
-analysisPanel :: FrontendState -> Array ClassName
-analysisPanel state = if state ^. _showBottomPanel then [ ClassName "analysis-panel" ] else [ ClassName "analysis-panel", ClassName "collapse" ]
-
-footerPanelBg :: Boolean -> View -> Array ClassName
-footerPanelBg display HaskellEditor =
-  if display then
-    [ ClassName "footer-panel-bg", ClassName "expanded", ClassName "footer-panel-haskell" ]
-  else
-    [ ClassName "footer-panel-bg", ClassName "footer-panel-haskell" ]
-
-footerPanelBg display _ =
-  if display then
-    [ ClassName "footer-panel-bg", ClassName "expanded" ]
-  else
-    [ ClassName "footer-panel-bg" ]
+-- TODO: https://github.com/purescript-halogen/purescript-halogen/issues/682
+bottomPanelHeight :: forall r i. Boolean -> IProp r i
+bottomPanelHeight showBottomPanel = if showBottomPanel then attr (AttrName "style") "" else attr (AttrName "style") "height: 3.5rem"

marlowe-playground-client/src/Wallet.purs

@@ -40,7 +40,7 @@ import Halogen as H
 import Halogen.Analytics (handleActionWithAnalyticsTracking)
 import Halogen.Classes (aHorizontal, active, bold, closeDrawerIcon, expanded, first, infoIcon, jFlexStart, minusBtn, noMargins, panelSubHeader, panelSubHeaderMain, panelSubHeaderSide, plusBtn, pointer, rTable, rTable4cols, rTableCell, rTableDataRow, rTableEmptyRow, sidebarComposer, smallBtn, spaceLeft, spanText, textSecondaryColor, uppercase)
 import Halogen.Classes as Classes
-import Halogen.HTML (HTML, a, article, aside, b_, button, div, h6, hr_, img, input, li, option, p, p_, section, select, small, small_, strong_, text, ul)
+import Halogen.HTML (HTML, a, article, aside, b_, br_, button, div, h6, hr_, img, input, li, option, p, p_, section, select, small, small_, strong_, text, ul)
 import Halogen.HTML (code_, span) as HTML
 import Halogen.HTML.Elements.Keyed as Keyed
 import Halogen.HTML.Events (onClick, onValueChange)
@@ -1115,24 +1115,32 @@ inputItem isEnabled person (DepositInput accountId party token value) =
 inputItem isEnabled person (ChoiceInput choiceId@(ChoiceId choiceName choiceOwner) bounds chosenNum) =
   li
     [ classes [ aHorizontal, ClassName "flex-wrap", ClassName "choice-row" ] ]
-    [ div []
-        [ p [ class_ (ClassName "choice-input") ]
-            [ spanText "Choice "
-            , b_ [ spanText (show choiceName) ]
-            , spanText ": Choose value "
-            , marloweActionInput isEnabled (SetChoice choiceId) chosenNum
-            ]
-        , p [ class_ (ClassName "choice-error") ] error
-        ]
-    , button
-        [ classes [ plusBtn, smallBtn, if (isEnabled && inBounds chosenNum bounds) then (ClassName mempty) else Classes.hide ]
-        , enabled (isEnabled && inBounds chosenNum bounds)
-        , onClick $ const $ Just
-            $ AddInput (Just person) (IChoice (ChoiceId choiceName choiceOwner) chosenNum) bounds
-        ]
-        [ text "+" ]
-    ]
+    ( [ div []
+          [ p [ class_ (ClassName "choice-input") ]
+              [ spanText "Choice "
+              , b_ [ spanText (show choiceName <> ":") ]
+              , br_
+              , spanText "Choose value "
+              , marloweActionInput isEnabled (SetChoice choiceId) chosenNum
+              ]
+          , p [ class_ (ClassName "choice-error") ] error
+          ]
+      ]
+        <> addButton
+    )
   where
+  addButton =
+    if isEnabled && inBounds chosenNum bounds then
+      [ button
+          [ classes [ plusBtn, smallBtn ]
+          , onClick $ const $ Just
+              $ AddInput (Just person) (IChoice (ChoiceId choiceName choiceOwner) chosenNum) bounds
+          ]
+          [ text "+" ]
+      ]
+    else
+      []
+
   error = if inBounds chosenNum bounds then [] else [ text boundsError ]
 
   boundsError = "Choice must be between " <> intercalate " or " (map boundError bounds)

marlowe-playground-client/static/css/css_var_globals.css

@@ -1,6 +1,7 @@
 :root {
   --animate-btn: translateY(1px);
   --box-shadow: 0 -3px 12px 0 rgba(0, 0, 0, 0.1);
+  --box-shadow-inverted: -3px 0 12px 0 rgba(0, 0, 0, 0.1);
   --box-shadow-left: -6px 6px 6px 0px rgba(0, 0, 0, 0.1);
   --border-radius: 4px;
 }