SCB: Improved formatting of active endpoint hooks.

plutus-scb-client/src/View/Contracts.purs

@@ -23,6 +23,7 @@ import Plutus.SCB.Types (ContractExe)
 import Schema.Types (FormEvent)
 import Types (EndpointForm, HAction(..), WebData, _contractInstanceIdString, _contractPath, _csContract, _csCurrentState, _hooks)
 import Validation (_argument)
+import View.Pretty (pretty)
 import View.Utils (webDataPane)
 
 installedContractsPane ::
@@ -129,7 +130,7 @@ contractRequestView contractInstance =
     tr_
       [ td_ [ text $ show itID ]
       , td_ [ text $ show rqID ]
-      , td_ [ text $ show rqRequest ]
+      , td_ [ pretty rqRequest ]
       ]
 
 hasActiveRequests :: forall t. ContractInstanceState t -> Boolean

plutus-scb-client/src/View/Pretty.purs

@@ -1,48 +1,49 @@
 module View.Pretty where
 
-import Data.Lens (toArrayOf, view)
-import Halogen.HTML (HTML, b_, div_, span_, text)
-import Language.Plutus.Contract.Effects.ExposeEndpoint (EndpointDescription)
-import Playground.Lenses (_endpointValue, _getEndpointDescription, _txConfirmed, _txId)
-import Plutus.SCB.Events (ChainEvent(..))
-import Plutus.SCB.Events.Contract (ContractEvent(..), ContractInstanceState(..), ContractResponse(..))
-import Plutus.SCB.Events.User (UserEvent(..))
-import Plutus.SCB.Types (ContractExe(..))
-import Types (_contractActiveEndpoints, _contractInstanceIdString)
+import Prelude
 import Bootstrap (alertDanger_, nbsp)
 import Data.Array (length)
-import Prelude
+import Data.Lens (toArrayOf, view)
 import Data.Lens.Iso.Newtype (_Newtype)
 import Data.Map as Map
 import Data.Newtype (unwrap)
+import Halogen.HTML (HTML, b_, div_, span_, text)
+import Language.Plutus.Contract.Effects.ExposeEndpoint (ActiveEndpoint, EndpointDescription)
 import Language.Plutus.Contract.Effects.WriteTx (WriteTxResponse(..))
 import Language.Plutus.Contract.Resumable (Response(..))
+import Ledger.Constraints.OffChain (UnbalancedTx(..))
 import Ledger.Tx (Tx(..))
+import Playground.Lenses (_aeDescription, _endpointValue, _getEndpointDescription, _txConfirmed, _txId)
+import Plutus.SCB.Events (ChainEvent(..))
+import Plutus.SCB.Events.Contract (ContractEvent(..), ContractInstanceState(..), ContractResponse(..), ContractSCBRequest(..))
 import Plutus.SCB.Events.Node (NodeEvent(..))
+import Plutus.SCB.Events.User (UserEvent(..))
 import Plutus.SCB.Events.Wallet (WalletEvent(..))
+import Plutus.SCB.Types (ContractExe(..))
+import Types (_contractActiveEndpoints, _contractInstanceIdString)
 
 class Pretty a where
   pretty :: forall p i. a -> HTML p i
 
 instance prettyChainEvent :: Pretty t => Pretty (ChainEvent t) where
-  pretty (ContractEvent subevent) = eventWithPrefix "Contract" $ pretty subevent
-  pretty (UserEvent subevent) = eventWithPrefix "User" $ pretty subevent
-  pretty (WalletEvent subevent) = eventWithPrefix "Wallet" $ pretty subevent
-  pretty (NodeEvent subevent) = eventWithPrefix "Node" $ pretty subevent
+  pretty (ContractEvent subevent) = withHeading "Contract" subevent
+  pretty (UserEvent subevent) = withHeading "User" subevent
+  pretty (WalletEvent subevent) = withHeading "Wallet" subevent
+  pretty (NodeEvent subevent) = withHeading "Node" subevent
 
