buildable with stm prior to 2.5

Have to use CPP, but it's worth it.
IntersectMBO · Dec 14, 2018 · 2fe1f67 · 2fe1f67
1 parent 9653e8e
commit 2fe1f67
Show file tree

Hide file tree

Showing 3 changed files with 20 additions and 5 deletions.
diff --git a/ouroboros-network/ouroboros-network.cabal b/ouroboros-network/ouroboros-network.cabal
@@ -98,16 +98,16 @@ library
                        bytestring        >=0.10 && <0.11,
                        cborg             >=0.2.1 && <0.3,
                        clock             >=0.7 && <0.8,
-                       containers        >=0.6 && <0.7,
-                       free              >=5.1 && <5.2,
+                       containers,
+                       free,
                        hashable          >=1.2 && <1.3,
                        mtl               >=2.2 && <2.3,
                        network,
                        pipes             >=4.3 && <4.4,
                        process           >=1.6 && <1.7,
                        psqueues          >=0.2 && <0.3,
                        serialise         >=0.2 && <0.3,
-                       stm               >=2.5 && <2.6,
+                       stm               >=2.4 && <2.6,
                        text              >=1.2 && <1.3,
 
                        QuickCheck        >=2.12 && <2.13

diff --git a/ouroboros-network/src/Ouroboros/Network/MonadClass/MonadSTM.hs b/ouroboros-network/src/Ouroboros/Network/MonadClass/MonadSTM.hs
@@ -4,6 +4,7 @@
 {-# LANGUAGE TypeFamilies           #-}
 {-# LANGUAGE TypeFamilyDependencies #-}
 {-# LANGUAGE UndecidableInstances   #-}
+{-# LANGUAGE CPP                    #-}
 {-# OPTIONS_GHC -fno-warn-orphans   #-}
 module Ouroboros.Network.MonadClass.MonadSTM
   ( MonadSTM (..)
@@ -88,8 +89,9 @@ class (MonadFork m, Monad (Tr m)) => MonadSTM m where
   newTBQueue     :: Natural -> Tr m (TBQueue m a)
   readTBQueue    :: TBQueue m a -> Tr m a
   writeTBQueue   :: TBQueue m a -> a -> Tr m ()
+#if MIN_VERSION_stm(2,5,0)
   lengthTBQueue  :: TBQueue m a -> Tr m Natural
-
+#endif
 
 instance MonadFork m => MonadFork (ReaderT e m) where
   fork (ReaderT f) = ReaderT $ \e -> fork (f e)
@@ -122,7 +124,9 @@ instance MonadSTM m => MonadSTM (ReaderT e m) where
   newTBQueue       = lift . newTBQueue
   readTBQueue      = lift . readTBQueue
   writeTBQueue q a = lift $ writeTBQueue q a
+#if MIN_VERSION_stm(2,5,0)
   lengthTBQueue    = lift . lengthTBQueue
+#endif
 
 -- NOTE(adn): Is this a sensible instance?
 instance (Show e, MonadFork m) => MonadFork (ExceptT e m) where
@@ -156,8 +160,9 @@ instance (Show e, MonadSTM m) => MonadSTM (ExceptT e m) where
   newTBQueue       = lift . newTBQueue
   readTBQueue      = lift . readTBQueue
   writeTBQueue q a = lift $ writeTBQueue q a
+#if MIN_VERSION_stm(2,5,0)
   lengthTBQueue    = lift . lengthTBQueue
-
+#endif
 
 --
 -- Instance for IO uses the existing STM library implementations
@@ -195,10 +200,17 @@ instance MonadSTM IO where
 
   type TBQueue IO = STM.TBQueue
 
+#if MIN_VERSION_stm(2,5,0)
   newTBQueue     = STM.newTBQueue
+#else
+  -- STM prior to 2.5.0 takes an Int
+  newTBQueue     = STM.newTBQueue . fromEnum
+#endif
   readTBQueue    = STM.readTBQueue
   writeTBQueue   = STM.writeTBQueue
+#if MIN_VERSION_stm(2,5,0)
   lengthTBQueue  = STM.lengthTBQueue
+#endif
 
 --
 -- Default TMVar implementation in terms of TVars (used by sim)

diff --git a/ouroboros-network/src/Ouroboros/Network/Sim.hs b/ouroboros-network/src/Ouroboros/Network/Sim.hs
@@ -9,6 +9,7 @@
 {-# LANGUAGE ScopedTypeVariables        #-}
 {-# LANGUAGE TypeApplications           #-}
 {-# LANGUAGE TypeFamilies               #-}
+{-# LANGUAGE CPP                        #-}
 
 module Ouroboros.Network.Sim {-(
   SimF,
@@ -154,7 +155,9 @@ instance MonadSTM (Free (SimF s)) where
   newTBQueue        = newTBQueueDefault
   readTBQueue       = readTBQueueDefault
   writeTBQueue      = writeTBQueueDefault
+#if MIN_VERSION_stm(2,5,0)
   lengthTBQueue     = lengthTBQueueDefault
+#endif
 
 instance MonadST (Free (SimF s)) where
   withLiftST f = f liftST