Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

ValueParser: rename publicly exposed function names to indicate they are parsers #674

Open
wants to merge 3 commits into
base: master
Choose a base branch
from
Open
Show file tree
Hide file tree
Changes from all commits
Commits
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
6 changes: 3 additions & 3 deletions cardano-api/internal/Cardano/Api/Tx/Body.hs
Original file line number Diff line number Diff line change
Expand Up @@ -997,10 +997,10 @@ instance IsShelleyBasedEra era => FromJSON (TxOutValue era) where
decodeAssets :: Aeson.Object -> Aeson.Parser [(AssetName, Quantity)]
decodeAssets assetNameHm =
let l = toList assetNameHm
in mapM (\(aName, q) -> (,) <$> parseAssetName aName <*> decodeQuantity q) l
in mapM (\(aName, q) -> (,) <$> parseKeyAsAssetName aName <*> decodeQuantity q) l

parseAssetName :: Aeson.Key -> Aeson.Parser AssetName
parseAssetName aName = runParsecParser assetName (Aeson.toText aName)
parseKeyAsAssetName :: Aeson.Key -> Aeson.Parser AssetName
parseKeyAsAssetName aName = runParsecParser parseAssetName (Aeson.toText aName)

decodeQuantity :: Aeson.Value -> Aeson.Parser Quantity
decodeQuantity (Aeson.Number sci) =
Expand Down
98 changes: 49 additions & 49 deletions cardano-api/internal/Cardano/Api/ValueParser.hs
Original file line number Diff line number Diff line change
Expand Up @@ -5,9 +5,9 @@ module Cardano.Api.ValueParser
, parseTxOutMultiAssetValue
, parseMintingMultiAssetValue
, parseUTxOValue
, assetName
, policyId
, ValueRole (..)
, parseAssetName
, parsePolicyId
, ParserValueRole (..)
)
where

Expand All @@ -32,7 +32,7 @@ import Text.Parsec.String (Parser)
import Text.ParserCombinators.Parsec.Combinator (many1)

-- | The role for which a 'Value' is being parsed.
data ValueRole
data ParserValueRole
= -- | The value is used as a UTxO or transaction output.
RoleUTxO
| -- | The value is used as a minting policy.
Expand All @@ -45,7 +45,7 @@ data ValueRole
-- Because we can't rule out the negation operator
-- for transaction outputs: some users have negative values in additions, with the addition's total
-- summing up to a positive value. So forbidding negations altogether is too restrictive.
parseValue :: ValueRole -> Parser Value
parseValue :: ParserValueRole -> Parser Value
parseValue role = do
valueExpr <- parseValueExpr
let value = evalValueExpr valueExpr
Expand Down Expand Up @@ -94,32 +94,32 @@ data ValueExpr

