add querying for commits

This commit is contained in:
Filip Gralinski 2016-02-12 13:00:33 +01:00
parent b089a10a6a
commit 8d3f6a01bb
9 changed files with 108 additions and 1 deletions

View File

@ -41,6 +41,7 @@ import Handler.Graph
import Handler.Home
import Handler.CreateChallenge
import Handler.ListChallenges
import Handler.Query
import Handler.ShowChallenge
import Handler.Shared
import Handler.YourAccount

71
Handler/Query.hs Normal file
View File

@ -0,0 +1,71 @@
module Handler.Query where
import Import
import Handler.Tables (formatSubmitter)
import PersistSHA1
import Database.Persist.Sql
import Data.Text as T(pack)
import Yesod.Form.Bootstrap3 (BootstrapFormLayout (..), renderBootstrap3,
withSmallInput)
data FullSubmissionInfo = FullSubmissionInfo {
fsiSubmission :: Submission,
fsiUser :: User,
fsiRepo :: Repo }
getFullInfo :: Entity Submission -> Handler FullSubmissionInfo
getFullInfo (Entity submissionId submission) = do
repo <- runDB $ get404 $ submissionRepo submission
user <- runDB $ get404 $ submissionSubmitter submission
return $ FullSubmissionInfo {
fsiSubmission = submission,
fsiUser = user,
fsiRepo = repo }
findSubmissions :: Text -> Handler [FullSubmissionInfo]
findSubmissions sha1Prefix = do
submissions <- runDB $ rawSql "SELECT ?? FROM submission WHERE cast(commit as text) like ?" [PersistText $ "\\\\x" ++ sha1Prefix ++ "%"]
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 = $(widgetFile "query-result")
where commitSha1AsText = fromSHA1ToText $ submissionCommit $ fsiSubmission submission
submitter = formatSubmitter $ fsiUser submission
stamp = T.pack $ show $ submissionStamp $ fsiSubmission submission
queryForm :: Form Text
queryForm = renderBootstrap3 BootstrapBasicForm $ areq textField (fieldSettingsLabel MsgGitCommitSha1) Nothing

View File

@ -20,9 +20,18 @@ toSHA1 x = SHA1 $ B.concat ["E'\\\\x", x, "'"]
fromTextToSHA1 :: Text -> SHA1
fromTextToSHA1 = SHA1 . B.pack . (map hexByteToWord8) . (T.chunksOf 2)
fromSHA1ToText :: SHA1 -> Text
fromSHA1ToText (SHA1 bs) = T.pack $ concat $ map word8ToHex $ B.unpack bs
hexByteToWord8 :: Text -> Word8
hexByteToWord8 t = (hexNibbleToWord8 $ T.head t) * 16 + (hexNibbleToWord8 $ T.index t 1)
word8ToHex :: Word8 -> String
word8ToHex e = case h of
[c] -> ['0', c]
s -> s
where h = showHex e ""
hexNibbleToWord8 :: Char -> Word8
hexNibbleToWord8 '0' = 0
hexNibbleToWord8 '1' = 1
@ -47,7 +56,6 @@ hexNibbleToWord8 'e' = 14
hexNibbleToWord8 'F' = 15
hexNibbleToWord8 'f' = 15
instance PersistField SHA1 where
toPersistValue (SHA1 t) = PersistByteString t

View File

@ -19,4 +19,8 @@
/challenge-how-to/#Text ChallengeHowToR GET
/challenge-graph-data/#Text ChallengeGraphDataR GET
/q QueryFormR GET POST
/q/#Text QueryResultsR GET
/account YourAccountR GET POST

View File

@ -38,6 +38,7 @@ library
Handler.Shared
Handler.ShowChallenge
Handler.Extract
Handler.Query
Handler.Tables
Handler.YourAccount

View File

@ -19,3 +19,5 @@ AccountName: name
Id: ID
SshPubKey: your SSH public key
Home: home
Search: search
GitCommitSha1: Git commit SHA1 hash

View File

@ -0,0 +1,7 @@
<h2>Search for submission by Git commit SHA1 hashes:
<p>
<form method=post action=@{QueryFormR}#form enctype=#{formEnctype}>
^{formWidget}
<button .btn .btn-primary type="submit">
_{MsgSearch} <span class="glyphicon glyphicon-upload"></span>

View File

@ -0,0 +1,6 @@
<div .subm-commit>#{commitSha1AsText}
<div .subm-description>#{submissionDescription $ fsiSubmission submission}
<div .subm-user>#{submitter}
<div .subm-stamp>#{stamp}
<div .subm-repo>#{repoUrl $ fsiRepo submission} / #{repoBranch $ fsiRepo submission}
<hr>

View File

@ -0,0 +1,7 @@
<h2>Query results
$if null submissions
<p>No results found.
$else
$forall submission <- submissions
^{queryResult submission}