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.
This commit is contained in:
Joey Hess 2024-10-17 20:55:31 -04:00
parent facde8bf85
commit b83fdf66df
No known key found for this signature in database
GPG key ID: DB12DB0FF05F8F38
5 changed files with 27 additions and 8 deletions

View file

@ -36,6 +36,7 @@ import P2P.Http.Url
import Annex.Concurrent import Annex.Concurrent
import Utility.Url (BasicAuth(..)) import Utility.Url (BasicAuth(..))
import Utility.HumanTime import Utility.HumanTime
import Utility.STM
import qualified Git.Credential as Git import qualified Git.Credential as Git
import Servant hiding (BasicAuthData(..)) import Servant hiding (BasicAuthData(..))
@ -46,7 +47,6 @@ import Network.HTTP.Client
import qualified Data.ByteString as B import qualified Data.ByteString as B
import qualified Data.ByteString.Lazy.Internal as LI import qualified Data.ByteString.Lazy.Internal as LI
import qualified Data.Map as M import qualified Data.Map as M
import Control.Concurrent.STM
import Control.Concurrent.Async import Control.Concurrent.Async
import Control.Concurrent import Control.Concurrent
import System.IO.Unsafe import System.IO.Unsafe
@ -533,11 +533,6 @@ clientKeepLocked lckid remoteuuid unablelock callback clientenv (ProtocolVersion
_ :<|> _ :<|> _ :<|> _ :<|> _ :<|> _ :<|>
_ :<|> _ :<|> _ :<|> _ :<|> _ :<|> _ :<|> _ :<|> _ :<|>
v3 :<|> v2 :<|> v1 :<|> v0 :<|> _ = client p2pHttpAPI v3 :<|> v2 :<|> v1 :<|> v0 :<|> _ = client p2pHttpAPI
#if ! MIN_VERSION_stm(2,5,1)
writeTMVar t new = tryTakeTMVar t >> putTMVar t new
#endif
#else #else
clientKeepLocked _ _ _ _ = () clientKeepLocked _ _ _ _ = ()
#endif #endif

View file

@ -32,13 +32,13 @@ import Annex.WorkerPool
import Types.WorkerPool import Types.WorkerPool
import Types.Direction import Types.Direction
import Utility.Metered import Utility.Metered
import Utility.STM
import Servant import Servant
import qualified Servant.Types.SourceT as S import qualified Servant.Types.SourceT as S
import qualified Data.ByteString as B import qualified Data.ByteString as B
import qualified Data.ByteString.Lazy as L import qualified Data.ByteString.Lazy as L
import qualified Data.ByteString.Lazy.Internal as LI import qualified Data.ByteString.Lazy.Internal as LI
import Control.Concurrent.STM
import Control.Concurrent.Async import Control.Concurrent.Async
import Control.Concurrent import Control.Concurrent
import System.IO.Unsafe import System.IO.Unsafe

View file

@ -35,12 +35,12 @@ import Annex.Proxy
import Annex.Cluster import Annex.Cluster
import qualified P2P.Proxy as Proxy import qualified P2P.Proxy as Proxy
import qualified Types.Remote as Remote import qualified Types.Remote as Remote
import Utility.STM
import Servant import Servant
import qualified Data.Map.Strict as M import qualified Data.Map.Strict as M
import qualified Data.Set as S import qualified Data.Set as S
import Control.Concurrent.Async import Control.Concurrent.Async
import Control.Concurrent.STM
import Data.Time.Clock.POSIX import Data.Time.Clock.POSIX
data P2PHttpServerState = P2PHttpServerState data P2PHttpServerState = P2PHttpServerState

23
Utility/STM.hs Normal file
View file

@ -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

View file

@ -1119,6 +1119,7 @@ Executable git-annex
Utility.SshConfig Utility.SshConfig
Utility.SshHost Utility.SshHost
Utility.StatelessOpenPGP Utility.StatelessOpenPGP
Utility.STM
Utility.Su Utility.Su
Utility.SystemDirectory Utility.SystemDirectory
Utility.Terminal Utility.Terminal