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

make other repositories list list all autostarted repos

Browse source 
And add a form to add another, unrelated repository
This commit is contained in:
Joey Hess 2012-09-18 17:50:07 -04:00
parent 467844d7d3
commit 18bae020ed
15 changed files with 166 additions and 38 deletions
Download patch file Download diff file Expand all files Collapse all files

35
Assistant/WebApp/Configurators/Local.hs
View file

@ -104,30 +104,47 @@ defaultRepositoryPath firstrun = do
)
else return cwd
firstRepositoryForm :: Form RepositoryPath
firstRepositoryForm msg = do
path <- T.pack . addTrailingPathSeparator
<$> (liftIO . defaultRepositoryPath =<< lift inFirstRun)
(pathRes, pathView) <- mreq (repositoryPathField True) "" (Just path)
newRepositoryForm :: FilePath -> Form RepositoryPath
newRepositoryForm defpath msg = do
(pathRes, pathView) <- mreq (repositoryPathField True) ""
(Just $ T.pack $ addTrailingPathSeparator defpath)
let (err, errmsg) = case pathRes of
FormMissing -> (False, "")
FormFailure l -> (True, concat $ map T.unpack l)
FormSuccess _ -> (False, "")
let form = do
webAppFormAuthToken
$(widgetFile "configurators/firstrepository/form")
$(widgetFile "configurators/newrepository/form")
return (RepositoryPath <$> pathRes, form)
{- Making the first repository, when starting the webapp for the first time. -}
getFirstRepositoryR :: Handler RepHtml
getFirstRepositoryR = bootstrap (Just Config) $ do
sideBarDisplay
setTitle "Getting started"
((res, form), enctype) <- lift $ runFormGet firstRepositoryForm
setTitle "Getting started"
path <- liftIO . defaultRepositoryPath =<< lift inFirstRun
((res, form), enctype) <- lift $ runFormGet $ newRepositoryForm path
case res of
FormSuccess (RepositoryPath p) -> lift $
startFullAssistant $ T.unpack p
_ -> $(widgetFile "configurators/firstrepository")
_ -> $(widgetFile "configurators/newrepository/first")
{- Adding a new, separate repository. -}
getNewRepositoryR :: Handler RepHtml
getNewRepositoryR = bootstrap (Just Config) $ do
sideBarDisplay
setTitle "Add another repository"
home <- liftIO myHomeDir
((res, form), enctype) <- lift $ runFormGet $ newRepositoryForm home
case res of
FormSuccess (RepositoryPath p) -> lift $ do
let path = T.unpack p
liftIO $ do
makeRepo path False
initRepo path Nothing
addAutoStart path
redirect $ SwitchToRepositoryR path
_ -> $(widgetFile "configurators/newrepository")
data RemovableDrive = RemovableDrive
{ diskFree :: Maybe Integer