gonito/Handler/ShowChallenge.hs
2015-09-06 15:33:37 +02:00

61 lines
2.2 KiB
Haskell

module Handler.ShowChallenge where
import Import
import Yesod.Form.Bootstrap3 (BootstrapFormLayout (..), renderBootstrap3,
withSmallInput)
import qualified Data.Text.Lazy as TL
import Text.Markdown
import Handler.Extract
import Handler.Shared
getShowChallengeR :: Text -> Handler Html
getShowChallengeR name = do
(Entity _ challenge) <- runDB $ getBy404 $ UniqueName name
challengeLayout True challenge (showChallengeWidget challenge)
getChallengeReadmeR :: Text -> Handler Html
getChallengeReadmeR name = do
(Entity _ challenge) <- runDB $ getBy404 $ UniqueName name
let repoId = challengePublicRepo challenge
let repoDir = getRepoDir repoId
let readmeFilePath = repoDir </> readmeFile
contents <- readFile readmeFilePath
challengeLayout False challenge $ toWidget $ markdown def $ TL.fromStrict contents
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
setTitle "Challenge"
$(widgetFile "challenge")