Merge pull request #6146 from IntersectMBO/erikd/ghc-9.12

Make it build with ghc-9.12

Author: erikd

.github/workflows/haskell.yml

@@ -38,7 +38,7 @@ jobs:
         # If you edit these versions, make sure the version in the lonely macos-latest job below is updated accordingly
         # TODO add 9.8 again to the versions list when GHC-9.8 gets released with stm > 2.5.2,
         # see https://github.com/haskell/stm/issues/76
-        ghc: ["9.6", "9.10"]
+        ghc: ["9.6", "9.12"]
         cabal: ["3.12"]
         sys:
           - { os: windows-latest, shell: 'C:/msys64/usr/bin/bash.exe -e {0}' }

bench/tx-generator/src/Cardano/Benchmarking/Command.hs

@@ -34,8 +34,8 @@ import           Data.Aeson (fromJSON)
 import           Data.ByteString.Lazy as BSL
 import           Data.Foldable (for_)
 import           Data.Maybe (catMaybes)
-import           Data.Text as T
-import           Data.Text.IO as T
+import qualified Data.Text as Text
+import qualified Data.Text.IO as Text
 import           Options.Applicative as Opt
 import           Ouroboros.Network.NodeToClient (IOManager, withIOManager)
 
@@ -148,7 +148,7 @@ runCommand' iocp = do
                                        , show sigInfo ]
               errorToThrow :: IOError
               errorToThrow = userError labelStr
-              tag = TraceBenchTxSubError . T.pack
+              tag = TraceBenchTxSubError . Text.pack
               traceWith' msg = do
                 mBenchTracer <- STM.atomically do readTVar benchTracers
                 case mBenchTracer of
@@ -257,4 +257,4 @@ commandParser
   versionCmd = pure VersionCmd
 
 runVersionCommand :: IO ()
-runVersionCommand = T.putStrLn $ multilineVersionMsg txGeneratorVersion
+runVersionCommand = Text.putStrLn $ multilineVersionMsg txGeneratorVersion

cabal.project

@@ -13,8 +13,8 @@ repository cardano-haskell-packages
 -- See CONTRIBUTING for information about these, including some Nix commands
 -- you need to run if you change them
 index-state:
-  , hackage.haskell.org 2025-01-01T23:24:19Z
-  , cardano-haskell-packages 2025-02-11T21:18:23Z
+  , hackage.haskell.org 2025-03-13T00:45:00Z
+  , cardano-haskell-packages 2025-03-13T02:33:54Z
 
 packages:
   cardano-node
@@ -64,3 +64,30 @@ allow-newer:
 -- IMPORTANT
 -- Do NOT add more source-repository-package stanzas here unless they are strictly
 -- temporary! Please read the section in CONTRIBUTING about updating dependencies.
+
+if impl (ghc >= 9.12)
+  allow-newer:
+    -- https://github.com/phadej/vec/issues/118
+    , bin:base
+    , fin:base
+    , ral:base
+
+    -- https://github.com/haskellari/tree-diff/issues/97
+    , tree-diff:base
+
+    -- https://github.com/kapralVV/Unique/issues/11
+    , Unique:hashable
+
+    -- https://github.com/fizruk/http-api-data/pull/146
+    , http-api-data:base
+
+    -- https://github.com/ocharles/libsystemd-journal/pull/32
+    , libsystemd-journal:base
+
+    -- https://github.com/Gabriella439/Haskell-Pipes-Safe-Library/pull/70
+    , pipes-safe:base
+
+    -- https://github.com/haskell-servant/servant/pull/1810
+    , servant:base
+    , servant-server:base
+

cardano-tracer/test/Cardano/Tracer/Test/ForwardingStressTest/Types.hs

@@ -17,7 +17,7 @@ import           Control.Monad (guard)
 import           Data.Aeson (FromJSON (..), Object, Value (..), withObject, (.=))
 import           Data.Aeson.Types (Parser, parseFail, -- parseEither,
                                    parseField)
-import           Data.Text hiding (empty, length, reverse)
+import           Data.Text (Text)
 import qualified Data.Text as Text
 import           Data.Vector (Vector)
 import qualified Data.Vector as Vector
