mirrors/git-annex
2
0
Fork 0
Code Issues Pull requests Projects Releases Packages 1 Wiki Activity Actions

remove Preparer abstraction

Browse source 
That had almost no benefit at all, and complicated things quite a lot.

What I proably wanted this to be was something like ResourceT, but it
was not. The few remotes that actually need some preparation done only
once and reused used a MVar and not Preparer.
This commit is contained in:
Joey Hess 2020-05-13 11:50:31 -04:00
parent 49bf7c8403
commit b50ee9cd0c
No known key found for this signature in database
GPG key ID: DB12DB0FF05F8F38
15 changed files with 93 additions and 122 deletions
Download patch file Download diff file Expand all files Collapse all files

37
Remote/Glacier.hs
View file

@ -65,10 +65,10 @@ gen r u rc gc rs = new
<*> remoteCost gc veryExpensiveRemoteCost
where
new c cst = Just $ specialRemote' specialcfg c
(prepareStore this)
(prepareRetrieve this)
(simplyPrepare $ remove this)
(simplyPrepare $ checkKey this)
(store this)
(retrieve this)
(remove this)
(checkKey this)
this
where
this = Remote
@ -136,18 +136,19 @@ glacierSetup' ss u mcreds c gc = do
, (vaultField, Proposed defvault)
]
prepareStore :: Remote -> Preparer Storer
prepareStore r = checkPrepare nonEmpty (byteStorer $ store r)
store :: Remote -> Storer
store r k b p = do
checkNonEmpty k
byteStorer (store' r) k b p
nonEmpty :: Key -> Annex Bool
nonEmpty k
| fromKey keySize k == Just 0 = do
warning "Cannot store empty files in Glacier."
return False
| otherwise = return True
checkNonEmpty :: Key -> Annex ()
checkNonEmpty k
| fromKey keySize k == Just 0 =
giveup "Cannot store empty files in Glacier."
| otherwise = return ()
store :: Remote -> Key -> L.ByteString -> MeterUpdate -> Annex Bool
store r k b p = go =<< glacierEnv c gc u
store' :: Remote -> Key -> L.ByteString -> MeterUpdate -> Annex Bool
store' r k b p = go =<< glacierEnv c gc u
where
c = config r
gc = gitconfig r
@ -167,11 +168,11 @@ store r k b p = go =<< glacierEnv c gc u
meteredWrite p h b
return True
prepareRetrieve :: Remote -> Preparer Retriever
prepareRetrieve = simplyPrepare . byteRetriever . retrieve
retrieve :: Remote -> Retriever
retrieve = byteRetriever . retrieve'
retrieve :: Remote -> Key -> (L.ByteString -> Annex Bool) -> Annex Bool
retrieve r k sink = go =<< glacierEnv c gc u
retrieve' :: Remote -> Key -> (L.ByteString -> Annex Bool) -> Annex Bool
retrieve' r k sink = go =<< glacierEnv c gc u
where
c = config r
gc = gitconfig r