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

make LocalRepo a newtype

Browse source
This commit is contained in:
Joey Hess 2016-06-02 16:34:52 -04:00
parent 8452ea45ca
commit 67f50e9cdd
Failed to extract signature
5 changed files with 8 additions and 8 deletions
Download patch file Download diff file Expand all files Collapse all files

2
RemoteDaemon/Common.hs
View file

@ -30,7 +30,7 @@ liftAnnex (TransportHandle _ annexstate) a = do
return r return r
inLocalRepo :: TransportHandle -> (Git.Repo -> IO a) -> IO a inLocalRepo :: TransportHandle -> (Git.Repo -> IO a) -> IO a
inLocalRepo (TransportHandle g _) a = a g inLocalRepo (TransportHandle (LocalRepo g) _) a = a g
-- Check if any of the shas are actally new in the local git repo, -- Check if any of the shas are actally new in the local git repo,
-- to avoid unnecessary fetching. -- to avoid unnecessary fetching.

6
RemoteDaemon/Core.hs
View file

@ -111,7 +111,7 @@ runController ichan ochan = do
-- Generates a map with a transport for each supported remote in the git repo, -- Generates a map with a transport for each supported remote in the git repo,
-- except those that have annex.sync = false -- except those that have annex.sync = false
genRemoteMap :: TransportHandle -> TChan Emitted -> IO RemoteMap genRemoteMap :: TransportHandle -> TChan Emitted -> IO RemoteMap
genRemoteMap h@(TransportHandle g _) ochan = genRemoteMap h@(TransportHandle (LocalRepo g) _) ochan =
M.fromList . catMaybes <$> mapM gen (Git.remotes g) M.fromList . catMaybes <$> mapM gen (Git.remotes g)
where where
gen r = case Git.location r of gen r = case Git.location r of
@ -132,11 +132,11 @@ genTransportHandle :: IO TransportHandle
genTransportHandle = do genTransportHandle = do
annexstate <- newMVar =<< Annex.new =<< Git.CurrentRepo.get annexstate <- newMVar =<< Annex.new =<< Git.CurrentRepo.get
g <- Annex.repo <$> readMVar annexstate g <- Annex.repo <$> readMVar annexstate
return $ TransportHandle g annexstate return $ TransportHandle (LocalRepo g) annexstate
updateTransportHandle :: TransportHandle -> IO TransportHandle updateTransportHandle :: TransportHandle -> IO TransportHandle
updateTransportHandle h@(TransportHandle _g annexstate) = do updateTransportHandle h@(TransportHandle _g annexstate) = do
g' <- liftAnnex h $ do g' <- liftAnnex h $ do
reloadConfig reloadConfig
Annex.fromRepo id Annex.fromRepo id
return (TransportHandle g' annexstate) return (TransportHandle (LocalRepo g') annexstate)

2
RemoteDaemon/Transport/GCrypt.hs
View file

@ -16,7 +16,7 @@ import Remote.Helper.Ssh
import Remote.GCrypt (accessShellConfig) import Remote.GCrypt (accessShellConfig)
transport :: Transport transport :: Transport
transport rr@(RemoteRepo r gc) url h@(TransportHandle g _) ichan ochan transport rr@(RemoteRepo r gc) url h@(TransportHandle (LocalRepo g) _) ichan ochan
| accessShellConfig gc = do | accessShellConfig gc = do
r' <- encryptedRemote g r r' <- encryptedRemote g r
v <- liftAnnex h $ git_annex_shell r' "notifychanges" [] [] v <- liftAnnex h $ git_annex_shell r' "notifychanges" [] []

4
RemoteDaemon/Transport/Ssh.hs
View file

@ -29,10 +29,10 @@ transport rr@(RemoteRepo r _) url h ichan ochan = do
Just (cmd, params) -> transportUsingCmd cmd params rr url h ichan ochan Just (cmd, params) -> transportUsingCmd cmd params rr url h ichan ochan
transportUsingCmd :: FilePath -> [CommandParam] -> Transport transportUsingCmd :: FilePath -> [CommandParam] -> Transport
transportUsingCmd cmd params rr@(RemoteRepo r gc) url h@(TransportHandle g s) ichan ochan = do transportUsingCmd cmd params rr@(RemoteRepo r gc) url h@(TransportHandle (LocalRepo g) s) ichan ochan = do
-- enable ssh connection caching wherever inLocalRepo is called -- enable ssh connection caching wherever inLocalRepo is called
g' <- liftAnnex h $ sshOptionsTo r gc g g' <- liftAnnex h $ sshOptionsTo r gc g
let transporthandle = TransportHandle g' s let transporthandle = TransportHandle (LocalRepo g') s
transportUsingCmd' cmd params rr url transporthandle ichan ochan transportUsingCmd' cmd params rr url transporthandle ichan ochan
transportUsingCmd' :: FilePath -> [CommandParam] -> Transport transportUsingCmd' :: FilePath -> [CommandParam] -> Transport

2
RemoteDaemon/Types.hs
View file

@ -29,7 +29,7 @@ newtype RemoteURI = RemoteURI URI
type Transport = RemoteRepo -> RemoteURI -> TransportHandle -> TChan Consumed -> TChan Emitted -> IO () type Transport = RemoteRepo -> RemoteURI -> TransportHandle -> TChan Consumed -> TChan Emitted -> IO ()
data RemoteRepo = RemoteRepo Git.Repo RemoteGitConfig data RemoteRepo = RemoteRepo Git.Repo RemoteGitConfig
type LocalRepo = Git.Repo newtype LocalRepo = LocalRepo Git.Repo
-- All Transports share a single AnnexState MVar -- All Transports share a single AnnexState MVar
-- --