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:
parent
d69c5e8abc
commit
4dd4e1b932
2 changed files with 21 additions and 9 deletions
|
@ -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
|
||||||
|
|
|
@ -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")
|
||||||
|
|
Loading…
Reference in a new issue