filipg/geval
1
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

Git-annex remote can be specified with --submit option

Browse Source
This commit is contained in:
Filip Graliński 2018-12-07 09:21:02 +01:00
parent a36f46a241
commit 6f1344e73e
3 changed files with 21 additions and 11 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

6
src/GEval/Core.hs
View File

@ -253,7 +253,8 @@ data GEvalSpecification = GEvalSpecification
gesPrecision :: Maybe Int, gesPrecision :: Maybe Int,
gesTokenizer :: Maybe Tokenizer, gesTokenizer :: Maybe Tokenizer,
gesGonitoHost :: Maybe String, gesGonitoHost :: Maybe String,
gesToken :: Maybe String } gesToken :: Maybe String,
gesGonitoGitAnnexRemote :: Maybe String }
gesMainMetric :: GEvalSpecification -> Metric gesMainMetric :: GEvalSpecification -> Metric
gesMainMetric spec = case gesMetrics spec of gesMainMetric spec = case gesMetrics spec of
@ -334,7 +335,8 @@ defaultGEvalSpecification = GEvalSpecification {
gesPrecision = Nothing, gesPrecision = Nothing,
gesTokenizer = Nothing, gesTokenizer = Nothing,
gesGonitoHost = Nothing, gesGonitoHost = Nothing,
gesToken = Nothing } gesToken = Nothing,
gesGonitoGitAnnexRemote = Nothing }
isEmptyFile :: FilePath -> IO (Bool) isEmptyFile :: FilePath -> IO (Bool)
isEmptyFile path = do isEmptyFile path = do

8
src/GEval/OptionsParser.hs
View File

@ -155,6 +155,12 @@ specParser = GEvalSpecification
<> help "Submit ONLY: Token for authorization with Gonito instance." <> help "Submit ONLY: Token for authorization with Gonito instance."
) )
) )
<*> ( optional . strOption $
( long "gonito-git-annex-remote"
<> metavar "GIT-ANNEX-REMOTE"
<> help "Submit ONLY: Specification of a git-annex remote."
)
)
singletonMaybe :: Maybe a -> Maybe [a] singletonMaybe :: Maybe a -> Maybe [a]
singletonMaybe (Just x) = Just [x] singletonMaybe (Just x) = Just [x]
@ -250,7 +256,7 @@ runGEval''' (Just JustTokenize) _ spec = do
justTokenize (gesTokenizer spec) justTokenize (gesTokenizer spec)
return Nothing return Nothing
runGEval''' (Just Submit) _ spec = do runGEval''' (Just Submit) _ spec = do
submit (gesGonitoHost spec) (gesToken spec) submit (gesGonitoHost spec) (gesToken spec) (gesGonitoGitAnnexRemote spec)
return Nothing return Nothing
initChallenge :: GEvalSpecification -> IO () initChallenge :: GEvalSpecification -> IO ()

18
src/GEval/Submit.hs
View File

@ -34,9 +34,9 @@ import qualified Data.ByteString.Char8 as BS
tokenFileName :: String tokenFileName :: String
tokenFileName = ".token" tokenFileName = ".token"
submit :: Maybe String -> Maybe String -> IO () submit :: Maybe String -> Maybe String -> Maybe String -> IO ()
submit Nothing _ = failWith "Please provide a Gonito host with --gonito-host option" submit Nothing _ _ = failWith "Please provide a Gonito host with --gonito-host option"
submit (Just host) tok = do submit (Just host) tok mGitAnnexRemote = do
branch <- getCurrentBranch branch <- getCurrentBranch
challengeId <- getChallengeId challengeId <- getChallengeId
repoUrl <- getRemoteUrl "origin" repoUrl <- getRemoteUrl "origin"
@ -46,18 +46,20 @@ submit (Just host) tok = do
checkEverythingCommitted checkEverythingCommitted
checkRemoteSynced checkRemoteSynced
token <- getToken tok token <- getToken tok
trigger host token branch challengeId repoUrl trigger host token branch challengeId repoUrl mGitAnnexRemote
trigger :: String -> String -> String -> String -> String -> IO () trigger :: String -> String -> String -> String -> String -> Maybe String -> IO ()
trigger host token branch challengeId repoUrl = do trigger host token branch challengeId repoUrl mGitAnnexRemote = do
putStrLn $ "Triggering: " ++ url putStrLn $ "Triggering: " ++ url
putStrLn "Please wait, it may take some time" putStrLn "Please wait, it may take some time"
req <- parseRequest url req <- parseRequest url
let params = map (\(pname, pval) -> (BS.pack $ pname, BS.pack $ pval)) [ let params = map (\(pname, pval) -> (BS.pack $ pname, BS.pack $ pval)) ([
("challenge", challengeId), ("challenge", challengeId),
("branch", branch), ("branch", branch),
("token", token), ("token", token),
("url", repoUrl)] ("url", repoUrl)] ++ case mGitAnnexRemote of
Just gitAnnexRemote -> [("git-annex-remote", gitAnnexRemote)]
Nothing -> [])
let req' = setRequestBodyURLEncoded params req let req' = setRequestBodyURLEncoded params req
httpBS req' >>= BS.putStrLn . getResponseBody httpBS req' >>= BS.putStrLn . getResponseBody
where url = "POST " ++ hostWithProtocol ++ "/trigger-remotely" where url = "POST " ++ hostWithProtocol ++ "/trigger-remotely"