Merge pull request #370 from input-output-hk/newhoggy/prettyprinter

Use `Pretty` for rendering errors instead of `Show`

cardano-api/cardano-api.cabal

@@ -105,6 +105,7 @@ library internal
                         Cardano.Api.Modes
                         Cardano.Api.NetworkId
                         Cardano.Api.OperationalCertificate
+                        Cardano.Api.Pretty
                         Cardano.Api.Protocol
                         Cardano.Api.ProtocolParameters
                         Cardano.Api.Query
@@ -187,6 +188,7 @@ library internal
                       , parsec
                       , plutus-ledger-api:{plutus-ledger-api, plutus-ledger-api-testlib} ^>= 1.15
                       , prettyprinter
+                      , prettyprinter-ansi-terminal
                       , prettyprinter-configurable ^>= 1.15
                       , random
                       , scientific
@@ -224,6 +226,7 @@ library
                         Cardano.Api.Ledger
 
   reexported-modules:   Cardano.Api.Ledger.Lens
+                      , Cardano.Api.Pretty
 
   build-depends:        bytestring
                       , cardano-api:internal

cardano-api/gen/Test/Gen/Cardano/Api/Typed.hs

@@ -137,6 +137,7 @@ import qualified Cardano.Api as Api
 import           Cardano.Api.Byron (KeyWitness (ByronKeyWitness),
                    WitnessNetworkIdOrByronAddress (..))
 import           Cardano.Api.Eon.AllegraEraOnwards (allegraEraOnwardsToShelleyBasedEra)
+import           Cardano.Api.Pretty
 import qualified Cardano.Api.Ledger as L
 import qualified Cardano.Api.Ledger.Lens as A
 import           Cardano.Api.Script (scriptInEraToRefScript)
@@ -449,7 +450,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 $ displayError err
+      Left err -> fail $ prettyToString $ prettyError err
       Right pair -> return pair
   where
     convert :: VerificationKey GenesisDelegateExtendedKey
@@ -741,7 +742,7 @@ genTxBodyByron = do
                              , Api.txOuts
                              }
   case Api.createAndValidateTransactionBody ByronEra byronTxBodyContent of
-    Left err -> fail (displayError err)
+    Left err -> fail $ prettyToString $ prettyError err
     Right txBody -> pure txBody
 
 genWitnessesByron :: Gen [KeyWitness ByronEra]
@@ -751,7 +752,7 @@ genTxBody :: ShelleyBasedEra era -> Gen (TxBody era)
 genTxBody era = do
   res <- Api.createAndValidateTransactionBody (toCardanoEra era) <$> genTxBodyContent era
   case res of
-    Left err -> fail (displayError err)
+    Left err -> fail (prettyToString (prettyError err))
     Right txBody -> pure txBody
 
 -- | Generate a 'Featured' for the given 'CardanoEra' with the provided generator.

cardano-api/gen/Test/Hedgehog/Golden/ErrorMessage.hs

@@ -2,6 +2,7 @@
 module Test.Hedgehog.Golden.ErrorMessage where
 
 import           Cardano.Api (Error (..))
+import           Cardano.Api.Pretty
 
 import           Data.Data
 import           GHC.Stack (HasCallStack, withFrozenCallStack)
@@ -77,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"
-    displayError err `H.diffVsGoldenFile` (goldenFilesLocation </> fqtn </> constructorName <> ".txt")
+    H.diffVsGoldenFile (prettyToString (prettyError err)) (goldenFilesLocation </> fqtn </> constructorName <> ".txt")

cardano-api/internal/Cardano/Api/DRepMetadata.hs

@@ -31,6 +31,7 @@ import qualified Cardano.Ledger.Keys as Shelley
 import           Data.ByteString (ByteString)
 import qualified Data.ByteString as BS
 import           Data.Either.Combinators (maybeToRight)
+import           Prettyprinter
 
 -- ----------------------------------------------------------------------------
 -- DRep metadata
@@ -68,13 +69,13 @@ data DRepMetadataValidationError
   deriving Show
 
 instance Error DRepMetadataValidationError where
-  displayError = \case
+  prettyError = \case
     DRepMetadataInvalidLengthError maxLen actualLen ->
       mconcat
         [ "DRep metadata must consist of at most "
-        , show maxLen
+        , pretty maxLen
         , " bytes, but it consists of "
-        , show actualLen
+        , pretty actualLen
         , " bytes."
         ]
 

cardano-api/internal/Cardano/Api/DeserialiseAnyOf.hs

@@ -44,9 +44,9 @@ import           Data.Data (Data)
 import           Data.List.NonEmpty (NonEmpty)
 import qualified Data.List.NonEmpty as NE
 import           Data.Text (Text)
-import qualified Data.Text as Text
 import qualified Data.Text.Encoding as Text
 import           Formatting (build, sformat, (%))
+import           Prettyprinter
 
 ------------------------------------------------------------------------------
 -- Formatted/encoded input deserialisation
@@ -78,18 +78,19 @@ data InputDecodeError
   -- ^ The provided data does not represent a valid value of the provided
   -- type.
   deriving (Eq, Show, Data)
+
 instance Error InputDecodeError where
-  displayError = Text.unpack . renderInputDecodeError
+  prettyError = renderInputDecodeError
 
 -- | Render an error message for a 'InputDecodeError'.
