From 84a97384edb46acc8a79b44820610ac59f39f190 Mon Sep 17 00:00:00 2001 From: Erik de Castro Lopo Date: Tue, 14 May 2024 16:40:33 +1000 Subject: [PATCH] Fixes for cardano-ledger --- .../src/Test/Cardano/Prelude/Golden.hs | 8 ++-- .../src/Test/Cardano/Prelude/Helpers.hs | 8 ++-- .../Cardano/Prelude/QuickCheck/Property.hs | 14 +++---- .../src/Test/Cardano/Prelude/Tripping.hs | 8 ++-- .../Test/Cardano/Prelude/GHC/Heap/SizeSpec.hs | 2 +- cardano-prelude/src/Cardano/Prelude/Base.hs | 40 ++++++++++++++----- .../src/Cardano/Prelude/GHC/Heap/Tree.hs | 2 +- .../src/Cardano/Prelude/Json/Canonical.hs | 8 ++-- .../src/Cardano/Prelude/Json/Parse.hs | 2 +- 9 files changed, 55 insertions(+), 37 deletions(-) diff --git a/cardano-prelude-test/src/Test/Cardano/Prelude/Golden.hs b/cardano-prelude-test/src/Test/Cardano/Prelude/Golden.hs index a48ec089..17e648b9 100644 --- a/cardano-prelude-test/src/Test/Cardano/Prelude/Golden.hs +++ b/cardano-prelude-test/src/Test/Cardano/Prelude/Golden.hs @@ -74,7 +74,7 @@ goldenTestCanonicalJSONDec x path = withFrozenCallStack $ do withTests 1 . property $ do bs <- liftIO (LB.readFile path) case Canonical.parseCanonicalJSON bs of - Left err -> failWith Nothing $ "could not parse: " <> show err + Left err -> failWith Nothing $ "could not parse: " <> Prelude.show err Right jsv -> case Canonical.fromJSON jsv of Left (schErr :: SchemaError) -> failWith Nothing $ LT.unpack $ toLazyText $ build schErr @@ -86,7 +86,7 @@ goldenTestJSONDec :: goldenTestJSONDec x path = withFrozenCallStack $ withTests 1 . property $ do bs <- liftIO (LB.readFile path) case eitherDecode bs of - Left err -> failWith Nothing $ "could not decode: " <> show err + Left err -> failWith Nothing $ "could not decode: " <> Prelude.show err Right x' -> x === x' goldenTestJSON :: @@ -98,7 +98,7 @@ goldenTestJSON x path = withFrozenCallStack $ withTests 1 . property $ do bs <- liftIO (LB.readFile path) encode x === bs case eitherDecode bs of - Left err -> failWith Nothing $ "could not decode: " <> show err + Left err -> failWith Nothing $ "could not decode: " <> Prelude.show err Right x' -> x === x' goldenTestJSONPretty :: @@ -125,7 +125,7 @@ goldenTestJSONPretty x path = } encodePretty' defConfig' x === bs case eitherDecode bs of - Left err -> failWith Nothing $ "could not decode: " <> show err + Left err -> failWith Nothing $ "could not decode: " <> Prelude.show err Right x' -> x === x' -- | Text used for example values in a number of golden tests diff --git a/cardano-prelude-test/src/Test/Cardano/Prelude/Helpers.hs b/cardano-prelude-test/src/Test/Cardano/Prelude/Helpers.hs index 6fb24a14..d602176d 100644 --- a/cardano-prelude-test/src/Test/Cardano/Prelude/Helpers.hs +++ b/cardano-prelude-test/src/Test/Cardano/Prelude/Helpers.hs @@ -25,11 +25,11 @@ assertIsLeftConstr :: assertIsLeftConstr expectedFailure = \case Left failure -> toConstr failure === expectedFailure Right res -> - withFrozenCallStack $ failWith Nothing (show $ sformat build res) + withFrozenCallStack $ failWith Nothing (Prelude.show $ sformat build res) assertIsRight :: (Buildable a, HasCallStack, MonadTest m) => Either a b -> m () assertIsRight = \case - Left err -> withFrozenCallStack $ failWith Nothing (show $ sformat build err) + Left err -> withFrozenCallStack $ failWith Nothing (Prelude.show $ sformat build err) Right _ -> success assertIsJust :: (HasCallStack, MonadTest m) => Maybe a -> m () @@ -40,7 +40,7 @@ assertIsJust = \case assertIsNothing :: (Buildable a, HasCallStack, MonadTest m) => Maybe a -> m () assertIsNothing = \case Nothing -> success - Just res -> withFrozenCallStack $ failWith Nothing (show $ sformat build res) + Just res -> withFrozenCallStack $ failWith Nothing (Prelude.show $ sformat build res) compareValueRight :: (Buildable a, Eq b, HasCallStack, MonadTest m, Show b) => @@ -48,5 +48,5 @@ compareValueRight :: Either a b -> m () compareValueRight iVal eith = case eith of - Left err -> withFrozenCallStack $ failWith Nothing (show $ sformat build err) + Left err -> withFrozenCallStack $ failWith Nothing (Prelude.show $ sformat build err) Right fVal -> iVal === fVal diff --git a/cardano-prelude-test/src/Test/Cardano/Prelude/QuickCheck/Property.hs b/cardano-prelude-test/src/Test/Cardano/Prelude/QuickCheck/Property.hs index f46224b6..f0db7fed 100644 --- a/cardano-prelude-test/src/Test/Cardano/Prelude/QuickCheck/Property.hs +++ b/cardano-prelude-test/src/Test/Cardano/Prelude/QuickCheck/Property.hs @@ -64,25 +64,25 @@ qcIsJust Nothing = qcFail "expected Just, got Nothing" qcIsNothing :: Show a => Maybe a -> Property qcIsNothing Nothing = property True -qcIsNothing (Just x) = qcFail ("expected Nothing, got Just (" <> Text.pack (show x) <> ")") +qcIsNothing (Just x) = qcFail ("expected Nothing, got Just (" <> Text.pack (Prelude.show x) <> ")") qcIsLeft :: Show b => Either a b -> Property qcIsLeft (Left _) = property True -qcIsLeft (Right x) = qcFail ("expected Left, got Right (" <> Text.pack (show x) <> ")") +qcIsLeft (Right x) = qcFail ("expected Left, got Right (" <> Text.pack (Prelude.show x) <> ")") qcIsRight :: Show a => Either a b -> Property qcIsRight (Right _) = property True -qcIsRight (Left x) = qcFail ("expected Right, got Left (" <> Text.pack (show x) <> ")") +qcIsRight (Left x) = qcFail ("expected Right, got Left (" <> Text.pack (Prelude.show x) <> ")") qcElem :: (Show a, Eq a, Show (t a), Foldable t) => a -> t a -> Property qcElem x xs = - counterexample ("expected " <> show x <> " to be in " <> show xs) $ + counterexample ("expected " <> Prelude.show x <> " to be in " <> Prelude.show xs) $ x `elem` xs qcNotElem :: (Show a, Eq a, Show (t a), Foldable t) => a -> t a -> Property qcNotElem x xs = - counterexample ("expected " <> show x <> " not to be in " <> show xs) $ + counterexample ("expected " <> Prelude.show x <> " not to be in " <> Prelude.show xs) $ x `notElem` xs @@ -144,9 +144,9 @@ splitWord total parts | total < parts = error $ "splitWord: can't split " - <> show total + <> Prelude.show total <> " into " - <> show parts + <> Prelude.show parts <> " parts." | otherwise = map succ diff --git a/cardano-prelude-test/src/Test/Cardano/Prelude/Tripping.hs b/cardano-prelude-test/src/Test/Cardano/Prelude/Tripping.hs index 20a8d6e5..3f12d815 100644 --- a/cardano-prelude-test/src/Test/Cardano/Prelude/Tripping.hs +++ b/cardano-prelude-test/src/Test/Cardano/Prelude/Tripping.hs @@ -168,17 +168,17 @@ trippingBuildable x enc dec = failWith Nothing $ Data.String.unlines [ "━━━ Original ━━━" - , show $ buildValue mx + , Prelude.show $ buildValue mx , "━━━ Intermediate ━━━" - , show i + , Prelude.show i , "━━━ Roundtrip ━━━" - , show $ buildValue my + , Prelude.show $ buildValue my ] Just dif -> withFrozenCallStack $ failWith (Just $ Diff "━━━ " "- Original" "/" "+ Roundtrip" " ━━━" dif) - $ Data.String.unlines ["━━━ Intermediate ━━━", show i] + $ Data.String.unlines ["━━━ Intermediate ━━━", Prelude.show i] instance (Buildable e, Buildable a) => Buildable (Either e a) where build (Left e) = build e diff --git a/cardano-prelude-test/test/Test/Cardano/Prelude/GHC/Heap/SizeSpec.hs b/cardano-prelude-test/test/Test/Cardano/Prelude/GHC/Heap/SizeSpec.hs index 1692eeab..cd0e0eda 100644 --- a/cardano-prelude-test/test/Test/Cardano/Prelude/GHC/Heap/SizeSpec.hs +++ b/cardano-prelude-test/test/Test/Cardano/Prelude/GHC/Heap/SizeSpec.hs @@ -94,7 +94,7 @@ bsSize numElems = NumWords (5 + 2 + 2 + numElems `divRoundUp` wordSize) verifySize :: NumWords -> a -> Property verifySize (NumWords expected) !x = withTests 1 $ property $ do - annotate (show wordSize) + annotate (Prelude.show wordSize) sz <- liftIO $ computeHeapSize x sz === Right expected diff --git a/cardano-prelude/src/Cardano/Prelude/Base.hs b/cardano-prelude/src/Cardano/Prelude/Base.hs index b5716c5b..64105eb0 100644 --- a/cardano-prelude/src/Cardano/Prelude/Base.hs +++ b/cardano-prelude/src/Cardano/Prelude/Base.hs @@ -2,19 +2,19 @@ {-# LANGUAGE ExplicitNamespaces #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE ImportQualifiedPost #-} +{-# LANGUAGE NoImplicitPrelude #-} {-# LANGUAGE RankNTypes #-} {-# LANGUAGE Safe #-} module Cardano.Prelude.Base ( module X, HasLength (..), + LByteString, identity, + length, + panic, putTextLn, scanl', - Cardano.Prelude.Base.length, -#if __GLASGOW_HASKELL__ >= 906 - type (~) -#endif ) where @@ -28,33 +28,48 @@ import Control.Category qualified as Category import Control.Category as X hiding (id) import Numeric.Natural as X -import Control.Applicative as X (many) +import Control.Applicative as X (Applicative (..), many) import Control.Concurrent.MVar as X (MVar, newMVar) import Control.DeepSeq as X (NFData (..), ($!!), force) import Control.Exception as X (Exception, bracket) -import Control.Monad as X (liftM, unless) +import Control.Monad as X (Monad, (=<<), (>>=), liftM, return, unless) import Control.Monad.Except as X (MonadError, throwError) import Control.Monad.IO.Class as X (MonadIO (..)) import Data.ByteString as X (ByteString) import Data.Bifunctor as X (first) +import Data.Either as X (Either (..)) +import Data.Foldable as X (Foldable) +import Data.Functor as X (Functor (..), (<$>)) import Data.Functor.Identity as X (Identity, runIdentity) -import Data.Int as X (Int8, Int16, Int32, Int64) +import Data.Int as X (Int, Int8, Int16, Int32, Int64) +import Data.Kind as X (Type) import Data.Ord as X (Ord (..), comparing) import Data.List as X (sortBy) import Data.List.NonEmpty as X (NonEmpty (..), nonEmpty) -import Data.Maybe as X (catMaybes) +import Data.Maybe as X (Maybe (..), catMaybes) +import Data.Monoid as X (Monoid (..)) import Data.Proxy as X (Proxy (..)) import Data.Ratio as X ((%), denominator, numerator) import Data.Semigroup as X (Semigroup (..), Any, diff) import Data.Typeable as X (Typeable, typeRep) -import Data.Word as X (Word8, Word16, Word32, Word64) +import Data.Word as X (Word, Word8, Word16, Word32, Word64) import Foreign.Ptr as X (Ptr) import GHC.Generics as X (Generic) import GHC.Stack as X +import Prelude as X (Eq (..), Integer, Num (..), Read, String, Show (..), type (~), + ($), (++), (||), (*), + fromIntegral, fst, otherwise, rem, snd) import System.Exit as X -import System.IO as X (Handle, stderr, stdout) +import System.IO as X (Handle, IO, stderr, stdout) import Text.Read as X (readEither) +-- Need to import this qualifed so we can redefine `length` below. +import Data.ByteString.Lazy.Char8 qualified as LBS +import Data.Foldable qualified as Foldable +import Prelude qualified as Prelude + +type LByteString = LBS.ByteString + -- | Rename `id` to `identity` to allow `id` as a variable name identity :: Category cat => cat a a identity = Category.id @@ -72,8 +87,11 @@ instance HasLength Text where length' = Text.length instance Foldable t => HasLength (t a) where - length' = Prelude.length + length' = Foldable.length -- | We can pass several things here, as long as they have length. length :: HasLength a => a -> Int length = length' + +panic :: Text -> a +panic = Prelude.error . Text.unpack diff --git a/cardano-prelude/src/Cardano/Prelude/GHC/Heap/Tree.hs b/cardano-prelude/src/Cardano/Prelude/GHC/Heap/Tree.hs index d86906a5..c9befde7 100644 --- a/cardano-prelude/src/Cardano/Prelude/GHC/Heap/Tree.hs +++ b/cardano-prelude/src/Cardano/Prelude/GHC/Heap/Tree.hs @@ -71,7 +71,7 @@ isZeroOrNegativeTreeDepth (TreeDepth d) | otherwise = False renderClosure :: Closure -> Text -renderClosure = Text.pack . show +renderClosure = Text.pack . Prelude.show renderTree :: Tree a -> (a -> Text) -> Text renderTree tree renderA = Text.pack $ drawTree (fmap (Text.unpack . renderA) tree) diff --git a/cardano-prelude/src/Cardano/Prelude/Json/Canonical.hs b/cardano-prelude/src/Cardano/Prelude/Json/Canonical.hs index efe86aa5..bb18d9eb 100644 --- a/cardano-prelude/src/Cardano/Prelude/Json/Canonical.hs +++ b/cardano-prelude/src/Cardano/Prelude/Json/Canonical.hs @@ -78,13 +78,13 @@ instance Monad m => ToJSON m Word32 where toJSON = pure . JSNum . fromIntegral instance Monad m => ToJSON m Word64 where - toJSON = pure . JSString . CanonicalJSON.toJSString . show + toJSON = pure . JSString . CanonicalJSON.toJSString . Prelude.show instance Monad m => ToJSON m Integer where - toJSON = pure . JSString . CanonicalJSON.toJSString . show + toJSON = pure . JSString . CanonicalJSON.toJSString . Prelude.show instance Monad m => ToJSON m Natural where - toJSON = pure . JSString . CanonicalJSON.toJSString . show + toJSON = pure . JSString . CanonicalJSON.toJSString . Prelude.show -- | For backwards compatibility we convert this to seconds instance Monad m => ToJSON m UTCTime where @@ -132,7 +132,7 @@ canonicalDecodePretty :: Either Text a canonicalDecodePretty y = do eVal <- first Text.pack (CanonicalJSON.parseCanonicalJSON y) - first (Text.pack . show) (CanonicalJSON.fromJSON eVal :: Either SchemaError a) + first (Text.pack . Prelude.show) (CanonicalJSON.fromJSON eVal :: Either SchemaError a) canonicalEncodePretty :: forall a. CanonicalJSON.ToJSON Identity a => a -> LB.ByteString diff --git a/cardano-prelude/src/Cardano/Prelude/Json/Parse.hs b/cardano-prelude/src/Cardano/Prelude/Json/Parse.hs index 2454ed63..be1e9039 100644 --- a/cardano-prelude/src/Cardano/Prelude/Json/Parse.hs +++ b/cardano-prelude/src/Cardano/Prelude/Json/Parse.hs @@ -36,7 +36,7 @@ parseJSString parser = \case val -> expectedButGotValue typeName val where typeName :: String - typeName = show $ typeRep (Proxy @a) + typeName = Prelude.show $ typeRep (Proxy @a) report :: String -> e -> m a report str err =