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

Remove renderEra. Rename prettyTo* to docTo* functions #387

Merged
merged 1 commit into from
Nov 28, 2023
Merged
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
4 changes: 2 additions & 2 deletions cardano-api/gen/Test/Gen/Cardano/Api/Typed.hs
Original file line number Diff line number Diff line change
Expand Up @@ -451,7 +451,7 @@ genOperationalCertificateWithCounter = do
case issueOperationalCertificate kesVKey stkPoolOrGenDelExtSign kesP iCounter of
-- This case should be impossible as we clearly derive the verification
-- key from the generated signing key.
Left err -> fail $ prettyToString $ prettyError err
Left err -> fail $ docToString $ prettyError err
Right pair -> return pair
where
convert :: VerificationKey GenesisDelegateExtendedKey
Expand Down Expand Up @@ -750,7 +750,7 @@ genTxBody :: ShelleyBasedEra era -> Gen (TxBody era)
genTxBody era = do
res <- Api.createAndValidateTransactionBody era <$> genTxBodyContent era
case res of
Left err -> fail (prettyToString (prettyError err))
Left err -> fail (docToString (prettyError err))
Right txBody -> pure txBody

-- | Generate a 'Featured' for the given 'CardanoEra' with the provided generator.
Expand Down
2 changes: 1 addition & 1 deletion cardano-api/gen/Test/Hedgehog/Golden/ErrorMessage.hs
Original file line number Diff line number Diff line change
Expand Up @@ -78,4 +78,4 @@ testErrorMessage_ goldenFilesLocation moduleName typeName constructorName err =
let fqtn = moduleName <> "." <> typeName
testProperty constructorName . withTests 1 . property $ do
H.note_ "Incorrect error message in golden file"
H.diffVsGoldenFile (prettyToString (prettyError err)) (goldenFilesLocation </> fqtn </> constructorName <> ".txt")
H.diffVsGoldenFile (docToString (prettyError err)) (goldenFilesLocation </> fqtn </> constructorName <> ".txt")
57 changes: 37 additions & 20 deletions cardano-api/internal/Cardano/Api/Eras/Core.hs
Original file line number Diff line number Diff line change
Expand Up @@ -57,6 +57,7 @@ import qualified Cardano.Ledger.Api as L
import Data.Aeson (FromJSON (..), ToJSON, toJSON, withText)
import Data.Kind
import Data.Maybe (isJust)
import Data.String (IsString)
import qualified Data.Text as Text
import Data.Type.Equality (TestEquality (..), (:~:) (Refl))
import Data.Typeable (Typeable, showsTypeRep, typeOf)
Expand Down Expand Up @@ -177,8 +178,8 @@ monoidForEraInEon :: ()
monoidForEraInEon sbe = forEraInEon sbe mempty

monoidForEraInEonA :: ()
=> Applicative f
=> Eon eon
=> Applicative f
=> Monoid a
=> CardanoEra era
-> (eon era -> f a)
Expand Down Expand Up @@ -242,16 +243,11 @@ deriving instance Eq (CardanoEra era)
deriving instance Ord (CardanoEra era)
deriving instance Show (CardanoEra era)

deriving via (ShowOf (CardanoEra era)) instance Pretty (CardanoEra era)
instance Pretty (CardanoEra era) where
Copy link
Contributor Author

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

Now Pretty instance does not print Era suffix which makes it suitable to use in console logging and error messages building.

pretty = cardanoEraToStringLike

instance ToJSON (CardanoEra era) where
toJSON ByronEra = "Byron"
toJSON ShelleyEra = "Shelley"
toJSON AllegraEra = "Allegra"
toJSON MaryEra = "Mary"
toJSON AlonzoEra = "Alonzo"
toJSON BabbageEra = "Babbage"
toJSON ConwayEra = "Conway"
toJSON = cardanoEraToStringLike

instance TestEquality CardanoEra where
testEquality ByronEra ByronEra = Just Refl
Expand Down Expand Up @@ -323,6 +319,9 @@ data AnyCardanoEra where

deriving instance Show AnyCardanoEra

instance Pretty AnyCardanoEra where
pretty (AnyCardanoEra e) = pretty e

-- | Assumes that 'CardanoEra era' are singletons
instance Eq AnyCardanoEra where
AnyCardanoEra era == AnyCardanoEra era' =
Expand Down Expand Up @@ -363,17 +362,35 @@ instance ToJSON AnyCardanoEra where
toJSON (AnyCardanoEra era) = toJSON era

instance FromJSON AnyCardanoEra where
parseJSON = withText "AnyCardanoEra"
$ \case
"Byron" -> pure $ AnyCardanoEra ByronEra
"Shelley" -> pure $ AnyCardanoEra ShelleyEra
"Allegra" -> pure $ AnyCardanoEra AllegraEra
"Mary" -> pure $ AnyCardanoEra MaryEra
"Alonzo" -> pure $ AnyCardanoEra AlonzoEra
"Babbage" -> pure $ AnyCardanoEra BabbageEra
"Conway" -> pure $ AnyCardanoEra ConwayEra
wrong -> fail $ "Failed to parse unknown era: " <> Text.unpack wrong