-renderInputDecodeError :: InputDecodeError -> Text
-renderInputDecodeError err =
-  case err of
-    InputTextEnvelopeError textEnvErr ->
-      Text.pack (displayError textEnvErr)
-    InputBech32DecodeError decodeErr ->
-      Text.pack (displayError decodeErr)
-    InputInvalidError -> "Invalid key."
+renderInputDecodeError :: InputDecodeError -> Doc ann
+renderInputDecodeError = \case
+  InputTextEnvelopeError textEnvErr ->
+    prettyError textEnvErr
+  InputBech32DecodeError decodeErr ->
+    prettyError decodeErr
+  InputInvalidError ->
+    "Invalid key."
 
 -- | The result of a deserialisation function.
 --

cardano-api/internal/Cardano/Api/Eras/Core.hs

@@ -1,5 +1,6 @@
 {-# LANGUAGE ConstraintKinds #-}
 {-# LANGUAGE DataKinds #-}
+{-# LANGUAGE DerivingVia #-}
 {-# LANGUAGE FlexibleContexts #-}
 {-# LANGUAGE GADTs #-}
 {-# LANGUAGE LambdaCase #-}
@@ -49,6 +50,7 @@ module Cardano.Api.Eras.Core
   ) where
 
 import           Cardano.Api.HasTypeProxy
+import           Cardano.Api.Pretty
 
 import qualified Cardano.Ledger.Api as L
 
@@ -236,9 +238,11 @@ data CardanoEra era where
      ConwayEra  :: CardanoEra ConwayEra
      -- when you add era here, change `instance Bounded AnyCardanoEra`
 
-deriving instance Eq   (CardanoEra era)
-deriving instance Ord  (CardanoEra era)
-deriving instance Show (CardanoEra era)
+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 ToJSON (CardanoEra era) where
    toJSON ByronEra   = "Byron"

cardano-api/internal/Cardano/Api/Error.hs

@@ -1,6 +1,8 @@
 {-# LANGUAGE DeriveFunctor #-}
 {-# LANGUAGE ExistentialQuantification #-}
 {-# LANGUAGE GADTSyntax #-}
+{-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE OverloadedStrings #-}
 
 -- | Class of errors used in the Api.
 --
@@ -10,23 +12,25 @@ module Cardano.Api.Error
   , ErrorAsException(..)
   , FileError(..)
   , fileIOExceptT
+  , displayError
   ) where
 
+import           Cardano.Api.Pretty
+
 import           Control.Exception (Exception (..), IOException, throwIO)
 import           Control.Monad.Except (throwError)
 import           Control.Monad.IO.Class (MonadIO)
 import           Control.Monad.Trans.Except (ExceptT)
 import           Control.Monad.Trans.Except.Extra (handleIOExceptT)
+import           Prettyprinter
 import           System.Directory (doesFileExist)
 import           System.IO (Handle)
 
-class Show e => Error e where
-
-    displayError :: e -> String
+class Error e where
+  prettyError :: e -> Doc ann
 
 instance Error () where
-    displayError () = ""
-
+  prettyError () = ""
 
 -- | The preferred approach is to use 'Except' or 'ExceptT', but you can if
 -- necessary use IO exceptions.
@@ -35,14 +39,22 @@ throwErrorAsException :: Error e => e -> IO a
 throwErrorAsException e = throwIO (ErrorAsException e)
 
 data ErrorAsException where
-     ErrorAsException :: Error e => e -> ErrorAsException
+  ErrorAsException :: Error e => e -> ErrorAsException
+
+instance Error ErrorAsException where
+  prettyError (ErrorAsException e) =
+    prettyError e
 
 instance Show ErrorAsException where
-    show (ErrorAsException e) = show e
+  show (ErrorAsException e) =
+    prettyToString $ prettyError e
 
 instance Exception ErrorAsException where
-    displayException (ErrorAsException e) = displayError e
+  displayException (ErrorAsException e) =
+    prettyToString $ prettyError e
 
+displayError :: Error a => a -> String
+displayError = prettyToString . prettyError
 
 data FileError e = FileError FilePath e
                  | FileErrorTempFile
@@ -55,20 +67,23 @@ data FileError e = FileError FilePath e
                  | FileIOError FilePath IOException
   deriving (Show, Eq, Functor)
 
-instance Error e => Error (FileError e) where
-  displayError (FileErrorTempFile targetPath tempPath h)=
-    "Error creating temporary file at: " ++ tempPath ++
-    "/n" ++ "Target path: " ++ targetPath ++
-    "/n" ++ "Handle: " ++ show h
-  displayError (FileDoesNotExistError path) =
-    "Error file not found at: " ++ path
-  displayError (FileIOError path ioe) =
-    path ++ ": " ++ displayException ioe
-  displayError (FileError path e) =
-    path ++ ": " ++ displayError e
+instance Error e => Pretty (FileError e) where
+  pretty = \case
+    FileErrorTempFile targetPath tempPath h ->
+      vsep
+        [ "Error creating temporary file at: " <> pretty tempPath
+        , "Target path: " <> pretty targetPath
+        , "Handle: " <> pshow h
+        ]
+    FileDoesNotExistError path ->
+      "Error file not found at: " <> pretty path
+    FileIOError path ioe ->
+      pretty path <> ": " <> pretty (displayException ioe)
+    FileError path e ->
+      pretty path <> ": " <> prettyError e
 
 instance Error IOException where
-  displayError = show
+  prettyError = pretty . show
 
 fileIOExceptT :: MonadIO m
               => FilePath