gonito/Handler/Query.hs

82 lines
2.8 KiB
Haskell
Raw Normal View History

2016-02-12 13:00:33 +01:00
module Handler.Query where
import Import
import Handler.Tables (formatSubmitter)
import Handler.Shared
2016-02-12 13:00:33 +01:00
import PersistSHA1
import Database.Persist.Sql
import Data.Text as T(pack)
import Yesod.Form.Bootstrap3 (BootstrapFormLayout (..), renderBootstrap3,
withSmallInput)
data FullSubmissionInfo = FullSubmissionInfo {
fsiSubmissionId :: SubmissionId,
2016-02-12 13:00:33 +01:00
fsiSubmission :: Submission,
fsiUser :: User,
fsiRepo :: Repo,
fsiChallenge :: Challenge }
2016-02-12 13:00:33 +01:00
getFullInfo :: Entity Submission -> Handler FullSubmissionInfo
getFullInfo (Entity submissionId submission) = do
repo <- runDB $ get404 $ submissionRepo submission
user <- runDB $ get404 $ submissionSubmitter submission
challenge <- runDB $ get404 $ submissionChallenge submission
2016-02-12 13:00:33 +01:00
return $ FullSubmissionInfo {
fsiSubmissionId = submissionId,
2016-02-12 13:00:33 +01:00
fsiSubmission = submission,
fsiUser = user,
fsiRepo = repo,
fsiChallenge = challenge }
2016-02-12 13:00:33 +01:00
findSubmissions :: Text -> Handler [FullSubmissionInfo]
findSubmissions sha1Prefix = do
submissions <- runDB $ rawSql "SELECT ?? FROM submission WHERE is_public AND cast(commit as text) like ?" [PersistText $ "\\\\x" ++ sha1Prefix ++ "%"]
2016-02-12 13:00:33 +01:00
mapM getFullInfo submissions
getQueryFormR :: Handler Html
getQueryFormR = do
(formWidget, formEnctype) <- generateFormPost queryForm
let submission = Nothing :: Maybe Text
handlerName = "getQueryFormR" :: Text
defaultLayout $ do
aDomId <- newIdent
setTitle "Searching for submissions"
$(widgetFile "query-form")
postQueryFormR :: Handler Html
postQueryFormR = do
((result, formWidget), formEnctype) <- runFormPost queryForm
let handlerName = "postQueryFormR" :: Text
case result of
FormSuccess query -> processQuery query
_ -> defaultLayout $ do
aDomId <- newIdent
setTitle "Searching for submissions"
$(widgetFile "query-form")
getQueryResultsR :: Text -> Handler Html
getQueryResultsR = processQuery
processQuery :: Text -> Handler Html
processQuery query = do
submissions <- findSubmissions query
defaultLayout $ do
aDomId <- newIdent
setTitle "query results"
$(widgetFile "query-results")
queryResult submission = do
$(widgetFile "query-result")
2016-02-12 13:00:33 +01:00
where commitSha1AsText = fromSHA1ToText $ submissionCommit $ fsiSubmission submission
submitter = formatSubmitter $ fsiUser submission
publicSubmissionBranch = getPublicSubmissionBranch $ fsiSubmissionId submission
publicSubmissionRepo = getReadOnlySubmissionUrl $ challengeName $ fsiChallenge submission
browsableUrl = browsableGitRepoBranch (challengeName $ fsiChallenge submission) publicSubmissionBranch
2016-02-12 13:00:33 +01:00
stamp = T.pack $ show $ submissionStamp $ fsiSubmission submission
queryForm :: Form Text
queryForm = renderBootstrap3 BootstrapBasicForm $ areq textField (fieldSettingsLabel MsgGitCommitSha1) Nothing