avoid unncessary IO
This commit is contained in:
parent
ecf7ef3ff2
commit
52e40970c8
6 changed files with 15 additions and 17 deletions
|
@ -66,10 +66,9 @@ global = do
|
||||||
home <- myHomeDir
|
home <- myHomeDir
|
||||||
ifM (doesFileExist $ home </> ".gitconfig")
|
ifM (doesFileExist $ home </> ".gitconfig")
|
||||||
( do
|
( do
|
||||||
repo <- Git.Construct.fromUnknown
|
repo <- withHandle StdoutHandle createProcessSuccess p $
|
||||||
repo' <- withHandle StdoutHandle createProcessSuccess p $
|
hRead (Git.Construct.fromUnknown)
|
||||||
hRead repo
|
return $ Just repo
|
||||||
return $ Just repo'
|
|
||||||
, return Nothing
|
, return Nothing
|
||||||
)
|
)
|
||||||
where
|
where
|
||||||
|
|
|
@ -19,8 +19,8 @@ module Git.Construct (
|
||||||
fromRemotes,
|
fromRemotes,
|
||||||
fromRemoteLocation,
|
fromRemoteLocation,
|
||||||
repoAbsPath,
|
repoAbsPath,
|
||||||
newFrom,
|
|
||||||
checkForRepo,
|
checkForRepo,
|
||||||
|
newFrom,
|
||||||
) where
|
) where
|
||||||
|
|
||||||
#ifndef mingw32_HOST_OS
|
#ifndef mingw32_HOST_OS
|
||||||
|
@ -48,7 +48,7 @@ fromCwd = getCurrentDirectory >>= seekUp
|
||||||
Nothing -> case upFrom dir of
|
Nothing -> case upFrom dir of
|
||||||
Nothing -> return Nothing
|
Nothing -> return Nothing
|
||||||
Just d -> seekUp d
|
Just d -> seekUp d
|
||||||
Just loc -> Just <$> newFrom loc
|
Just loc -> pure $ Just $ newFrom loc
|
||||||
|
|
||||||
{- Local Repo constructor, accepts a relative or absolute path. -}
|
{- Local Repo constructor, accepts a relative or absolute path. -}
|
||||||
fromPath :: FilePath -> IO Repo
|
fromPath :: FilePath -> IO Repo
|
||||||
|
@ -62,7 +62,7 @@ fromAbsPath dir
|
||||||
| otherwise =
|
| otherwise =
|
||||||
error $ "internal error, " ++ dir ++ " is not absolute"
|
error $ "internal error, " ++ dir ++ " is not absolute"
|
||||||
where
|
where
|
||||||
ret = newFrom . LocalUnknown
|
ret = pure . newFrom . LocalUnknown
|
||||||
{- Git always looks for "dir.git" in preference to
|
{- Git always looks for "dir.git" in preference to
|
||||||
- to "dir", even if dir ends in a "/". -}
|
- to "dir", even if dir ends in a "/". -}
|
||||||
canondir = dropTrailingPathSeparator dir
|
canondir = dropTrailingPathSeparator dir
|
||||||
|
@ -90,13 +90,13 @@ fromUrl url
|
||||||
fromUrlStrict :: String -> IO Repo
|
fromUrlStrict :: String -> IO Repo
|
||||||
fromUrlStrict url
|
fromUrlStrict url
|
||||||
| startswith "file://" url = fromAbsPath $ unEscapeString $ uriPath u
|
| startswith "file://" url = fromAbsPath $ unEscapeString $ uriPath u
|
||||||
| otherwise = newFrom $ Url u
|
| otherwise = pure $ newFrom $ Url u
|
||||||
where
|
where
|
||||||
u = fromMaybe bad $ parseURI url
|
u = fromMaybe bad $ parseURI url
|
||||||
bad = error $ "bad url " ++ url
|
bad = error $ "bad url " ++ url
|
||||||
|
|
||||||
{- Creates a repo that has an unknown location. -}
|
{- Creates a repo that has an unknown location. -}
|
||||||
fromUnknown :: IO Repo
|
fromUnknown :: Repo
|
||||||
fromUnknown = newFrom Unknown
|
fromUnknown = newFrom Unknown
|
||||||
|
|
||||||
{- Converts a local Repo into a remote repo, using the reference repo
|
{- Converts a local Repo into a remote repo, using the reference repo
|
||||||
|
@ -223,8 +223,8 @@ checkForRepo dir =
|
||||||
gitdirprefix = "gitdir: "
|
gitdirprefix = "gitdir: "
|
||||||
gitSignature file = doesFileExist $ dir </> file
|
gitSignature file = doesFileExist $ dir </> file
|
||||||
|
|
||||||
newFrom :: RepoLocation -> IO Repo
|
newFrom :: RepoLocation -> Repo
|
||||||
newFrom l = return Repo
|
newFrom l = Repo
|
||||||
{ location = l
|
{ location = l
|
||||||
, config = M.empty
|
, config = M.empty
|
||||||
, fullconfig = M.empty
|
, fullconfig = M.empty
|
||||||
|
@ -234,4 +234,3 @@ newFrom l = return Repo
|
||||||
, gitGlobalOpts = []
|
, gitGlobalOpts = []
|
||||||
}
|
}
|
||||||
|
|
||||||
|
|
||||||
|
|
|
@ -50,8 +50,8 @@ get = do
|
||||||
configure (Just d) _ = do
|
configure (Just d) _ = do
|
||||||
absd <- absPath d
|
absd <- absPath d
|
||||||
curr <- getCurrentDirectory
|
curr <- getCurrentDirectory
|
||||||
r <- newFrom $ Local { gitdir = absd, worktree = Just curr }
|
Git.Config.read $ newFrom $
|
||||||
Git.Config.read r
|
Local { gitdir = absd, worktree = Just curr }
|
||||||
configure Nothing Nothing = error "Not in a git repository."
|
configure Nothing Nothing = error "Not in a git repository."
|
||||||
|
|
||||||
addworktree w r = changelocation r $
|
addworktree w r = changelocation r $
|
||||||
|
|
|
@ -44,7 +44,7 @@ remote = RemoteType {
|
||||||
-- There is only one bittorrent remote, and it always exists.
|
-- There is only one bittorrent remote, and it always exists.
|
||||||
list :: Annex [Git.Repo]
|
list :: Annex [Git.Repo]
|
||||||
list = do
|
list = do
|
||||||
r <- liftIO $ Git.Construct.remoteNamed "bittorrent" Git.Construct.fromUnknown
|
r <- liftIO $ Git.Construct.remoteNamed "bittorrent" (pure Git.Construct.fromUnknown)
|
||||||
return [r]
|
return [r]
|
||||||
|
|
||||||
gen :: Git.Repo -> UUID -> RemoteConfig -> RemoteGitConfig -> Annex (Maybe Remote)
|
gen :: Git.Repo -> UUID -> RemoteConfig -> RemoteGitConfig -> Annex (Maybe Remote)
|
||||||
|
|
|
@ -59,7 +59,7 @@ findSpecialRemotes s = do
|
||||||
liftIO $ mapM construct $ remotepairs m
|
liftIO $ mapM construct $ remotepairs m
|
||||||
where
|
where
|
||||||
remotepairs = M.toList . M.filterWithKey match
|
remotepairs = M.toList . M.filterWithKey match
|
||||||
construct (k,_) = Git.Construct.remoteNamedFromKey k Git.Construct.fromUnknown
|
construct (k,_) = Git.Construct.remoteNamedFromKey k (pure Git.Construct.fromUnknown)
|
||||||
match k _ = startswith "remote." k && endswith (".annex-"++s) k
|
match k _ = startswith "remote." k && endswith (".annex-"++s) k
|
||||||
|
|
||||||
{- Sets up configuration for a special remote in .git/config. -}
|
{- Sets up configuration for a special remote in .git/config. -}
|
||||||
|
|
|
@ -38,7 +38,7 @@ remote = RemoteType {
|
||||||
-- a new release to the survivors by carrier pigeon.)
|
-- a new release to the survivors by carrier pigeon.)
|
||||||
list :: Annex [Git.Repo]
|
list :: Annex [Git.Repo]
|
||||||
list = do
|
list = do
|
||||||
r <- liftIO $ Git.Construct.remoteNamed "web" Git.Construct.fromUnknown
|
r <- liftIO $ Git.Construct.remoteNamed "web" (pure Git.Construct.fromUnknown)
|
||||||
return [r]
|
return [r]
|
||||||
|
|
||||||
gen :: Git.Repo -> UUID -> RemoteConfig -> RemoteGitConfig -> Annex (Maybe Remote)
|
gen :: Git.Repo -> UUID -> RemoteConfig -> RemoteGitConfig -> Annex (Maybe Remote)
|
||||||
|
|
Loading…
Add table
Add a link
Reference in a new issue