submission form

Handler/ShowChallenge.hs

@@ -1,6 +1,8 @@
 module Handler.ShowChallenge where
 
 import Import
+import Yesod.Form.Bootstrap3 (BootstrapFormLayout (..), renderBootstrap3,
+                              withSmallInput)
 
 import qualified Data.Text.Lazy          as TL
 import           Text.Markdown
@@ -24,6 +26,33 @@ getChallengeReadmeR name = do
 
 showChallengeWidget challenge = $(widgetFile "show-challenge")
 
+
+getChallengeSubmissionR :: Text -> Handler Html
+getChallengeSubmissionR name = do
+   (Entity _ challenge) <- runDB $ getBy404 $ UniqueName name
+   (formWidget, formEnctype) <- generateFormPost submissionForm
+   challengeLayout True challenge $ challengeSubmissionWidget formWidget formEnctype challenge
+
+postChallengeSubmissionR :: Text -> Handler TypedContent
+postChallengeSubmissionR name = do
+    ((result, formWidget), formEnctype) <- runFormPost submissionForm
+    let submissionData = case result of
+          FormSuccess res -> Just res
+          _ -> Nothing
+        Just (description, submissionUrl, submissionBranch) = submissionData
+
+    runViewProgress $ (flip msg) "HAHA"
+
+challengeSubmissionWidget formWidget formEnctype challenge = $(widgetFile "challenge-submission")
+
+submissionForm :: Form (Text, Text, Text)
+submissionForm = renderBootstrap3 BootstrapBasicForm $ (,,)
+    <$> areq textField (fieldSettingsLabel MsgSubmissionDescription) Nothing
+    <*> areq textField (fieldSettingsLabel MsgSubmissionUrl) Nothing
+    <*> areq textField (fieldSettingsLabel MsgSubmissionBranch) Nothing
+
+
+
 challengeLayout withHeader challenge widget = do
   bc <- widgetToPageContent widget
   defaultLayout $ do

config/routes

@@ -13,3 +13,4 @@
 
 /challenge/#Text ShowChallengeR GET
 /challenge-readme/#Text ChallengeReadmeR GET
+/challenge-submission/#Text ChallengeSubmissionR GET POST

messages/en.msg

@@ -8,3 +8,8 @@ PrivateUrl: private repo (URL)
 Branch: branch
 Add: Add!
 ListChallenges: list challenges
+SubmitSolution: Submit a solution to the challenge
+Submit: Submit
+SubmissionUrl: Submission repo URL
+SubmissionBranch: Submission repo branch
+SubmissionDescription: Submission description

templates/challenge-submission.hamlet

@@ -0,0 +1,7 @@
+<h2>_{MsgSubmitSolution}
+
+<p>
+  <form method=post action=@{ChallengeSubmissionR (challengeName challenge)}#form enctype=#{formEnctype}>
+    ^{formWidget}
+    <button .btn .btn-primary type="submit">
+       _{MsgSubmit} <span class="glyphicon glyphicon-upload"></span>

templates/challenge.hamlet

@@ -4,7 +4,7 @@
     <ul class="nav nav-pills nav-stacked navbar-left">
      <li role="presentation" class="active"><a href="@{ShowChallengeR (challengeName challenge)}">Graph</a>
      <li role="presentation"><a href="@{ChallengeReadmeR (challengeName challenge)}">Readme</a>
-     <li role="presentation"><a href="#">Submit</a>
+     <li role="presentation"><a href="@{ChallengeSubmissionR (challengeName challenge)}">Submit</a>
      <li role="presentation"><a href="#">My Submissions</a>
      <li role="presentation"><a href="#">All Submissions</a>
   <div .col-md-10 role="main">