Implement new transaction output parser

cardano-cli/cardano-cli.cabal

@@ -59,6 +59,7 @@ library
                        Cardano.CLI.Shelley.Run.TextView
                        Cardano.CLI.Shelley.Run.Transaction
 
+                       Cardano.CLI.Mary.TxOutParser
                        Cardano.CLI.Mary.ValueParser
 
                        Cardano.CLI.TopHandler

cardano-cli/src/Cardano/CLI/Mary/TxOutParser.hs

@@ -0,0 +1,83 @@
+module Cardano.CLI.Mary.TxOutParser
+  ( TxOutAnyEraParseError (..)
+  , renderTxOutAnyEraParseError
+  , stringToTxOutAnyEra
+  ) where
+
+import           Prelude
+
+import           Control.Applicative (some, (<|>))
+import           Data.Bifunctor (first)
+import           Data.Char (isAsciiLower, isAsciiUpper, isDigit)
+import           Data.Functor (void)
+import           Data.Text (Text)
+import qualified Data.Text as Text
+import           Text.Parsec (ParseError, parse, satisfy, try)
+import           Text.Parsec.Char (space, spaces, string)
+import           Text.Parsec.String (Parser)
+
+import           Cardano.API (AddressAny (..), AsType (..), deserialiseAddress)
+import           Cardano.CLI.Mary.ValueParser (ValueExpr, ValueExpressionEvaluationError,
+                     evalValueExpr, renderParsecParseError, renderValueExpressionEvaluationError,
+                     valueExpr)
+import           Cardano.CLI.Types (TxOutAnyEra (..))
+
+stringToTxOutAnyEra :: String -> Either TxOutAnyEraParseError TxOutAnyEra
+stringToTxOutAnyEra str =
+  case parse txOutAnyEra "" str of
+    Left parseErr -> Left (TxOutAnyEraParseError parseErr)
+    Right (ParsedTxOutAnyEra addr valExpr) -> do
+      val <- first ParsedValueExpressionEvaluationError (evalValueExpr valExpr)
+      pure $ TxOutAnyEra addr val
+
+-- | Error parsing a 'Value'.
+data TxOutAnyEraParseError
+  = TxOutAnyEraParseError !ParseError
+    -- ^ Error parsing the transaction output.
+  | ParsedValueExpressionEvaluationError !ValueExpressionEvaluationError
+    -- ^ Error evaluating a parsed 'ValueExpr'.
+  deriving Show
+
+-- | Render an error message for a 'TxOutAnyEraParseError'.
+renderTxOutAnyEraParseError :: TxOutAnyEraParseError -> Text
+renderTxOutAnyEraParseError err =
+  case err of
+    TxOutAnyEraParseError pErr -> renderParsecParseError pErr
+    ParsedValueExpressionEvaluationError evalErr ->
+      renderValueExpressionEvaluationError evalErr
+
+data ParsedTxOutAnyEra = ParsedTxOutAnyEra !AddressAny !ValueExpr
+
+txOutAnyEra :: Parser ParsedTxOutAnyEra
+txOutAnyEra = do
+  ParsedTxOutAnyEra
+    <$> addressAny
+    <* (try addrValueSepOldSyntax <|> someSpace)
+    <*> valueExpr
+  where
+    -- Essentially @some space@, but the result is discarded.
+    someSpace :: Parser ()
+    someSpace = void (some space)
+
+    -- Parser for the old style of separating the address and value in a
+    -- transaction output.
+    addrValueSepOldSyntax :: Parser ()
+    addrValueSepOldSyntax = spaces *> string "+" *> spaces
+
+addressAny :: Parser AddressAny
+addressAny = do
+  str <- plausibleAddressString
+  case deserialiseAddress AsAddressAny str of
+    Nothing -> fail "expecting valid address"
+    Just addr -> pure addr
+
+plausibleAddressString :: Parser Text
+plausibleAddressString =
+    Text.pack <$> some (satisfy isPlausibleAddressChar)
+  where
+    -- Covers both base58 and bech32 (with constrained prefixes)
+    isPlausibleAddressChar c =
+      isAsciiLower c
+        || isAsciiUpper c
+        || isDigit c
+        || c == '_'