Merge pull request #5945 from IntersectMBO/erikd/ghc-9.10

Make it build with ghc-9.10

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"]
+        ghc: ["9.6", "9.10"]
         cabal: ["3.12"]
         sys:
           - { os: windows-latest, shell: 'C:/msys64/usr/bin/bash.exe -e {0}' }
@@ -49,7 +49,7 @@ jobs:
           - cabal: "3.12"
             ghc: "9.6"
             sys:
-              os: macos-latest
+              os: macos-13
               shell: bash
     defaults:
       run:

bench/locli/locli.cabal

@@ -114,7 +114,6 @@ library
                       , filepath
                       , fingertree
                       , hashable
-                      , ghc
                       , gnuplot
                       , iohk-monitoring
                       , optparse-applicative-fork

bench/locli/src/Cardano/Util.hs

@@ -1,4 +1,3 @@
-{-# LANGUAGE CPP #-}
 {-# LANGUAGE DeriveAnyClass #-}
 {-# LANGUAGE DeriveFunctor #-}
 {-# LANGUAGE GeneralisedNewtypeDeriving #-}
@@ -7,7 +6,6 @@
 {- HLINT ignore "Use list literal pattern" -}
 module Cardano.Util
   ( module Prelude
-  , module Util
   , module Data.Aeson
   , module Data.IntervalMap.FingerTree
   , module Data.SOP
@@ -30,20 +28,6 @@ import Prelude                          (String, error, head, last)
 import Text.Show qualified as Show      (Show(..))
 import Cardano.Prelude
 
-#if __GLASGOW_HASKELL__ < 902
--- This is a GHC module ...
-import Util                      hiding (fst3, snd3)
-#elif __GLASGOW_HASKELL__ < 906
--- that moved for the ghc-9.2 release.
-import GHC.Utils.Misc                   as Util
-                                 hiding (fst3, snd3, third3, uncurry3, firstM, secondM)
-#else
--- that moved again for the ghc-9.6 release.
--- Taking an internal module of GHC and re-exporting it is an incredibly dumb idea.
-import GHC.Utils.Misc                   as Util
-                                 hiding (fst3, snd3, third3, uncurry3)
-#endif
-
 import Data.Aeson                       (FromJSON (..), ToJSON (..), Object, Value (..), (.:), (.:?), (.!=), withObject, object)
 import Data.Aeson                       qualified as AE
 import Control.Arrow                    ((&&&), (***))
@@ -254,3 +238,26 @@ toRUTCTime =  RUTCTime . unsafeUTCToNominal
 
 fromRUTCTime :: RUTCTime -> UTCTime
 fromRUTCTime =  unsafeNominalToUTC . unRUTCTime
+
+-- -------------------------------------------------------------------------------------------------
+-- Importing from GHC.* is a bad idea, because that library changes from compiler release to
+-- compiler release and adds dependency constraints that are too tight.
+-- Both of these issues makes supporting multiple GHC versions significantly more difficult
+-- than it should be.
+-- Cargo cult these two functions instead.
+
+-- Stolen from GHC.Utils.Misc
+count :: (a -> Bool) -> [a] -> Int
+count p = go 0
+  where go !n [] = n
+        go !n (x:xs) | p x       = go (n+1) xs
+                     | otherwise = go n xs
+
+-- Stolen from GHC.Utils.Misc
+mapAndUnzip :: (a -> (b, c)) -> [a] -> ([b], [c])
+mapAndUnzip _ [] = ([], [])
+mapAndUnzip f (x:xs)
+  = let (r1,  r2)  = f x
+        (rs1, rs2) = mapAndUnzip f xs
+    in
+    (r1:rs1, r2:rs2)

bench/locli/src/Data/DataDomain.hs

@@ -10,7 +10,6 @@ where
 import Cardano.Prelude
 
 import Witherable qualified as Wither
-import Data.List.NonEmpty qualified as NE
 
 import Cardano.Util
 import Data.CDF
@@ -61,7 +60,7 @@ traverseDataDomain' ::
 traverseDataDomain' f xs =
   DataDomain
   <$> (Interval <$> f (xs <&> low . ddRaw) <*> f (xs <&> high . ddRaw))
-  <*> (let lohis = NE.unzip $ (fmap (low &&& high) . ddFiltered) `Wither.mapMaybe` xs
+  <*> (let lohis = neUnzip $ (fmap (low &&& high) . ddFiltered) `Wither.mapMaybe` xs
        in Just <$> (Interval <$> f (fst lohis) <*> f (snd lohis)))
   <*> f (xs <&> ddRawCount)
   <*> f (xs <&> ddFilteredCount)
@@ -97,3 +96,12 @@ intersectDataDomains xs =
   , ddRawCount      =   I $ sum $ xs <&> unI . ddRawCount
   , ddFilteredCount =   I $ sum $ xs <&> unI . ddFilteredCount
   }
+
+-- In [email protected] the Data.List.NonEmpty.unzip is deprecated and suggests that
+-- Data.Function.unzip should be used instead,but base versions earlier than
+-- 4.20 do not have that.
+-- Neatest solution is to cargo cult it here and switch to Data.Function.unzip
+-- later.
+neUnzip :: Functor f => f (a,b) -> (f a, f b)
+neUnzip xs = (fst <$> xs, snd <$> xs)
+

bench/tx-generator/src/Cardano/TxGenerator/PureExample.hs

@@ -21,7 +21,7 @@ import           Control.Monad (foldM)
 import           Control.Monad.Trans.State.Strict
 import           Data.Aeson (eitherDecodeFileStrict')
 import           Data.Either (fromRight)
-import           Data.List (foldl')
+import           Data.List as List (foldl')
 import           Data.String (fromString)
 import           System.Exit (die)
 
@@ -121,7 +121,7 @@ generateTx TxEnvironment{..}
       return $ Right funds
 
     addNewOutputFunds :: [Fund] -> Generator ()
-    addNewOutputFunds = put . foldl' insertFund emptyFundQueue
+    addNewOutputFunds = put . List.foldl' insertFund emptyFundQueue
 
     computeOutputValues :: [L.Coin] -> [L.Coin]
     computeOutputValues = inputsToOutputsWithFee fee numOfOutputs
@@ -147,7 +147,7 @@ generateTxPure ::
 generateTxPure TxEnvironment{..} inQueue
   = do
       (tx, txId) <- generator inputs outputs
-      let outQueue = foldl' insertFund emptyFundQueue (toFunds txId)
+      let outQueue = List.foldl' insertFund emptyFundQueue (toFunds txId)
       pure (tx, outQueue)
   where
     inputs = toList inQueue

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 2024-08-15T08:53:32Z
-  , cardano-haskell-packages 2024-08-15T10:40:33Z
+  , hackage.haskell.org 2024-08-20T21:35:22Z
+  , cardano-haskell-packages 2024-08-18T22:35:14Z
 
 packages:
   cardano-node
@@ -58,10 +58,16 @@ package plutus-scripts-bench
   haddock-options: "--optghc=-fplugin-opt PlutusTx.Plugin:defer-errors"
 
 constraints:
-  wai-extra < 3.1.15,
+  , wai-extra < 3.1.15
 
 allow-newer:
-    katip:Win32
+  , katip:Win32
+
+  -- https://github.com/L0neGamer/ekg-json/pull/21
+  -- https://github.com/L0neGamer/ekg/issues/94
+  , ekg:base
+  , ekg:filepath
+  , ekg-json:base
 
 -- IMPORTANT
 -- Do NOT add more source-repository-package stanzas here unless they are strictly

cardano-node/src/Cardano/Node/Tracing/Tracers/Consensus.hs

@@ -71,10 +71,10 @@ import           Ouroboros.Network.TxSubmission.Outbound
 import           Control.Monad.Class.MonadTime.SI (Time (..))
 import           Data.Aeson (ToJSON, Value (Number, String), toJSON, (.=))
 import qualified Data.Aeson as Aeson
-import           Data.Foldable (Foldable (..))
 import           Data.Int (Int64)
 import           Data.IntPSQ (IntPSQ)
 import qualified Data.IntPSQ as Pq
+import qualified Data.List as List
 import qualified Data.Text as Text
 import           Data.Time (DiffTime, NominalDiffTime)
 import           Data.Word (Word32, Word64)
@@ -648,7 +648,7 @@ instance (LogFormatting peer, Show peer) =>
   forMachine _ xs       = mconcat
     [ "kind"  .= String "PeersFetch"
     , "peers" .= toJSON
-      (foldl' (\acc x -> forMachine DDetailed x : acc) [] xs) ]
+      (List.foldl' (\acc x -> forMachine DDetailed x : acc) [] xs) ]
 
   asMetrics peers = [IntM "BlockFetch.ConnectedPeers" (fromIntegral (length peers))]
 

flake.lock

@@ -18,7 +18,7 @@ import           Control.Exception (throwIO)
 import qualified Data.Aeson as AE
 import           Data.ByteString (ByteString)
 import qualified Data.ByteString.Char8 as BS
-import           Data.List (foldl')
+import           Data.List as List (foldl')
 import qualified Data.Map.Strict as Map
 import           Data.Maybe (catMaybes, listToMaybe)
 import           Data.Text (Text, intercalate, split)
@@ -122,7 +122,7 @@ parseRepresentation bs = transform (decodeEither' bs)
     transform (Right rl) = Right $ transform' emptyTraceConfig rl
     transform' :: TraceConfig -> ConfigRepresentation -> TraceConfig
     transform' TraceConfig {tcOptions=to'} cr =
-      let to''  = foldl' (\ tci (nsp, opts') ->
+      let to''  = List.foldl' (\ tci (nsp, opts') ->
                               let ns' = split (=='.') nsp
                                   ns'' = if ns' == [""] then [] else ns'
                                   ns''' = case ns'' of
@@ -164,7 +164,7 @@ configToRepresentation traceConfig =
     toOptionRepresentation :: Map.Map [Text] [ConfigOption]
                               ->  Map.Map Text ConfigOptionRep
     toOptionRepresentation internalOptMap =
-      foldl' conversion Map.empty (Map.toList internalOptMap)
+      List.foldl' conversion Map.empty (Map.toList internalOptMap)
 
     conversion :: Map.Map Text ConfigOptionRep
                 -> ([Text],[ConfigOption])

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

@@ -7,7 +7,7 @@ module Cardano.Logging.Consistency (
 import           Cardano.Logging.ConfigurationParser
 import           Cardano.Logging.Types
 
-import           Data.Foldable (foldl')
+import           Data.Foldable as Foldable (foldl')
 import qualified Data.Map.Strict as Map
 import           Data.Maybe (mapMaybe)
 import qualified Data.Text as T
@@ -69,7 +69,7 @@ checkNamespace nsLookup ns = go nsLookup ns
 --   Warns as well if namespaces in all namespaces are ending in the
 --   middle of another namespace.
 asNSLookup :: [[T.Text]] -> (NSLookup, NSWarnings)
-asNSLookup = foldl' (fillLookup []) (NSLookup Map.empty, [])
+asNSLookup = Foldable.foldl' (fillLookup []) (NSLookup Map.empty, [])
   where
     fillLookup :: [T.Text] -> (NSLookup, NSWarnings) -> [T.Text] -> (NSLookup, NSWarnings)
     fillLookup _nsFull (NSLookup nsl, nsw)  [] = (NSLookup nsl, nsw)