webapp: Can now add a new local repository, and make it sync with the main local repository.

This commit is contained in:
Joey Hess 2013-02-18 20:37:26 -04:00
parent 9b91ea425c
commit e598b78a69
8 changed files with 58 additions and 39 deletions

View file

@ -11,6 +11,7 @@ module Assistant.WebApp.Configurators.Local where
import Assistant.WebApp.Common
import Assistant.WebApp.Utility
import Assistant.WebApp.OtherRepos
import Assistant.MakeRemote
import Init
import qualified Git
@ -135,20 +136,35 @@ getFirstRepositoryR = page "Getting started" (Just Configuration) $ do
startFullAssistant $ T.unpack p
_ -> $(widgetFile "configurators/newrepository/first")
{- Adding a new, separate repository. -}
{- Adding a new local repository, which may be entirely separate, or may
- be connected to the current repository. -}
getNewRepositoryR :: Handler RepHtml
getNewRepositoryR = page "Add another repository" (Just Configuration) $ do
home <- liftIO myHomeDir
((res, form), enctype) <- lift $ runFormGet $ newRepositoryForm home
case res of
FormSuccess (RepositoryPath p) -> lift $ do
FormSuccess (RepositoryPath p) -> do
let path = T.unpack p
liftIO $ makeRepo path False
u <- liftIO $ initRepo True path Nothing
runAnnex () $ setStandardGroup u ClientGroup
lift $ runAnnex () $ setStandardGroup u ClientGroup
liftIO $ addAutoStart path
redirect $ SwitchToRepositoryR path
liftIO $ startAssistant path
askcombine u path
_ -> $(widgetFile "configurators/newrepository")
where
askcombine newrepouuid newrepopath = do
newrepo <- liftIO $ relHome newrepopath
mainrepo <- fromJust . relDir <$> lift getYesod
$(widgetFile "configurators/newrepository/combine")
getCombineRepositoryR :: FilePath -> UUID -> Handler RepHtml
getCombineRepositoryR newrepopath newrepouuid = do
r <- combineRepos newrepopath remotename
syncRemote r
redirect $ EditRepositoryR newrepouuid
where
remotename = takeFileName newrepopath
data RemovableDrive = RemovableDrive
{ diskFree :: Maybe Integer
@ -188,7 +204,7 @@ getAddDriveR = page "Add a removable drive" (Just Configuration) $ do
make mountpoint = do
liftIO $ makerepo dir
u <- liftIO $ initRepo False dir $ Just remotename
r <- addremote dir remotename
r <- combineRepos dir remotename
runAnnex () $ setStandardGroup u TransferGroup
syncRemote r
return u
@ -204,12 +220,15 @@ getAddDriveR = page "Add a removable drive" (Just Configuration) $ do
_ -> do
createDirectoryIfMissing True dir
makeRepo dir True
{- Each repository is made a remote of the other. -}
addremote dir name = runAnnex undefined $ do
hostname <- maybe "host" id <$> liftIO getHostname
hostlocation <- fromRepo Git.repoLocation
liftIO $ inDir dir $ void $ makeGitRemote hostname hostlocation
addRemote $ makeGitRemote name dir
{- Each repository is made a remote of the other.
- Next call syncRemote to get them in sync. -}
combineRepos :: FilePath -> String -> Handler Remote
combineRepos dir name = runAnnex undefined $ do
hostname <- maybe "host" id <$> liftIO getHostname
hostlocation <- fromRepo Git.repoLocation
liftIO $ inDir dir $ void $ makeGitRemote hostname hostlocation
addRemote $ makeGitRemote name dir
getEnableDirectoryR :: UUID -> Handler RepHtml
getEnableDirectoryR uuid = page "Enable a repository" (Just Configuration) $ do

View file

@ -43,14 +43,9 @@ listOtherRepos = do
-}
getSwitchToRepositoryR :: FilePath -> Handler RepHtml
getSwitchToRepositoryR repo = do
liftIO startassistant
url <- liftIO geturl
redirect url
liftIO $ startAssistant repo
redirect =<< liftIO geturl
where
startassistant = do
program <- readProgramFile
void $ forkIO $ void $ createProcess $
(proc program ["assistant"]) { cwd = Just repo }
geturl = do
r <- Git.Config.read =<< Git.Construct.fromPath repo
waiturl $ gitAnnexUrlFile r
@ -66,3 +61,9 @@ getSwitchToRepositoryR repo = do
delayed a = do
threadDelay 100000 -- 1/10th of a second
a
startAssistant :: FilePath -> IO ()
startAssistant repo = do
program <- readProgramFile
void $ forkIO $ void $ createProcess $
(proc program ["assistant"]) { cwd = Just repo }

View file

@ -20,6 +20,7 @@
/config/repository/new NewRepositoryR GET
/config/repository/switcher RepositorySwitcherR GET
/config/repository/switchto/#FilePath SwitchToRepositoryR GET
/config/repository/combine/#FilePath/#UUID CombineRepositoryR GET
/config/repository/edit/#UUID EditRepositoryR GET
/config/repository/edit/new/#UUID EditNewRepositoryR GET
/config/repository/edit/new/cloud/#UUID EditNewCloudRepositoryR GET