-eventWithPrefix :: forall i p. String -> HTML p i -> HTML p i
-eventWithPrefix prefix content =
+withHeading :: forall i p a. Pretty a => String -> a -> HTML p i
+withHeading prefix content =
   span_
     [ b_
         [ text prefix
         , text ":"
         , nbsp
         ]
-    , content
+    , pretty content
     ]
 
 instance prettyUserEvent :: Pretty t => Pretty (UserEvent t) where
-  pretty (InstallContract contract) = span_ [ text $ "Install", nbsp, pretty contract ]
+  pretty (InstallContract contract) = span_ [ text $ "Install:", nbsp, pretty contract ]
 
 instance prettyContractExe :: Pretty ContractExe where
   pretty ((ContractExe { contractPath })) = text contractPath
@@ -72,7 +73,7 @@ instance prettyContractInstanceState :: Pretty t => Pretty (ContractInstanceStat
 instance prettyNodeEvent :: Pretty NodeEvent where
   pretty event@(SubmittedTx tx) =
     span_
-      [ text "SubmittedTx"
+      [ text "SubmittedTx:"
       , nbsp
       , pretty tx
       ]
@@ -102,74 +103,148 @@ instance prettyResponse :: Pretty a => Pretty (Response a) where
 instance prettyContractResponse :: Pretty ContractResponse where
   pretty (AwaitSlotResponse slot) =
     span_
-      [ text "AwaitSlotResponse"
+      [ text "AwaitSlotResponse:"
       , nbsp
       , text $ show slot
       ]
   pretty (AwaitTxConfirmedResponse txConfirmed) =
     span_
-      [ text "AwaitTxConfirmedResponse Confirmed:"
+      [ text "AwaitTxConfirmedResponse:"
       , nbsp
       , text $ view (_txConfirmed <<< _txId) txConfirmed
       ]
   pretty (UserEndpointResponse endpointDescription endpointValue) =
     span_
-      [ text "UserEndpointResponse"
+      [ text "UserEndpointResponse:"
       , nbsp
       , pretty endpointDescription
       , nbsp
       , text $ view (_endpointValue <<< _Newtype) endpointValue
       ]
   pretty (OwnPubkeyResponse pubKey) =
     span_
-      [ text "OwnPubkeyResponse"
+      [ text "OwnPubkeyResponse:"
       , nbsp
       , text $ show pubKey
       ]
   pretty (UtxoAtResponse utxoAtAddress) =
     span_
-      [ text "UtxoAtResponse"
+      [ text "UtxoAtResponse:"
       , nbsp
       , text $ show utxoAtAddress
       ]
   pretty (NextTxAtResponse addressChangeResponse) =
     span_
-      [ text "NextTxAtResponse"
+      [ text "NextTxAtResponse:"
       , nbsp
       , text $ show addressChangeResponse
       ]
   pretty (WriteTxResponse writeTxResponse) =
     span_
-      [ text "WriteTxResponse"
+      [ text "WriteTxResponse:"
       , nbsp
       , pretty writeTxResponse
       ]
 
+instance prettyContractSCBRequest :: Pretty ContractSCBRequest where
+  pretty (AwaitSlotRequest slot) =
+    span_
+      [ text "AwaitSlotRequest:"
+      , nbsp
+      , text $ show slot
+      ]
+  pretty (AwaitTxConfirmedRequest txId) =
+    span_
+      [ text "AwaitTxConfirmedRequest:"
+      , nbsp
+      , text $ view _txId txId
+      ]
+  pretty (UserEndpointRequest activeEndpoint) =
+    span_
+      [ text "UserEndpointRequest:"
+      , nbsp
+      , pretty activeEndpoint
+      ]
+  pretty (OwnPubkeyRequest pubKey) =
+    span_
+      [ text "OwnPubkeyRequest:"
+      , nbsp
+      , text $ show pubKey
+      ]
+  pretty (UtxoAtRequest utxoAtAddress) =
+    span_
+      [ text "UtxoAtRequest:"
+      , nbsp
+      , text $ show utxoAtAddress
+      ]
+  pretty (NextTxAtRequest addressChangeRequest) =
+    span_
+      [ text "NextTxAtRequest:"
+      , nbsp
+      , text $ show addressChangeRequest
+      ]
+  pretty (WriteTxRequest writeTxRequest) =
+    span_
+      [ text "WriteTxRequest:"
+      , nbsp
+      , pretty writeTxRequest
+      ]
+
 instance prettyWriteTxResponse :: Pretty WriteTxResponse where
-  pretty (WriteTxSuccess tx) = span_ [ text "WriteTxSuccess", nbsp, pretty tx ]
+  pretty (WriteTxSuccess tx) = span_ [ text "WriteTxSuccess:", nbsp, pretty tx ]
   pretty (WriteTxFailed error) =
     alertDanger_
-      [ text "WriteTxFailed"
+      [ text "WriteTxFailed:"
       , nbsp
       , text $ show error
       ]
 
+instance prettyUnbalancedTx :: Pretty UnbalancedTx where
+  pretty (UnbalancedTx { unBalancedTxTx: (Tx { txInputs, txOutputs, txSignatures }) }) =
+    span_
+      [ text "UnbalancedTx:"
+      , nbsp
+      , withBasicPlural (length txInputs) "input"
+      , text ", "
+      , withBasicPlural (length txOutputs) "output"
+      , text ", "
+      , withBasicPlural (Map.size (unwrap txSignatures)) "signature"
+      , text "."
+      ]
+
 instance prettyTx :: Pretty Tx where
   pretty (Tx { txInputs, txOutputs, txSignatures }) =
     span_
-      [ text "Tx: "
-      , text $ show (length txInputs) <> " inputs, "
-      , text $ show (length txOutputs) <> " outputs, "
-      , text $ show (Map.size (unwrap txSignatures)) <> " signatures."
+      [ text "Tx:"
+      , nbsp
+      , withBasicPlural (length txInputs) "input"
+      , text ", "
+      , withBasicPlural (length txOutputs) "output"
+      , text ", "
+      , withBasicPlural (Map.size (unwrap txSignatures)) "signature"
+      , text "."
       ]
 
 instance prettyWalletEvent :: Pretty WalletEvent where
   pretty (BalancedTx tx) =
     span_
-      [ text "BalancedTx"
+      [ text "BalancedTx:"
       , nbsp
       , pretty tx
       ]
 
+instance prettyActiveEndpoint :: Pretty ActiveEndpoint where
+  pretty endpoint = pretty $ view _aeDescription endpoint
+
 instance prettyEndpointDescription :: Pretty EndpointDescription where
   pretty description = text $ show $ view _getEndpointDescription description
+
+-- | Yes, this is dumb and only handles _most_ English words, but it's and better than saying '1 input(s)'.
+-- And hey, "most English words" is still a lot of words.
+withBasicPlural :: forall p i. Int -> String -> HTML p i
+withBasicPlural n name =
+  span_
+    [ text $ show n
+    , nbsp
+    , text $ name <> (if n == 1 then "" else "s")
+    ]

web-common/src/Playground/Lenses.purs

@@ -46,3 +46,9 @@ _txId = _Newtype <<< prop (SProxy :: SProxy "getTxId")
 
 _utxoIndexEntries :: Lens' UtxoIndex (Map TxOutRef TxOut)
 _utxoIndexEntries = _UtxoIndex <<< prop (SProxy :: SProxy "getIndex") <<< _JsonMap
+
+_aeDescription :: forall s r a. Newtype s { aeDescription :: a | r } => Lens' s a
+_aeDescription = _Newtype <<< prop (SProxy :: SProxy "aeDescription")
+
+_aeMetadata :: forall s r a. Newtype s { aeMetadata :: a | r } => Lens' s a
+_aeMetadata = _Newtype <<< prop (SProxy :: SProxy "aeMetadata")