Make GHC 8.10.7 happy in CI

IntersectMBO · Jan 10, 2025 · fef4eb9 · fef4eb9
1 parent 7bfc107
commit fef4eb9
Show file tree

Hide file tree

Showing 4 changed files with 13 additions and 11 deletions.
diff --git a/ouroboros-consensus-cardano/app/snapshot-converter.hs b/ouroboros-consensus-cardano/app/snapshot-converter.hs
@@ -16,7 +16,7 @@ import           Cardano.Tools.DBAnalyser.HasAnalysis (mkProtocolInfo)
 import           Codec.Serialise
 import qualified Control.Monad as Monad
 import           Control.Monad.Except
-import           Control.Monad.Trans (lift)
+import qualified Control.Monad.Trans as Trans (lift)
 import           Control.ResourceRegistry (ResourceRegistry)
 import qualified Control.ResourceRegistry as RR
 import           Control.Tracer (nullTracer)
@@ -158,7 +158,7 @@ checkSnapshotFileStructure m p (SomeHasFS fs) = case m of
   where
     want :: (FsPath -> IO Bool) -> FsPath -> String -> ExceptT (Error blk) IO ()
     want fileType path err = do
-        exists <- lift $ fileType path
+        exists <- Trans.lift $ fileType path
         Monad.unless exists $ throwError $ SnapshotFormatMismatch m err
 
     isDir        = (doesDirectoryExist, [],             "is NOT a directory")
@@ -207,7 +207,7 @@ load config@Config{inpath = pathToDiskSnapshot -> Just (fs@(SomeHasFS hasFS), pa
       checkSnapshotFileStructure Mem path fs
       (ls, _) <- withExceptT SnapshotError $ V2.loadSnapshot rr ccfg fs checkChecksum ds
       let h = V2.currentHandle ls
-      (V2.state h,) <$> lift (V2.readAll (V2.tables h))
+      (V2.state h,) <$> Trans.lift (V2.readAll (V2.tables h))
     LMDB -> do
       checkSnapshotFileStructure LMDB path fs
       ((dbch, bstore), _) <-
@@ -219,7 +219,7 @@ load config@Config{inpath = pathToDiskSnapshot -> Just (fs@(SomeHasFS hasFS), pa
           (V1.SnapshotsFS fs)
           checkChecksum
           ds
-      (V1.current dbch,) <$> lift (V1.bsReadAll bstore)
+      (V1.current dbch,) <$> Trans.lift (V1.bsReadAll bstore)
   where
     Config { checkChecksum } = config
 load _ _ _ _ = error "Malformed input path!"

diff --git a/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Ledger/Dual.hs b/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Ledger/Dual.hs
@@ -71,7 +71,9 @@ import qualified Data.ByteString.Lazy as Lazy
 import qualified Data.ByteString.Short as Short
 import           Data.Functor ((<&>))
 import           Data.Kind (Type)
+#if __GLASGOW_HASKELL__ >= 906
 import           Data.MemPack (MemPack)
+#endif
 import           Data.Typeable
 import           GHC.Generics (Generic)
 import           GHC.Stack

diff --git a/...os-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Storage/LedgerDB/V1/Snapshots.hs b/...os-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Storage/LedgerDB/V1/Snapshots.hs
@@ -142,7 +142,7 @@ import           Codec.CBOR.Encoding
 import           Codec.Serialise
 import qualified Control.Monad as Monad
 import           Control.Monad.Except
-import           Control.Monad.Trans (lift)
+import qualified Control.Monad.Trans as Trans (lift)
 import           Control.Tracer
 import qualified Data.ByteString.Builder as BS
 import           Data.Functor.Contravariant ((>$<))
@@ -272,6 +272,6 @@ loadSnapshot tracer bss ccfg fs@(SnapshotsFS fs'@(SomeHasFS fs'')) doChecksum s
   case pointToWithOriginRealPoint (castPoint (getTip extLedgerSt)) of
     Origin        -> throwError InitFailureGenesis
     NotOrigin pt -> do
-        backingStore <- lift (restoreBackingStore tracer bss fs (snapshotToTablesPath s))
+        backingStore <- Trans.lift (restoreBackingStore tracer bss fs (snapshotToTablesPath s))
         let chlog  = empty extLedgerSt
         pure ((chlog, backingStore), pt)
diff --git a/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Storage/LedgerDB/V2.hs b/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Storage/LedgerDB/V2.hs
@@ -18,7 +18,7 @@
 module Ouroboros.Consensus.Storage.LedgerDB.V2 (mkInitDb) where
 
 import           Control.Arrow ((>>>))
-import           Control.Monad (void, (>=>))
+import qualified Control.Monad as Monad (void, (>=>))
 import           Control.Monad.Except
 import           Control.RAWLock
 import qualified Control.RAWLock as RAWLock
@@ -185,7 +185,7 @@ mkInternals bss h = TestInternals {
           st <- (case whereTo of
             TakeAtVolatileTip  -> anchorHandle
             TakeAtImmutableTip -> currentHandle) <$> readTVarIO (ldbSeq env)
-          void $ takeSnapshot
+          Monad.void $ takeSnapshot
                 (configCodec . getExtLedgerCfg . ledgerDbCfg $ ldbCfg env)
                 (LedgerDBSnapshotEvent >$< ldbTracer env)
                 (ldbHasFS env)
@@ -336,13 +336,13 @@ implTryTakeSnapshot ::
   -> m SnapCounters
 implTryTakeSnapshot bss env mTime nrBlocks =
     if onDiskShouldTakeSnapshot (ldbSnapshotPolicy env) (uncurry (flip diffTime) <$> mTime) nrBlocks then do
-      void . takeSnapshot
+      Monad.void . takeSnapshot
                 (configCodec . getExtLedgerCfg . ledgerDbCfg $ ldbCfg env)
                 (LedgerDBSnapshotEvent >$< ldbTracer env)
                 (ldbHasFS env)
                 . anchorHandle
                 =<< readTVarIO (ldbSeq env)
-      void $ trimSnapshots
+      Monad.void $ trimSnapshots
                 (LedgerDBSnapshotEvent >$< ldbTracer env)
                 (ldbHasFS env)
                 (ldbSnapshotPolicy env)
@@ -654,7 +654,7 @@ newForker h ldbEnv rr st = do
     let tr = LedgerDBForkerEvent . TraceForkerEventWithKey forkerKey >$< ldbTracer ldbEnv
     traceWith tr ForkerOpen
     lseqVar   <- newTVarIO . LedgerSeq . AS.Empty $ st
-    (_, toRelease) <- allocate rr (\_ -> newTVarIO (pure ())) (readTVarIO >=> id)
+    (_, toRelease) <- allocate rr (\_ -> newTVarIO (pure ())) (readTVarIO Monad.>=> id)
     let forkerEnv = ForkerEnv {
         foeLedgerSeq          = lseqVar
       , foeSwitchVar          = ldbSeq ldbEnv