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

avoid head

Browse source 
Recent ghc has a deprecation warning on it.

This is not an improvement though. I know these cannot fail, but I can't
prove it to ghc.
This commit is contained in:
Joey Hess 2024-09-26 17:52:19 -04:00
parent 30713ab0d3
commit c8fcd97626
No known key found for this signature in database
GPG key ID: DB12DB0FF05F8F38
2 changed files with 5 additions and 3 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

5
Assistant/WebApp/Pairing.hs
View file

@ -35,8 +35,9 @@ newWormholePairingState = newTVarIO M.empty
addWormholePairingState :: WormholePairingHandle -> WormholePairingState -> IO WormholePairingId addWormholePairingState :: WormholePairingHandle -> WormholePairingState -> IO WormholePairingId
addWormholePairingState h tv = atomically $ do addWormholePairingState h tv = atomically $ do
m <- readTVar tv m <- readTVar tv
-- use of head is safe because allids is infinite -- safe because allids is infinite
let i = Prelude.head $ filter (`notElem` M.keys m) allids let i = fromMaybe (error "internal") $
headMaybe $ filter (`notElem` M.keys m) allids
writeTVar tv (M.insert i h m) writeTVar tv (M.insert i h m)
return i return i
where where

3
Remote.hs
View file

@ -473,7 +473,8 @@ claimingUrl = claimingUrl' (const True)
claimingUrl' :: (Remote -> Bool) -> URLString -> Annex Remote claimingUrl' :: (Remote -> Bool) -> URLString -> Annex Remote
claimingUrl' remotefilter url = do claimingUrl' remotefilter url = do
rs <- remoteList rs <- remoteList
let web = Prelude.head $ filter (\r -> uuid r == webUUID) rs let web = fromMaybe (error "internal") $ headMaybe $
filter (\r -> uuid r == webUUID) rs
fromMaybe web <$> firstM checkclaim (filter remotefilter rs) fromMaybe web <$> firstM checkclaim (filter remotefilter rs)
where where
checkclaim = maybe (pure False) (`id` url) . claimUrl checkclaim = maybe (pure False) (`id` url) . claimUrl