Internet Archive!

* Add public repository group.
* webapp: Can now set up Internet Archive repositories.

TODO: Enabling IA repositories.
This commit is contained in:
Joey Hess 2013-04-25 12:23:36 -04:00
parent 04d8a26afe
commit 2810807ca5
16 changed files with 248 additions and 27 deletions

View file

@ -147,12 +147,12 @@ editForm :: Bool -> UUID -> Handler RepHtml
editForm new uuid = page "Configure repository" (Just Configuration) $ do
mremote <- liftAnnex $ Remote.remoteFromUUID uuid
curr <- liftAnnex $ getRepoConfig uuid mremote
lift $ checkarchivedirectory curr
lift $ checkdirectories curr
((result, form), enctype) <- lift $
runFormPost $ renderBootstrap $ editRepositoryAForm curr
case result of
FormSuccess input -> lift $ do
checkarchivedirectory input
checkdirectories input
setRepoConfig uuid mremote curr input
redirect DashboardR
_ -> showform form enctype curr
@ -161,16 +161,17 @@ editForm new uuid = page "Configure repository" (Just Configuration) $ do
let istransfer = repoGroup curr == RepoGroupStandard TransferGroup
$(widgetFile "configurators/editrepository")
{- Makes a toplevel archive directory, so the user can get on with
- using it. This is done both when displaying the form, as well
- as after it's posted, because the user may not post the form,
{- Makes a toplevel archive or public directory, so the user can
- get on with using it. This is done both when displaying the form,
- as well as after it's posted, because the user may not post the form,
- but may see that the repo is set up to use the archive
- directory. -}
checkarchivedirectory cfg
| repoGroup cfg == RepoGroupStandard SmallArchiveGroup = go
| repoGroup cfg == RepoGroupStandard FullArchiveGroup = go
checkdirectories cfg
| repoGroup cfg == RepoGroupStandard SmallArchiveGroup = go "archive"
| repoGroup cfg == RepoGroupStandard FullArchiveGroup = go "archive"
| repoGroup cfg == RepoGroupStandard PublicGroup = go "public"
| otherwise = noop
where
go = liftAnnex $ inRepo $ \g ->
go d = liftAnnex $ inRepo $ \g ->
createDirectoryIfMissing True $
Git.repoPath g </> "archive"
Git.repoPath g </> d