@@ -63,7 +63,7 @@ parseFromObjInner :: Object -> Parser Message
 parseFromObjInner obj = do
   messageId_ <- parseField obj "mid"
   messageId <- maybe (parseFail "parseFromObjInner: No `mid' field found.") pure
-    (stripBrackets messageId_ >>= readMaybe @MessageID . unpack)
+    (stripBrackets messageId_ >>= readMaybe @MessageID . Text.unpack)
 
   kind     <- parseField @String obj "kind"
   workload <- parseField @String obj "workload"
@@ -73,7 +73,7 @@ parseFromObjInner obj = do
         Just workloadInt -> pure $ Message1 messageId workloadInt
         Nothing -> parseFail ("FromJSON Message: Could not parse 'workload' field: " ++ workload ++ "\n  + " ++ show obj)
     "Message2" ->
-      pure $ Message2 messageId (pack workload)
+      pure $ Message2 messageId (Text.pack workload)
     "Message3" ->
       case readMaybe @Double workload of
         Just workloadDouble -> pure $ Message3 messageId workloadDouble

flake.lock

@@ -42,7 +42,7 @@
     };
 
     hackageNix = {
-      url = "github:input-output-hk/hackage.nix";
+      url = "github:input-output-hk/hackage.nix?ref=for-stackage";
       flake = false;
     };
 

flake.nix

@@ -12,8 +12,9 @@ import           Cardano.Logging.Types
 import           Data.Aeson hiding (Error)
 import           Data.ByteString.Lazy (toStrict)
 import qualified Data.Map as Map
-import           Data.Text
-import           Data.Text.Encoding
+import           Data.Text (Text)
+import qualified Data.Text as Text
+import qualified Data.Text.Encoding as Text
 
 data UnknownNamespaceKind =
     UKFSeverity
@@ -51,20 +52,20 @@ data TraceDispatcherMessage =
 instance LogFormatting TraceDispatcherMessage where
   forHuman (StartLimiting txt) = "Start of frequency limiting for " <> txt
   forHuman (StopLimiting txt num) = "Stop of frequency limiting for " <> txt <>
-    ". Suppressed " <> pack (show num) <> " messages."
+    ". Suppressed " <> textShow num <> " messages."
   forHuman (RememberLimiting txt num) = "Frequency limiting still active for " <> txt <>
-    ". Suppressed so far " <> pack (show num) <> " messages."
+    ". Suppressed so far " <> textShow num <> " messages."
   forHuman (UnknownNamespace nsPrefixNS nsInnerNS qk) = "Unknown namespace detected "
-    <> intercalate (singleton '.') (nsPrefixNS ++ nsInnerNS)
-    <> ". Used for querying " <> (pack . show) qk <> "."
+    <> Text.intercalate (Text.singleton '.') (nsPrefixNS ++ nsInnerNS)
+    <> ". Used for querying " <> textShow qk <> "."
   forHuman (TracerInfo silent noMetrics allTracers) = "The tracing system has silent the following tracer,"
     <> " as they will never have any output according to the current config: "
-    <> intercalate (singleton ' ') silent <> ". The following tracers will not emit metrics "
-    <> intercalate (singleton ' ') noMetrics <> ". Here is a complete list of all tracers: "
-    <> intercalate (singleton ' ') allTracers <> "."
-  forHuman (MetricsInfo mmap) = "Number of metrics delivered, " <> (pack . show) mmap
-  forHuman (TracerConsistencyWarnings errs) = "Consistency check found error:  " <> (pack . show) errs
-  forHuman (TracerInfoConfig tc) = "Effective Tracer config is:  " <> decodeUtf8 (toStrict (encode tc))
+    <> Text.intercalate (Text.singleton ' ') silent <> ". The following tracers will not emit metrics "
+    <> Text.intercalate (Text.singleton ' ') noMetrics <> ". Here is a complete list of all tracers: "
+    <> Text.intercalate (Text.singleton ' ') allTracers <> "."
+  forHuman (MetricsInfo mmap) = "Number of metrics delivered, " <> textShow mmap
+  forHuman (TracerConsistencyWarnings errs) = "Consistency check found error:  " <> textShow errs
+  forHuman (TracerInfoConfig tc) = "Effective Tracer config is:  " <> Text.decodeUtf8 (toStrict (encode tc))
 
 
   forMachine _dtl StartLimiting {} = mconcat
