From b83fdf66dfe4caf52c097af8773d8f7470e48b5e Mon Sep 17 00:00:00 2001
From: Joey Hess <joeyh@joeyh.name>
Date: Thu, 17 Oct 2024 20:55:31 -0400
Subject: [PATCH] Allow enabling the servant build flag with older versions of
 stm

Allowing building with ghc 9.0.2 (debian stable).

Updated patch covering all uses of writeTMVar.
---
 P2P/Http/Client.hs |  7 +------
 P2P/Http/Server.hs |  2 +-
 P2P/Http/State.hs  |  2 +-
 Utility/STM.hs     | 23 +++++++++++++++++++++++
 git-annex.cabal    |  1 +
 5 files changed, 27 insertions(+), 8 deletions(-)
 create mode 100644 Utility/STM.hs

diff --git a/P2P/Http/Client.hs b/P2P/Http/Client.hs
index 9560f80dac..62cad6ca74 100644
--- a/P2P/Http/Client.hs
+++ b/P2P/Http/Client.hs
@@ -36,6 +36,7 @@ import P2P.Http.Url
 import Annex.Concurrent
 import Utility.Url (BasicAuth(..))
 import Utility.HumanTime
+import Utility.STM
 import qualified Git.Credential as Git
 
 import Servant hiding (BasicAuthData(..))
@@ -46,7 +47,6 @@ import Network.HTTP.Client
 import qualified Data.ByteString as B
 import qualified Data.ByteString.Lazy.Internal as LI
 import qualified Data.Map as M
-import Control.Concurrent.STM
 import Control.Concurrent.Async
 import Control.Concurrent
 import System.IO.Unsafe
@@ -533,11 +533,6 @@ clientKeepLocked lckid remoteuuid unablelock callback clientenv (ProtocolVersion
 		_ :<|> _ :<|> _ :<|>
 		_ :<|> _ :<|> _ :<|> _ :<|>
 		v3 :<|> v2 :<|> v1 :<|> v0 :<|> _ = client p2pHttpAPI
-
-#if ! MIN_VERSION_stm(2,5,1)
-	writeTMVar t new = tryTakeTMVar t >> putTMVar t new
-#endif
-
 #else
 clientKeepLocked _ _ _ _ = ()
 #endif
diff --git a/P2P/Http/Server.hs b/P2P/Http/Server.hs
index 8bc0284db4..f3f5a46219 100644
--- a/P2P/Http/Server.hs
+++ b/P2P/Http/Server.hs
@@ -32,13 +32,13 @@ import Annex.WorkerPool
 import Types.WorkerPool
 import Types.Direction
 import Utility.Metered
+import Utility.STM
 
 import Servant
 import qualified Servant.Types.SourceT as S
 import qualified Data.ByteString as B
 import qualified Data.ByteString.Lazy as L
 import qualified Data.ByteString.Lazy.Internal as LI
-import Control.Concurrent.STM
 import Control.Concurrent.Async
 import Control.Concurrent
 import System.IO.Unsafe
diff --git a/P2P/Http/State.hs b/P2P/Http/State.hs
index 6bd162b404..fdaaf44962 100644
--- a/P2P/Http/State.hs
+++ b/P2P/Http/State.hs
@@ -35,12 +35,12 @@ import Annex.Proxy
 import Annex.Cluster
 import qualified P2P.Proxy as Proxy
 import qualified Types.Remote as Remote
+import Utility.STM
 
 import Servant
 import qualified Data.Map.Strict as M
 import qualified Data.Set as S
 import Control.Concurrent.Async
-import Control.Concurrent.STM
 import Data.Time.Clock.POSIX
 
 data P2PHttpServerState = P2PHttpServerState
diff --git a/Utility/STM.hs b/Utility/STM.hs
new file mode 100644
index 0000000000..8d049b5b41
--- /dev/null
+++ b/Utility/STM.hs
@@ -0,0 +1,23 @@
+{- support for old versions of the stm package
+ -
+ - Copyright 2024 Joey Hess <id@joeyh.name>
+ -
+ - License: BSD-2-clause
+ -}
+
+{-# LANGUAGE CPP #-}
+{-# OPTIONS_GHC -fno-warn-tabs #-}
+
+module Utility.STM (
+	module Control.Concurrent.STM,
+#if ! MIN_VERSION_stm(2,5,1)
+	writeTMVar
+#endif
+) where
+
+import Control.Concurrent.STM
+
+#if ! MIN_VERSION_stm(2,5,1)
+writeTMVar :: TMVar t -> t -> STM ()
+writeTMVar t new = tryTakeTMVar t >> putTMVar t new
+#endif
diff --git a/git-annex.cabal b/git-annex.cabal
index a02bf948d3..306ea47bdf 100644
--- a/git-annex.cabal
+++ b/git-annex.cabal
@@ -1119,6 +1119,7 @@ Executable git-annex
     Utility.SshConfig
     Utility.SshHost
     Utility.StatelessOpenPGP
+    Utility.STM
     Utility.Su
     Utility.SystemDirectory
     Utility.Terminal