remove uses of warningIO
It's not concurrent-output safe, and doesn't support --json-error-messages. Using Annex.makeRunner is a bit scary, because what if it's run in a different thread from an active annex action? Normally the same Annex state is not used concurrently in several threads, and it's not designed to be fully concurrency safe. (Annex.Concurrent exists to deal with that.) I think it will be ok in these simple cases though. Eg, when buffering a warning message to json, Annex.changeState is used, and it modifies the MVar in a concurrency safe way. The only warningIO remaining is not a problem.
This commit is contained in:
parent
1858b65d88
commit
63839532c9
5 changed files with 28 additions and 22 deletions
|
@ -28,6 +28,7 @@ import Annex.Common
|
|||
import Types.Remote
|
||||
import Types.Export
|
||||
import qualified Git
|
||||
import qualified Annex
|
||||
import Config
|
||||
import Config.Cost
|
||||
import Annex.SpecialRemote.Config
|
||||
|
@ -139,8 +140,9 @@ webdavSetup _ mu mcreds c gc = do
|
|||
|
||||
store :: DavHandleVar -> ChunkConfig -> Storer
|
||||
store hv (LegacyChunks chunksize) = fileStorer $ \k f p ->
|
||||
withDavHandle hv $ \dav -> liftIO $
|
||||
withMeteredFile f p $ storeLegacyChunked chunksize k dav
|
||||
withDavHandle hv $ \dav -> do
|
||||
annexrunner <- Annex.makeRunner
|
||||
liftIO $ withMeteredFile f p $ storeLegacyChunked annexrunner chunksize k dav
|
||||
store hv _ = httpStorer $ \k reqbody ->
|
||||
withDavHandle hv $ \dav -> liftIO $ goDAV dav $ do
|
||||
let tmp = keyTmpLocation k
|
||||
|
@ -448,15 +450,15 @@ prepDAV user pass = do
|
|||
-- Legacy chunking code, to be removed eventually.
|
||||
--
|
||||
|
||||
storeLegacyChunked :: ChunkSize -> Key -> DavHandle -> L.ByteString -> IO ()
|
||||
storeLegacyChunked chunksize k dav b =
|
||||
storeLegacyChunked :: (Annex () -> IO ()) -> ChunkSize -> Key -> DavHandle -> L.ByteString -> IO ()
|
||||
storeLegacyChunked annexrunner chunksize k dav b =
|
||||
Legacy.storeChunks k tmp dest storer recorder finalizer
|
||||
where
|
||||
storehttp l b' = void $ goDAV dav $ do
|
||||
maybe noop (void . mkColRecursive) (locationParent l)
|
||||
debugDav $ "putContent " ++ l
|
||||
inLocation l $ putContentM (contentType, b')
|
||||
storer locs = Legacy.storeChunked chunksize locs storehttp b
|
||||
storer locs = Legacy.storeChunked annexrunner chunksize locs storehttp b
|
||||
recorder l s = storehttp l (L8.fromString s)
|
||||
finalizer tmp' dest' = goDAV dav $
|
||||
finalizeStore dav tmp' (fromJust $ locationParent dest')
|
||||
|
|
Loading…
Add table
Add a link
Reference in a new issue