diff --git a/src/Vervis/Form/Repo.hs b/src/Vervis/Form/Repo.hs index 20a93ed..04397ea 100644 --- a/src/Vervis/Form/Repo.hs +++ b/src/Vervis/Form/Repo.hs @@ -18,6 +18,8 @@ module Vervis.Form.Repo ) where +--import Prelude + import Vervis.Import import Vervis.Field.Repo import Vervis.Model.Repo @@ -26,10 +28,16 @@ newRepoAForm :: SharerId -> AForm Handler Repo newRepoAForm sid = Repo <$> areq (mkIdentField sid) "Identifier*" Nothing <*> pure sid - <*> pure VCSGit + <*> areq (selectFieldList vcsList) "Version control system*" Nothing <*> pure Nothing <*> aopt textField "Description" Nothing <*> pure "master" + where + vcsList :: [(Text, VersionControlSystem)] + vcsList = + [ ("Darcs", VCSDarcs) + , ("Git" , VCSGit) + ] newRepoForm :: SharerId -> Form Repo newRepoForm = renderDivs . newRepoAForm diff --git a/src/Vervis/Handler/Repo.hs b/src/Vervis/Handler/Repo.hs index 65fed81..5dd5107 100644 --- a/src/Vervis/Handler/Repo.hs +++ b/src/Vervis/Handler/Repo.hs @@ -72,6 +72,7 @@ import Vervis.Git (timeAgo') import Vervis.Path import Vervis.MediaType (chooseMediaType) import Vervis.Model +import Vervis.Model.Repo import Vervis.Readme import Vervis.Render import Vervis.Settings @@ -96,14 +97,17 @@ postReposR user = do let sid = personIdent person ((result, widget), enctype) <- runFormPost $ newRepoForm sid case result of - FormSuccess repo -> do - parent <- askSharerDir user - liftIO $ do - createDirectoryIfMissing True parent - initRepo parent (unpack $ repoIdent repo) - runDB $ insert_ repo - setMessage "Repo added." - redirectUltDest HomeR + FormSuccess repo -> + case repoVcs repo of + VCSDarcs -> error "Darcs not supported yet" + VCSGit -> do + parent <- askSharerDir user + liftIO $ do + createDirectoryIfMissing True parent + initRepo parent (unpack $ repoIdent repo) + runDB $ insert_ repo + setMessage "Repo added." + redirect $ ReposR user FormMissing -> do setMessage "Field(s) missing" defaultLayout $(widgetFile "repo/repo-new")