diff --git a/src/GEval/Core.hs b/src/GEval/Core.hs index 2f8de73..a807a08 100644 --- a/src/GEval/Core.hs +++ b/src/GEval/Core.hs @@ -253,7 +253,8 @@ data GEvalSpecification = GEvalSpecification gesPrecision :: Maybe Int, gesTokenizer :: Maybe Tokenizer, gesGonitoHost :: Maybe String, - gesToken :: Maybe String } + gesToken :: Maybe String, + gesGonitoGitAnnexRemote :: Maybe String } gesMainMetric :: GEvalSpecification -> Metric gesMainMetric spec = case gesMetrics spec of @@ -334,7 +335,8 @@ defaultGEvalSpecification = GEvalSpecification { gesPrecision = Nothing, gesTokenizer = Nothing, gesGonitoHost = Nothing, - gesToken = Nothing } + gesToken = Nothing, + gesGonitoGitAnnexRemote = Nothing } isEmptyFile :: FilePath -> IO (Bool) isEmptyFile path = do diff --git a/src/GEval/OptionsParser.hs b/src/GEval/OptionsParser.hs index 4d4438b..61bc653 100644 --- a/src/GEval/OptionsParser.hs +++ b/src/GEval/OptionsParser.hs @@ -155,6 +155,12 @@ specParser = GEvalSpecification <> 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 (Just x) = Just [x] @@ -250,7 +256,7 @@ runGEval''' (Just JustTokenize) _ spec = do justTokenize (gesTokenizer spec) return Nothing runGEval''' (Just Submit) _ spec = do - submit (gesGonitoHost spec) (gesToken spec) + submit (gesGonitoHost spec) (gesToken spec) (gesGonitoGitAnnexRemote spec) return Nothing initChallenge :: GEvalSpecification -> IO () diff --git a/src/GEval/Submit.hs b/src/GEval/Submit.hs index 1ff6f9b..f04a6b6 100644 --- a/src/GEval/Submit.hs +++ b/src/GEval/Submit.hs @@ -34,9 +34,9 @@ import qualified Data.ByteString.Char8 as BS tokenFileName :: String tokenFileName = ".token" -submit :: Maybe String -> Maybe String -> IO () -submit Nothing _ = failWith "Please provide a Gonito host with --gonito-host option" -submit (Just host) tok = do +submit :: Maybe String -> Maybe String -> Maybe String -> IO () +submit Nothing _ _ = failWith "Please provide a Gonito host with --gonito-host option" +submit (Just host) tok mGitAnnexRemote = do branch <- getCurrentBranch challengeId <- getChallengeId repoUrl <- getRemoteUrl "origin" @@ -46,18 +46,20 @@ submit (Just host) tok = do checkEverythingCommitted checkRemoteSynced token <- getToken tok - trigger host token branch challengeId repoUrl + trigger host token branch challengeId repoUrl mGitAnnexRemote -trigger :: String -> String -> String -> String -> String -> IO () -trigger host token branch challengeId repoUrl = do +trigger :: String -> String -> String -> String -> String -> Maybe String -> IO () +trigger host token branch challengeId repoUrl mGitAnnexRemote = do putStrLn $ "Triggering: " ++ url putStrLn "Please wait, it may take some time" 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), ("branch", branch), ("token", token), - ("url", repoUrl)] + ("url", repoUrl)] ++ case mGitAnnexRemote of + Just gitAnnexRemote -> [("git-annex-remote", gitAnnexRemote)] + Nothing -> []) let req' = setRequestBodyURLEncoded params req httpBS req' >>= BS.putStrLn . getResponseBody where url = "POST " ++ hostWithProtocol ++ "/trigger-remotely"