parseValueExpr :: Parser ValueExpr
parseValueExpr =
buildExpressionParser operatorTable valueExprTerm
buildExpressionParser operatorTable parseValueExprTerm
<?> "multi-asset value expression"
where
operatorTable =
[ [Prefix negateOp]
, [Infix plusOp AssocLeft]
[ [Prefix parseNegateOp]
, [Infix parsePlusOp AssocLeft]
]

-- | Parse either a 'ValueExprLovelace' or 'ValueExprMultiAsset'.
valueExprTerm :: Parser ValueExpr
valueExprTerm = do
q <- try quantity <?> "quantity (word64)"
aId <- try assetIdUnspecified <|> assetIdSpecified <?> "asset id"
parseValueExprTerm :: Parser ValueExpr
parseValueExprTerm = do
q <- try parseQuantity <?> "quantity (word64)"
aId <- try parseAssetIdUnspecified <|> parseAssetIdSpecified <?> "asset id"
_ <- spaces
pure $ case aId of
AdaAssetId -> ValueExprLovelace q
AssetId polId aName -> ValueExprMultiAsset polId aName q
where
-- Parse an asset ID which must be lead by one or more whitespace
-- characters and may be trailed by whitespace characters.
assetIdSpecified :: Parser AssetId
assetIdSpecified = some space *> assetId
parseAssetIdSpecified :: Parser AssetId
parseAssetIdSpecified = some space *> parseAssetId

-- Default for if an asset ID is not specified.
assetIdUnspecified :: Parser AssetId
assetIdUnspecified =
parseAssetIdUnspecified :: Parser AssetId
parseAssetIdUnspecified =
spaces
*> notFollowedBy alphaNum
$> AdaAssetId
Expand All @@ -128,43 +128,43 @@ valueExprTerm = do
-- Primitive parsers
------------------------------------------------------------------------------

plusOp :: Parser (ValueExpr -> ValueExpr -> ValueExpr)
plusOp = (char '+' *> spaces) $> ValueExprAdd
parsePlusOp :: Parser (ValueExpr -> ValueExpr -> ValueExpr)
parsePlusOp = (char '+' *> spaces) $> ValueExprAdd

negateOp :: Parser (ValueExpr -> ValueExpr)
negateOp = (char '-' *> spaces) $> ValueExprNegate
parseNegateOp :: Parser (ValueExpr -> ValueExpr)
parseNegateOp = (char '-' *> spaces) $> ValueExprNegate

-- | Period (\".\") parser.
period :: Parser ()
period = void $ char '.'
parsePeriod :: Parser ()
parsePeriod = void $ char '.'

-- | Word64 parser.
word64 :: Parser Integer
word64 = do
i <- decimal
parseWord64 :: Parser Integer
parseWord64 = do
i <- parseDecimal
if i > fromIntegral (maxBound :: Word64)
then
fail $
"expecting word64, but the number exceeds the max bound: " <> show i
else return i

decimal :: Parser Integer
decimal = do
parseDecimal :: Parser Integer
parseDecimal = do
digits <- many1 digit
return $! List.foldl' (\x d -> 10 * x + toInteger (Char.digitToInt d)) 0 digits

-- | Asset name parser.
assetName :: Parser AssetName
assetName = do
parseAssetName :: Parser AssetName
parseAssetName = do
hexText <- many hexDigit
failEitherWith
(\e -> "AssetName deserisalisation failed: " ++ displayError e)
$ deserialiseFromRawBytesHex AsAssetName
$ BSC.pack hexText

-- | Policy ID parser.
policyId :: Parser PolicyId
policyId = do
parsePolicyId :: Parser PolicyId
parsePolicyId = do
hexText <- many1 hexDigit
failEitherWith
( \e ->
Expand All @@ -183,34 +183,34 @@ policyId = do
. Text.pack

-- | Asset ID parser.
assetId :: Parser AssetId
assetId =
try adaAssetId
<|> nonAdaAssetId
parseAssetId :: Parser AssetId
parseAssetId =
try parseAdaAssetId
<|> parseNonAdaAssetId
<?> "asset ID"
where
-- Parse the ADA asset ID.
adaAssetId :: Parser AssetId
adaAssetId = string "lovelace" $> AdaAssetId
parseAdaAssetId :: Parser AssetId
parseAdaAssetId = string "lovelace" $> AdaAssetId

-- Parse a multi-asset ID.
nonAdaAssetId :: Parser AssetId
nonAdaAssetId = do
polId <- policyId
fullAssetId polId <|> assetIdNoAssetName polId
parseNonAdaAssetId :: Parser AssetId
parseNonAdaAssetId = do
polId <- parsePolicyId
parseFullAssetId polId <|> parseAssetIdNoAssetName polId

-- Parse a fully specified multi-asset ID with both a policy ID and asset
-- name.
fullAssetId :: PolicyId -> Parser AssetId
fullAssetId polId = do
_ <- period
aName <- assetName <?> "hexadecimal asset name"
parseFullAssetId :: PolicyId -> Parser AssetId
parseFullAssetId polId = do
_ <- parsePeriod
aName <- parseAssetName <?> "hexadecimal asset name"
pure (AssetId polId aName)

-- Parse a multi-asset ID that specifies a policy ID, but no asset name.
assetIdNoAssetName :: PolicyId -> Parser AssetId
assetIdNoAssetName polId = pure (AssetId polId "")
parseAssetIdNoAssetName :: PolicyId -> Parser AssetId
parseAssetIdNoAssetName polId = pure (AssetId polId "")

-- | Quantity (word64) parser. Only accepts positive quantities.
quantity :: Parser Quantity
quantity = fmap Quantity word64
parseQuantity :: Parser Quantity
parseQuantity = fmap Quantity parseWord64
8 changes: 6 additions & 2 deletions cardano-api/src/Cardano/Api.hs
Original file line number Diff line number Diff line change
Expand Up @@ -232,9 +232,13 @@ module Cardano.Api
, AssetName (..)
, AssetId (..)
, Value
, ValueRole (..)
, ParserValueRole (..)
, parseValue
, policyId
, parsePolicyId
, parseAssetName
, parseTxOutMultiAssetValue
, parseMintingMultiAssetValue
, parseUTxOValue
, selectAsset
, valueFromList
, valueToList
Expand Down
Loading