finished handling git-annex
This commit is contained in:
parent
e06f2120ea
commit
35bb3c7af6
@ -240,9 +240,21 @@ rawClone tmpRepoDir repoCloningSpec chan = runWithChannel chan $ do
|
|||||||
runProg (Just tmpRepoDir) gitPath ["reset",
|
runProg (Just tmpRepoDir) gitPath ["reset",
|
||||||
"--hard",
|
"--hard",
|
||||||
"FETCH_HEAD"]
|
"FETCH_HEAD"]
|
||||||
|
getStuffUsingGitAnnex tmpRepoDir (repoSpecGitAnnexRemote $ cloningSpecRepo repoCloningSpec)
|
||||||
else
|
else
|
||||||
return ()
|
return ()
|
||||||
|
|
||||||
|
getStuffUsingGitAnnex :: FilePath -> Maybe Text -> Runner ()
|
||||||
|
getStuffUsingGitAnnex _ Nothing = return ()
|
||||||
|
getStuffUsingGitAnnex tmpRepoDir (Just gitAnnexRemote) = do
|
||||||
|
runGitAnnex tmpRepoDir ["init"]
|
||||||
|
runGitAnnex tmpRepoDir ["initremote", remoteName, T.unpack gitAnnexRemote]
|
||||||
|
runGitAnnex tmpRepoDir ["get", "--from", remoteName]
|
||||||
|
where remoteName = "storage"
|
||||||
|
|
||||||
|
runGitAnnex :: FilePath -> [String] -> Runner ()
|
||||||
|
runGitAnnex tmpRepoDir args = runProg (Just tmpRepoDir) gitPath ("annex":args)
|
||||||
|
|
||||||
getRepoDir :: Key Repo -> Handler FilePath
|
getRepoDir :: Key Repo -> Handler FilePath
|
||||||
getRepoDir repoId = do
|
getRepoDir repoId = do
|
||||||
arenaDir <- arena
|
arenaDir <- arena
|
||||||
|
@ -122,10 +122,13 @@ postChallengeSubmissionR name = do
|
|||||||
let submissionData = case result of
|
let submissionData = case result of
|
||||||
FormSuccess res -> Just res
|
FormSuccess res -> Just res
|
||||||
_ -> Nothing
|
_ -> Nothing
|
||||||
Just (mDescription, mTags, submissionUrl, submissionBranch) = submissionData
|
Just (mDescription, mTags, submissionUrl, submissionBranch, submissionGitAnnexRemote) = submissionData
|
||||||
|
|
||||||
userId <- requireAuthId
|
userId <- requireAuthId
|
||||||
runViewProgress $ doCreateSubmission userId challengeId mDescription mTags submissionUrl submissionBranch
|
runViewProgress $ doCreateSubmission userId challengeId mDescription mTags RepoSpec {
|
||||||
|
repoSpecUrl=submissionUrl,
|
||||||
|
repoSpecBranch=submissionBranch,
|
||||||
|
repoSpecGitAnnexRemote=submissionGitAnnexRemote}
|
||||||
|
|
||||||
postTriggerLocallyR :: Handler TypedContent
|
postTriggerLocallyR :: Handler TypedContent
|
||||||
postTriggerLocallyR = do
|
postTriggerLocallyR = do
|
||||||
@ -150,12 +153,16 @@ trigger userId challengeName url mBranch = do
|
|||||||
let branch = fromMaybe "master" mBranch
|
let branch = fromMaybe "master" mBranch
|
||||||
mChallengeEnt <- runDB $ getBy $ UniqueName challengeName
|
mChallengeEnt <- runDB $ getBy $ UniqueName challengeName
|
||||||
case mChallengeEnt of
|
case mChallengeEnt of
|
||||||
Just (Entity challengeId _) -> runOpenViewProgress $ doCreateSubmission userId challengeId Nothing Nothing url branch
|
Just (Entity challengeId _) -> runOpenViewProgress $ doCreateSubmission userId challengeId
|
||||||
|
Nothing Nothing
|
||||||
|
RepoSpec {repoSpecUrl=url,
|
||||||
|
repoSpecBranch=branch,
|
||||||
|
repoSpecGitAnnexRemote=Nothing}
|
||||||
Nothing -> return $ toTypedContent (("Unknown challenge `" ++ (Data.Text.unpack challengeName) ++ "`. Cannot be triggered, must be submitted manually at Gonito.net!\n") :: String)
|
Nothing -> return $ toTypedContent (("Unknown challenge `" ++ (Data.Text.unpack challengeName) ++ "`. Cannot be triggered, must be submitted manually at Gonito.net!\n") :: String)
|
||||||
|
|
||||||
doCreateSubmission :: UserId -> Key Challenge -> Maybe Text -> Maybe Text -> Text -> Text -> Channel -> Handler ()
|
doCreateSubmission :: UserId -> Key Challenge -> Maybe Text -> Maybe Text -> RepoSpec -> Channel -> Handler ()
|
||||||
doCreateSubmission userId challengeId mDescription mTags url branch chan = do
|
doCreateSubmission userId challengeId mDescription mTags repoSpec chan = do
|
||||||
maybeRepoKey <- getSubmissionRepo challengeId url branch chan
|
maybeRepoKey <- getSubmissionRepo challengeId repoSpec chan
|
||||||
case maybeRepoKey of
|
case maybeRepoKey of
|
||||||
Just repoId -> do
|
Just repoId -> do
|
||||||
repo <- runDB $ get404 repoId
|
repo <- runDB $ get404 repoId
|
||||||
@ -311,8 +318,10 @@ rawEval challengeDir repoDir name = Import.try (runGEvalGetOptions [
|
|||||||
"--out-directory", repoDir,
|
"--out-directory", repoDir,
|
||||||
"--test-name", (T.unpack name)])
|
"--test-name", (T.unpack name)])
|
||||||
|
|
||||||
getSubmissionRepo :: Key Challenge -> Text -> Text -> Channel -> Handler (Maybe (Key Repo))
|
getSubmissionRepo :: Key Challenge -> RepoSpec -> Channel -> Handler (Maybe (Key Repo))
|
||||||
getSubmissionRepo challengeId url branch chan = do
|
getSubmissionRepo challengeId repoSpec chan = do
|
||||||
|
let url = repoSpecUrl repoSpec
|
||||||
|
let branch = repoSpecBranch repoSpec
|
||||||
maybeRepo <- runDB $ getBy $ UniqueUrlBranch url branch
|
maybeRepo <- runDB $ getBy $ UniqueUrlBranch url branch
|
||||||
case maybeRepo of
|
case maybeRepo of
|
||||||
Just (Entity repoId repo) -> do
|
Just (Entity repoId repo) -> do
|
||||||
@ -334,16 +343,14 @@ getSubmissionRepo challengeId url branch chan = do
|
|||||||
let repoId = challengePublicRepo challenge
|
let repoId = challengePublicRepo challenge
|
||||||
repo <- runDB $ get404 repoId
|
repo <- runDB $ get404 repoId
|
||||||
repoDir <- getRepoDir repoId
|
repoDir <- getRepoDir repoId
|
||||||
let repoSpec = RepoCloningSpec {
|
let repoCloningSpec = RepoCloningSpec {
|
||||||
cloningSpecRepo = RepoSpec {
|
cloningSpecRepo = repoSpec,
|
||||||
repoSpecUrl = url,
|
|
||||||
repoSpecBranch = branch },
|
|
||||||
cloningSpecReferenceRepo = RepoSpec {
|
cloningSpecReferenceRepo = RepoSpec {
|
||||||
repoSpecUrl = (T.pack repoDir),
|
repoSpecUrl = (T.pack repoDir),
|
||||||
repoSpecBranch = (repoBranch repo)
|
repoSpecBranch = (repoBranch repo)
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
cloneRepo' repoSpec chan
|
cloneRepo' repoCloningSpec chan
|
||||||
|
|
||||||
checkRepoAvailibility :: Key Challenge -> Key Repo -> Channel -> Handler Bool
|
checkRepoAvailibility :: Key Challenge -> Key Repo -> Channel -> Handler Bool
|
||||||
checkRepoAvailibility challengeId repoId chan = do
|
checkRepoAvailibility challengeId repoId chan = do
|
||||||
@ -365,12 +372,13 @@ checkRepoAvailibility challengeId repoId chan = do
|
|||||||
|
|
||||||
challengeSubmissionWidget formWidget formEnctype challenge = $(widgetFile "challenge-submission")
|
challengeSubmissionWidget formWidget formEnctype challenge = $(widgetFile "challenge-submission")
|
||||||
|
|
||||||
submissionForm :: Maybe Text -> Form (Maybe Text, Maybe Text, Text, Text)
|
submissionForm :: Maybe Text -> Form (Maybe Text, Maybe Text, Text, Text, Maybe Text)
|
||||||
submissionForm defaultUrl = renderBootstrap3 BootstrapBasicForm $ (,,,)
|
submissionForm defaultUrl = renderBootstrap3 BootstrapBasicForm $ (,,,,)
|
||||||
<$> aopt textField (fieldWithTooltip MsgSubmissionDescription MsgSubmissionDescriptionTooltip) Nothing
|
<$> aopt textField (fieldWithTooltip MsgSubmissionDescription MsgSubmissionDescriptionTooltip) Nothing
|
||||||
<*> aopt textField (tagsfs MsgSubmissionTags) Nothing
|
<*> aopt textField (tagsfs MsgSubmissionTags) Nothing
|
||||||
<*> areq textField (bfs MsgSubmissionUrl) defaultUrl
|
<*> areq textField (bfs MsgSubmissionUrl) defaultUrl
|
||||||
<*> areq textField (bfs MsgSubmissionBranch) (Just "master")
|
<*> areq textField (bfs MsgSubmissionBranch) (Just "master")
|
||||||
|
<*> aopt textField (bfs MsgSubmissionGitAnnexRemote) Nothing
|
||||||
|
|
||||||
getChallengeMySubmissionsR :: Text -> Handler Html
|
getChallengeMySubmissionsR :: Text -> Handler Html
|
||||||
getChallengeMySubmissionsR name = do
|
getChallengeMySubmissionsR name = do
|
||||||
|
@ -59,3 +59,4 @@ Manage: manage
|
|||||||
Presentation: presentation
|
Presentation: presentation
|
||||||
GonitoInClass: Gonito in class
|
GonitoInClass: Gonito in class
|
||||||
GitAnnexRemote: git-annex remote (if needed)
|
GitAnnexRemote: git-annex remote (if needed)
|
||||||
|
SubmissionGitAnnexRemote: git-annex remote specification (if needed)
|
||||||
|
Loading…
Reference in New Issue
Block a user