sup39/vervis
1
0
Fork 0
mirror of https://code.sup39.dev/repos/Wqawg synced 2024-12-28 09:34:51 +09:00
Code Issues Activity

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

Browse source
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
Show stats Download patch file Download diff file Expand all files Collapse all files

10
src/Vervis/Form/Repo.hs
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

20
src/Vervis/Handler/Repo.hs
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 ->
parent <- askSharerDir user case repoVcs repo of
liftIO $ do VCSDarcs -> error "Darcs not supported yet"
createDirectoryIfMissing True parent VCSGit -> do
initRepo parent (unpack $ repoIdent repo) parent <- askSharerDir user
runDB $ insert_ repo liftIO $ do
setMessage "Repo added." createDirectoryIfMissing True parent
redirectUltDest HomeR initRepo parent (unpack $ repoIdent repo)
runDB $ insert_ repo
setMessage "Repo added."
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")