@@ -80,23 +81,23 @@ instance LogFormatting TraceDispatcherMessage where
         ]
   forMachine _dtl (UnknownNamespace nsun nsleg query) = mconcat
         [ "kind" .= String "UnknownNamespace"
-        , "unknownNamespace" .= String (intercalate (singleton '.') nsun)
-        , "legalNamespace" .= String (intercalate (singleton '.') nsleg)
-        , "querying" .= String ((pack . show) query)
+        , "unknownNamespace" .= String (Text.intercalate (Text.singleton '.') nsun)
+        , "legalNamespace" .= String (Text.intercalate (Text.singleton '.') nsleg)
+        , "querying" .= String (textShow query)
         ]
   forMachine _dtl (TracerInfo silent noMetrics allTracers) = mconcat
         [ "kind" .= String "TracerMeta"
-        , "silentTracers" .= String (intercalate (singleton ' ') silent)
-        , "noMetrics" .= String (intercalate (singleton ' ') noMetrics)
-        , "allTracers" .= String (intercalate (singleton ' ') allTracers)
+        , "silentTracers" .= String (Text.intercalate (Text.singleton ' ') silent)
+        , "noMetrics" .= String (Text.intercalate (Text.singleton ' ') noMetrics)
+        , "allTracers" .= String (Text.intercalate (Text.singleton ' ') allTracers)
         ]
   forMachine _dtl (MetricsInfo mmap) = mconcat
         [ "kind" .= String "MetricsInfo"
-        , "metrics count" .= String ((pack . show) mmap)
+        , "metrics count" .= String (textShow mmap)
         ]
   forMachine _dtl (TracerConsistencyWarnings errs) = mconcat
         [ "kind" .= String "TracerConsistencyWarnings"
-        , "errors" .= String ((pack . show) errs)
+        , "errors" .= String (textShow errs)
         ]
   forMachine _dtl (TracerInfoConfig tc) = mconcat
         [ "conf" .= toJSON tc
@@ -182,3 +183,8 @@ instance MetaTrace TraceDispatcherMessage where
       , Namespace [] ["TracerConsistencyWarnings"]
       , Namespace [] ["TracerConfigInfo"]
       ]
+
+-- `text-2.1.2` provides `Text.show` which can replace this when
+-- the lower bound for `text` is high enough.
+textShow :: Show a => a -> Text
+textShow = Text.pack . show

trace-dispatcher/src/Cardano/Logging/TraceDispatcherMessage.hs

@@ -16,12 +16,11 @@ import           Ouroboros.Network.Protocol.Handshake.Version (Accept (..), Acce
 import qualified Codec.CBOR.Term as CBOR
 import           Data.Text (Text)
 import qualified Data.Text as T
-import           Data.Typeable (Typeable)
 
 data ForwardingVersion
   = ForwardingV_1
   | ForwardingV_2
-  deriving (Eq, Ord, Enum, Bounded, Show, Typeable)
+  deriving (Eq, Ord, Enum, Bounded, Show)
 
 forwardingVersionCodec :: CodecCBORTerm (Text, Maybe Int) ForwardingVersion
 forwardingVersionCodec = CodecCBORTerm { encodeTerm, decodeTerm }
@@ -40,7 +39,7 @@ forwardingVersionCodec = CodecCBORTerm { encodeTerm, decodeTerm }
 
 newtype ForwardingVersionData = ForwardingVersionData
   { networkMagic :: NetworkMagic
-  } deriving (Eq, Show, Typeable)
+  } deriving (Eq, Show)
 
 instance Acceptable ForwardingVersionData where
   acceptableVersion local remote

trace-dispatcher/src/Cardano/Logging/Version.hs

@@ -87,7 +87,7 @@ acceptorActions config@AcceptorConfiguration{whatToRequest, shouldWeStop} loHand
       (return $ acceptorActions config loHandler)
 
 data Timeout = Timeout
-  deriving (Typeable, Show)
+  deriving Show
 
 instance Exception Timeout where