1
0
Fork 0
mirror of https://code.sup39.dev/repos/Wqawg synced 2024-12-29 00:44:52 +09:00

Let user choose VCS and fail to create repo if Darcs is chosen

This commit is contained in:
fr33domlover 2016-05-03 00:33:49 +00:00
parent d69c5e8abc
commit 4dd4e1b932
2 changed files with 21 additions and 9 deletions

View file

@ -18,6 +18,8 @@ module Vervis.Form.Repo
) )
where where
--import Prelude
import Vervis.Import import Vervis.Import
import Vervis.Field.Repo import Vervis.Field.Repo
import Vervis.Model.Repo import Vervis.Model.Repo
@ -26,10 +28,16 @@ newRepoAForm :: SharerId -> AForm Handler Repo
newRepoAForm sid = Repo newRepoAForm sid = Repo
<$> areq (mkIdentField sid) "Identifier*" Nothing <$> areq (mkIdentField sid) "Identifier*" Nothing
<*> pure sid <*> pure sid
<*> pure VCSGit <*> areq (selectFieldList vcsList) "Version control system*" Nothing
<*> pure Nothing <*> pure Nothing
<*> aopt textField "Description" Nothing <*> aopt textField "Description" Nothing
<*> pure "master" <*> pure "master"
where
vcsList :: [(Text, VersionControlSystem)]
vcsList =
[ ("Darcs", VCSDarcs)
, ("Git" , VCSGit)
]
newRepoForm :: SharerId -> Form Repo newRepoForm :: SharerId -> Form Repo
newRepoForm = renderDivs . newRepoAForm newRepoForm = renderDivs . newRepoAForm

View file

@ -72,6 +72,7 @@ import Vervis.Git (timeAgo')
import Vervis.Path import Vervis.Path
import Vervis.MediaType (chooseMediaType) import Vervis.MediaType (chooseMediaType)
import Vervis.Model import Vervis.Model
import Vervis.Model.Repo
import Vervis.Readme import Vervis.Readme
import Vervis.Render import Vervis.Render
import Vervis.Settings import Vervis.Settings
@ -96,14 +97,17 @@ postReposR user = do
let sid = personIdent person let sid = personIdent person
((result, widget), enctype) <- runFormPost $ newRepoForm sid ((result, widget), enctype) <- runFormPost $ newRepoForm sid
case result of case result of
FormSuccess repo -> do FormSuccess repo ->
case repoVcs repo of
VCSDarcs -> error "Darcs not supported yet"
VCSGit -> do
parent <- askSharerDir user parent <- askSharerDir user
liftIO $ do liftIO $ do
createDirectoryIfMissing True parent createDirectoryIfMissing True parent
initRepo parent (unpack $ repoIdent repo) initRepo parent (unpack $ repoIdent repo)
runDB $ insert_ repo runDB $ insert_ repo
setMessage "Repo added." setMessage "Repo added."
redirectUltDest HomeR redirect $ ReposR user
FormMissing -> do FormMissing -> do
setMessage "Field(s) missing" setMessage "Field(s) missing"
defaultLayout $(widgetFile "repo/repo-new") defaultLayout $(widgetFile "repo/repo-new")