convert from readFileStrict
This removes that function, using file-io readFile' instead. Had to deal with newline conversion, which readFileStrict does on Windows. In a few cases, that was pretty ugly to deal with. Sponsored-by: Kevin Mueller
This commit is contained in:
parent
de1af273e0
commit
6e27b0d4d1
19 changed files with 94 additions and 71 deletions
|
@ -26,6 +26,7 @@ import Utility.FileMode
|
|||
import Utility.ThreadScheduler
|
||||
import Utility.SafeOutput
|
||||
import qualified Utility.RawFilePath as R
|
||||
import qualified Utility.FileIO as F
|
||||
import qualified Utility.MagicWormhole as Wormhole
|
||||
|
||||
import Control.Concurrent.Async
|
||||
|
@ -193,12 +194,11 @@ serializePairData :: PairData -> String
|
|||
serializePairData (PairData (HalfAuthToken ha) addrs) = unlines $
|
||||
T.unpack ha : map formatP2PAddress addrs
|
||||
|
||||
deserializePairData :: String -> Maybe PairData
|
||||
deserializePairData s = case lines s of
|
||||
[] -> Nothing
|
||||
(ha:l) -> do
|
||||
addrs <- mapM unformatP2PAddress l
|
||||
return (PairData (HalfAuthToken (T.pack ha)) addrs)
|
||||
deserializePairData :: [String] -> Maybe PairData
|
||||
deserializePairData [] = Nothing
|
||||
deserializePairData (ha:l) = do
|
||||
addrs <- mapM unformatP2PAddress l
|
||||
return (PairData (HalfAuthToken (T.pack ha)) addrs)
|
||||
|
||||
data PairingResult
|
||||
= PairSuccess
|
||||
|
@ -245,13 +245,14 @@ wormholePairing remotename ouraddrs ui = do
|
|||
then return ReceiveFailed
|
||||
else do
|
||||
r <- liftIO $ tryIO $
|
||||
readFileStrict recvf
|
||||
map decodeBS . fileLines' <$> F.readFile'
|
||||
(toOsPath (toRawFilePath recvf))
|
||||
case r of
|
||||
Left _e -> return ReceiveFailed
|
||||
Right s -> maybe
|
||||
Right ls -> maybe
|
||||
(return ReceiveFailed)
|
||||
(finishPairing 100 remotename ourhalf)
|
||||
(deserializePairData s)
|
||||
(deserializePairData ls)
|
||||
|
||||
-- | Allow the peer we're pairing with to authenticate to us,
|
||||
-- using an authtoken constructed from the two HalfAuthTokens.
|
||||
|
|
|
@ -35,6 +35,7 @@ import Remote
|
|||
import Git.Types (fromConfigKey, fromConfigValue)
|
||||
import Utility.DataUnits
|
||||
import qualified Utility.RawFilePath as R
|
||||
import qualified Utility.FileIO as F
|
||||
|
||||
cmd :: Command
|
||||
cmd = command "vicfg" SectionSetup "edit configuration in git-annex branch"
|
||||
|
@ -60,7 +61,10 @@ vicfg curcfg f = do
|
|||
-- Allow EDITOR to be processed by the shell, so it can contain options.
|
||||
unlessM (liftIO $ boolSystem "sh" [Param "-c", Param $ unwords [vi, shellEscape f]]) $
|
||||
giveup $ vi ++ " exited nonzero; aborting"
|
||||
r <- parseCfg (defCfg curcfg) <$> liftIO (readFileStrict f)
|
||||
r <- liftIO $ parseCfg (defCfg curcfg)
|
||||
. map decodeBS
|
||||
. fileLines'
|
||||
<$> F.readFile' (toOsPath (toRawFilePath f))
|
||||
liftIO $ removeWhenExistsWith R.removeLink (toRawFilePath f)
|
||||
case r of
|
||||
Left s -> do
|
||||
|
@ -278,8 +282,8 @@ lcom = map (\l -> if "#" `isPrefixOf` l then l else '#' : l)
|
|||
|
||||
{- If there's a parse error, returns a new version of the file,
|
||||
- with the problem lines noted. -}
|
||||
parseCfg :: Cfg -> String -> Either String Cfg
|
||||
parseCfg defcfg = go [] defcfg . lines
|
||||
parseCfg :: Cfg -> [String] -> Either String Cfg
|
||||
parseCfg defcfg = go [] defcfg
|
||||
where
|
||||
go c cfg []
|
||||
| null (mapMaybe fst c) = Right cfg
|
||||
|
|
Loading…
Add table
Add a link
Reference in a new issue