parseJSON = withText "AnyCardanoEra"
$ (\case
Right era -> pure era
Left era -> fail $ "Failed to parse unknown era: " <> Text.unpack era
) . anyCardanoEraFromStringLike


cardanoEraToStringLike :: IsString a => CardanoEra era -> a
{-# INLINE cardanoEraToStringLike #-}
cardanoEraToStringLike = \case
ByronEra -> "Byron"
ShelleyEra -> "Shelley"
AllegraEra -> "Allegra"
MaryEra -> "Mary"
AlonzoEra -> "Alonzo"
BabbageEra -> "Babbage"
ConwayEra -> "Conway"

anyCardanoEraFromStringLike :: (IsString a, Eq a) => a -> Either a AnyCardanoEra
{-# INLINE anyCardanoEraFromStringLike #-}
anyCardanoEraFromStringLike = \case
"Byron" -> pure $ AnyCardanoEra ByronEra
"Shelley" -> pure $ AnyCardanoEra ShelleyEra
"Allegra" -> pure $ AnyCardanoEra AllegraEra
"Mary" -> pure $ AnyCardanoEra MaryEra
"Alonzo" -> pure $ AnyCardanoEra AlonzoEra
"Babbage" -> pure $ AnyCardanoEra BabbageEra
"Conway" -> pure $ AnyCardanoEra ConwayEra
wrong -> Left wrong

-- | Like the 'AnyCardanoEra' constructor but does not demand a 'IsCardanoEra'
-- class constraint.
Expand Down
6 changes: 3 additions & 3 deletions cardano-api/internal/Cardano/Api/Error.hs
Original file line number Diff line number Diff line change
Expand Up @@ -47,14 +47,14 @@ instance Error ErrorAsException where

instance Show ErrorAsException where
show (ErrorAsException e) =
prettyToString $ prettyError e
docToString $ prettyError e

instance Exception ErrorAsException where
displayException (ErrorAsException e) =
prettyToString $ prettyError e
docToString $ prettyError e

displayError :: Error a => a -> String
displayError = prettyToString . prettyError
displayError = docToString . prettyError

data FileError e = FileError FilePath e
| FileErrorTempFile
Expand Down
4 changes: 2 additions & 2 deletions cardano-api/internal/Cardano/Api/Keys/Shelley.hs
Original file line number Diff line number Diff line change
Expand Up @@ -1469,7 +1469,7 @@ instance FromJSON (Hash StakePoolKey) where
parseJSON = withText "PoolId" $ \str ->
case deserialiseFromBech32 (AsHash AsStakePoolKey) str of
Left err ->
fail $ prettyToString $ mconcat
fail $ docToString $ mconcat
[ "Error deserialising Hash StakePoolKey: " <> pretty str
, " Error: " <> prettyError err
]
Expand Down Expand Up @@ -1590,7 +1590,7 @@ instance FromJSON (Hash DRepKey) where
parseJSON = withText "DRepId" $ \str ->
case deserialiseFromBech32 (AsHash AsDRepKey) str of
Left err ->
fail $ prettyToString $ mconcat
fail $ docToString $ mconcat
[ "Error deserialising Hash DRepKey: " <> pretty str
, " Error: " <> prettyError err
]
Expand Down
20 changes: 10 additions & 10 deletions cardano-api/internal/Cardano/Api/Pretty.hs
Original file line number Diff line number Diff line change
Expand Up @@ -4,9 +4,9 @@ module Cardano.Api.Pretty
, Pretty(..)
, ShowOf(..)
, viaShow
, prettyToLazyText
, prettyToText
, prettyToString
, docToLazyText
, docToText
, docToString
, pshow

, black
Expand All @@ -30,14 +30,14 @@ import Prettyprinter.Render.Terminal
-- of colored output. This is a type alias for AnsiStyle.
type Ann = AnsiStyle

prettyToString :: Doc AnsiStyle -> String
prettyToString = show
docToString :: Doc AnsiStyle -> String
Copy link
Contributor Author

@carbolymer carbolymer Nov 27, 2023

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

Those functions weren't accepting Pretty a => a but Doc so their names were misleading and it was resulting in oddities like: prettyToString . pretty

docToString = show

prettyToLazyText :: Doc AnsiStyle -> TextLazy.Text
prettyToLazyText = renderLazy . layoutPretty defaultLayoutOptions
docToLazyText :: Doc AnsiStyle -> TextLazy.Text
docToLazyText = renderLazy . layoutPretty defaultLayoutOptions

prettyToText :: Doc AnsiStyle -> Text.Text
prettyToText = TextLazy.toStrict . prettyToLazyText
docToText :: Doc AnsiStyle -> Text.Text
docToText = TextLazy.toStrict . docToLazyText

black :: Doc AnsiStyle -> Doc AnsiStyle
black = annotate (color Black)
Expand All @@ -64,4 +64,4 @@ white :: Doc AnsiStyle -> Doc AnsiStyle
white = annotate (color White)

pshow :: Show a => a -> Doc ann
pshow = pretty . show
pshow = viaShow
4 changes: 2 additions & 2 deletions cardano-api/internal/Cardano/Api/SerialiseUsing.hs
Original file line number Diff line number Diff line change
Expand Up @@ -112,7 +112,7 @@ instance SerialiseAsBech32 a => IsString (UsingBech32 a) where
case deserialiseFromBech32 ttoken (Text.pack str) of
Right x -> UsingBech32 x
Left e ->
error $ prettyToString $
error $ docToString $
"fromString: " <> pretty str <> ": " <> prettyError e
where
ttoken :: AsType a
Expand All @@ -126,7 +126,7 @@ instance SerialiseAsBech32 a => FromJSON (UsingBech32 a) where
Aeson.withText tname $ \str ->
case deserialiseFromBech32 ttoken str of
Right x -> return (UsingBech32 x)
Left e -> fail $ prettyToString $ pretty str <> ": " <> prettyError e
Left e -> fail $ docToString $ pretty str <> ": " <> prettyError e
where
ttoken = proxyToAsType (Proxy :: Proxy a)
tname = (tyConName . typeRepTyCon . typeRep) (Proxy :: Proxy a)
Expand Down
2 changes: 1 addition & 1 deletion cardano-api/internal/Cardano/Api/TxIn.hs
Original file line number Diff line number Diff line change
Expand Up @@ -130,7 +130,7 @@ parseTxId :: Parsec.Parser TxId
parseTxId = do
str <- some Parsec.hexDigit <?> "transaction id (hexadecimal)"
failEitherWith
(\e -> prettyToString $ "Incorrect transaction id format: " <> prettyError e)
(\e -> docToString $ "Incorrect transaction id format: " <> prettyError e)
(deserialiseFromRawBytesHex AsTxId $ BSC.pack str)

parseTxIn :: Parsec.Parser TxIn
Expand Down
12 changes: 0 additions & 12 deletions cardano-api/internal/Cardano/Api/Utils.hs
Original file line number Diff line number Diff line change
Expand Up @@ -22,7 +22,6 @@ module Cardano.Api.Utils
, note
, parseFilePath
, readFileBlocking
, renderEra
, runParsecParser
, textShow
, modifyWith
Expand All @@ -31,8 +30,6 @@ module Cardano.Api.Utils
, bounded
) where

import Cardano.Api.Eras

import Cardano.Ledger.Shelley ()

import Control.Exception (bracket)
Expand Down Expand Up @@ -118,15 +115,6 @@ readFileBlocking path = bracket
textShow :: Show a => a -> Text
textShow = Text.pack . show

renderEra :: AnyCardanoEra -> Text
renderEra (AnyCardanoEra ByronEra) = "Byron"
renderEra (AnyCardanoEra ShelleyEra) = "Shelley"
renderEra (AnyCardanoEra AllegraEra) = "Allegra"
renderEra (AnyCardanoEra MaryEra) = "Mary"
renderEra (AnyCardanoEra AlonzoEra) = "Alonzo"
renderEra (AnyCardanoEra BabbageEra) = "Babbage"
renderEra (AnyCardanoEra ConwayEra) = "Conway"

bounded :: forall a. (Bounded a, Integral a, Show a) => String -> ReadM a
bounded t = eitherReader $ \s -> do
i <- Read.readEither @Integer s
Expand Down
1 change: 0 additions & 1 deletion cardano-api/src/Cardano/Api.hs
Original file line number Diff line number Diff line change
Expand Up @@ -927,7 +927,6 @@ module Cardano.Api (
-- ** Misc
ScriptLockedTxInsError(..),
TxInsExistError(..),
renderEra,
renderNotScriptLockedTxInsError,
renderTxInsExistError,
txInsExistInUTxO,
Expand Down
Original file line number Diff line number Diff line change
@@ -1 +1 @@
The ConwayEra protocol parameters value is missing the following field: MinUTxoValue. Did you intend to use a ConwayEra protocol parameters value?
The Conway protocol parameters value is missing the following field: MinUTxoValue. Did you intend to use a Conway protocol parameters value?
2 changes: 1 addition & 1 deletion cardano-api/test/cardano-api-test/Test/Cardano/Api/IO.hs
Original file line number Diff line number Diff line change
Expand Up @@ -26,7 +26,7 @@ prop_createVrfFileWithOwnerPermissions =
result <- liftIO $ writeLazyByteStringFileWithOwnerPermissions (File file) ""

case result of
Left err -> failWith Nothing $ prettyToString $ prettyError @(FileError ()) err
Left err -> failWith Nothing $ docToString $ prettyError @(FileError ()) err
Right () -> return ()

fResult <- liftIO . runExceptT $ checkVrfFilePermissions (File file)
Expand Down