Eliminate a failure case in negating which simplifies things

We can make the negate case total in the evaluator, since the failure cases cannot happen anyway due to the concrete syntax. Having the evaluator be pure reduced the amount of error handling.
IntersectMBO · Nov 30, 2020 · 24a1b77 · 24a1b77
1 parent dc5bf38
commit 24a1b77
Show file tree

Hide file tree

Showing 2 changed files with 17 additions and 66 deletions.
diff --git a/cardano-cli/src/Cardano/CLI/Mary/TxOutParser.hs b/cardano-cli/src/Cardano/CLI/Mary/TxOutParser.hs
@@ -7,7 +7,6 @@ module Cardano.CLI.Mary.TxOutParser
 import           Prelude
 
 import           Control.Applicative (some, (<|>))
-import           Data.Bifunctor (first)
 import           Data.Char (isAsciiLower, isAsciiUpper, isDigit)
 import           Data.Functor (void)
 import           Data.Text (Text)
@@ -17,34 +16,25 @@ 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.Mary.ValueParser
+                   (ValueExpr, evalValueExpr, renderParsecParseError, 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
+    Right (ParsedTxOutAnyEra addr valExpr) ->
+      Right (TxOutAnyEra addr (evalValueExpr valExpr))
 
 -- | Error parsing a transaction output.
-data TxOutAnyEraParseError
-  = TxOutAnyEraParseError !ParseError
-    -- ^ Error parsing the transaction output.
-  | ParsedValueExpressionEvaluationError !ValueExpressionEvaluationError
-    -- ^ Error evaluating a parsed 'ValueExpr'.
+data TxOutAnyEraParseError = TxOutAnyEraParseError !ParseError
   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
+renderTxOutAnyEraParseError (TxOutAnyEraParseError pErr) =
+  renderParsecParseError pErr
 
 data ParsedTxOutAnyEra = ParsedTxOutAnyEra !AddressAny !ValueExpr
 

diff --git a/cardano-cli/src/Cardano/CLI/Mary/ValueParser.hs b/cardano-cli/src/Cardano/CLI/Mary/ValueParser.hs
@@ -1,10 +1,8 @@
 module Cardano.CLI.Mary.ValueParser
   ( ValueExpr (..)
-  , ValueExpressionEvaluationError (..)
   , ValueParseError (..)
   , evalValueExpr
   , renderParsecParseError
-  , renderValueExpressionEvaluationError
   , renderValueParseError
   , stringToValue
   , valueExpr
@@ -29,41 +27,23 @@ import           Text.Parsec.String (Parser)
 import           Text.Parsec.Token (GenTokenParser, decimal, makeTokenParser, reservedOp)
 import           Text.ParserCombinators.Parsec.Combinator (many1)
 
-import           Cardano.Api.Typed (AsType (..), AssetId (..), AssetName (..), PolicyId (..),
-                     Quantity (..), Value, deserialiseFromRawBytesHex, valueFromList)
+import           Cardano.Api.Typed
 
 -- | Parse and construct a 'Value' from its string representation.
 stringToValue :: String -> Either ValueParseError Value
 stringToValue input =
-  case parse valueExpr "" input of
-    Left parseErr -> Left (ValueParseError parseErr)
-    Right valExpr ->
-      first ParsedValueExpressionEvaluationError (evalValueExpr valExpr)
+  first ValueParseError $
+    evalValueExpr <$> parse valueExpr "" input
 
 -- | Evaluate a 'ValueExpr' and construct a 'Value'.
-evalValueExpr :: ValueExpr -> Either ValueExpressionEvaluationError Value
+evalValueExpr :: ValueExpr -> Value
 evalValueExpr vExpr =
   case vExpr of
-    ValueExprAdd x y -> (<>) <$> evalValueExpr x <*> evalValueExpr y
-    ValueExprNegate x ->
-      maybe
-        (Left InvalidNegationExpressionError)
-        evalValueExpr
-        (negateValueExpr x)
-    ValueExprLovelace quant -> Right $ valueFromList [(AdaAssetId, quant)]
+    ValueExprAdd x y -> evalValueExpr x <> evalValueExpr y
+    ValueExprNegate x -> negateValue (evalValueExpr x)
+    ValueExprLovelace quant -> valueFromList [(AdaAssetId, quant)]
     ValueExprMultiAsset polId aName quant ->
-      Right $ valueFromList [(AssetId polId aName , quant)]
-
--- | Negate a 'ValueExpr'.
---
--- n.b. it is invalid to attempt the negation of a 'ValueExprAdd' or
--- 'ValueExprNegate'.
-negateValueExpr :: ValueExpr -> Maybe ValueExpr
-negateValueExpr (ValueExprAdd _x _y) = Nothing
-negateValueExpr (ValueExprNegate _x) = Nothing
-negateValueExpr (ValueExprLovelace x) = Just $ ValueExprLovelace (negate x)
-negateValueExpr (ValueExprMultiAsset polId aName x) =
-  Just $ ValueExprMultiAsset polId aName (negate x)
+      valueFromList [(AssetId polId aName , quant)]
 
 textToPolicyId :: Text -> Maybe PolicyId
 textToPolicyId hashText =
@@ -78,20 +58,12 @@ textToAssetName = AssetName . Text.encodeUtf8
 ------------------------------------------------------------------------------
 
 -- | Error parsing a 'Value'.
-data ValueParseError
-  = ValueParseError !ParseError
-    -- ^ Error parsing the 'Value'.
-  | ParsedValueExpressionEvaluationError !ValueExpressionEvaluationError
-    -- ^ Error evaluating a parsed 'ValueExpr'.
+data ValueParseError = ValueParseError !ParseError
   deriving Show
 
 -- | Render an error message for a 'ValueParseError'.
 renderValueParseError :: ValueParseError -> Text
-renderValueParseError err =
-  case err of
-    ValueParseError pErr -> renderParsecParseError pErr
-    ParsedValueExpressionEvaluationError evalErr ->
-      renderValueExpressionEvaluationError evalErr
+renderValueParseError (ValueParseError pErr) = renderParsecParseError pErr
 
 -- | Render an error message for a Parsec 'ParseError'.
 --
@@ -102,17 +74,6 @@ renderParsecParseError =
     . map (Text.pack . messageString)
     . errorMessages
 
--- | Error evaluating a 'ValueExpr'.
-data ValueExpressionEvaluationError
-  = InvalidNegationExpressionError
-  deriving Show
-
--- | Render an error message for a 'ValueExpressionEvaluationError'.
-renderValueExpressionEvaluationError :: ValueExpressionEvaluationError -> Text
-renderValueExpressionEvaluationError err =
-  case err of
-    InvalidNegationExpressionError ->
-      "Cannot evaluate invalid negation expression."
 
 ------------------------------------------------------------------------------
 -- Expression parser