From b68c7d9c0fd13df235788bc37c3df67e7595a092 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Mon, 10 Nov 2014 12:06:29 -0400 Subject: merge from git-annex --- Git/Remote.hs | 13 ------------- Utility/Metered.hs | 34 ++++++++++++++++++++++------------ Utility/UserInfo.hs | 20 ++++++++++++-------- 3 files changed, 34 insertions(+), 33 deletions(-) diff --git a/Git/Remote.hs b/Git/Remote.hs index 7e8e5f8..156e308 100644 --- a/Git/Remote.hs +++ b/Git/Remote.hs @@ -12,8 +12,6 @@ module Git.Remote where import Common import Git import Git.Types -import qualified Git.Command -import qualified Git.BuildVersion import Data.Char import qualified Data.Map as M @@ -44,17 +42,6 @@ makeLegalName s = case filter legal $ replace "/" "_" s of legal '.' = True legal c = isAlphaNum c -remove :: RemoteName -> Repo -> IO () -remove remotename = Git.Command.run - [ Param "remote" - -- name of this subcommand changed - , Param $ - if Git.BuildVersion.older "1.8.0" - then "rm" - else "remove" - , Param remotename - ] - data RemoteLocation = RemoteUrl String | RemotePath FilePath remoteLocationIsUrl :: RemoteLocation -> Bool diff --git a/Utility/Metered.hs b/Utility/Metered.hs index 4618aec..f27eee2 100644 --- a/Utility/Metered.hs +++ b/Utility/Metered.hs @@ -98,34 +98,44 @@ offsetMeterUpdate base offset = \n -> base (offset `addBytesProcessed` n) {- This is like L.hGetContents, but after each chunk is read, a meter - is updated based on the size of the chunk. + - + - All the usual caveats about using unsafeInterleaveIO apply to the + - meter updates, so use caution. + -} +hGetContentsMetered :: Handle -> MeterUpdate -> IO L.ByteString +hGetContentsMetered h = hGetUntilMetered h (const True) + +{- Reads from the Handle, updating the meter after each chunk. - - Note that the meter update is run in unsafeInterleaveIO, which means that - it can be run at any time. It's even possible for updates to run out - of order, as different parts of the ByteString are consumed. - - - All the usual caveats about using unsafeInterleaveIO apply to the - - meter updates, so use caution. + - Stops at EOF, or when keepgoing evaluates to False. + - Closes the Handle at EOF, but otherwise leaves it open. -} -hGetContentsMetered :: Handle -> MeterUpdate -> IO L.ByteString -hGetContentsMetered h meterupdate = lazyRead zeroBytesProcessed +hGetUntilMetered :: Handle -> (Integer -> Bool) -> MeterUpdate -> IO L.ByteString +hGetUntilMetered h keepgoing meterupdate = lazyRead zeroBytesProcessed where lazyRead sofar = unsafeInterleaveIO $ loop sofar loop sofar = do - c <- S.hGetSome h defaultChunkSize + c <- S.hGet h defaultChunkSize if S.null c then do hClose h return $ L.empty else do - let sofar' = addBytesProcessed sofar $ - S.length c + let sofar' = addBytesProcessed sofar (S.length c) meterupdate sofar' - {- unsafeInterleaveIO causes this to be - - deferred until the data is read from the - - ByteString. -} - cs <- lazyRead sofar' - return $ L.append (L.fromChunks [c]) cs + if keepgoing (fromBytesProcessed sofar') + then do + {- unsafeInterleaveIO causes this to be + - deferred until the data is read from the + - ByteString. -} + cs <- lazyRead sofar' + return $ L.append (L.fromChunks [c]) cs + else return $ L.fromChunks [c] {- Same default chunk size Lazy ByteStrings use. -} defaultChunkSize :: Int diff --git a/Utility/UserInfo.hs b/Utility/UserInfo.hs index 617c3e9..1a557c9 100644 --- a/Utility/UserInfo.hs +++ b/Utility/UserInfo.hs @@ -40,16 +40,20 @@ myUserName = myVal env userName env = ["USERNAME", "USER", "LOGNAME"] #endif -myUserGecos :: IO String -#ifdef __ANDROID__ -myUserGecos = return "" -- userGecos crashes on Android +myUserGecos :: IO (Maybe String) +-- userGecos crashes on Android and is not available on Windows. +#if defined(__ANDROID__) || defined(mingw32_HOST_OS) +myUserGecos = return Nothing #else -myUserGecos = myVal [] userGecos +myUserGecos = Just <$> myVal [] userGecos #endif myVal :: [String] -> (UserEntry -> String) -> IO String -myVal envvars extract = maybe (extract <$> getpwent) return =<< check envvars +myVal envvars extract = go envvars where - check [] = return Nothing - check (v:vs) = maybe (check vs) (return . Just) =<< getEnv v - getpwent = getUserEntryForID =<< getEffectiveUserID +#ifndef mingw32_HOST_OS + go [] = extract <$> (getUserEntryForID =<< getEffectiveUserID) +#else + go [] = error $ "environment not set: " ++ show envvars +#endif + go (v:vs) = maybe (go vs) return =<< getEnv v -- cgit v1.2.3