diff options
Diffstat (limited to 'server')
| -rw-r--r-- | server/Server.hs | 2 | ||||
| -rw-r--r-- | server/Worker.hs | 9 |
2 files changed, 9 insertions, 2 deletions
diff --git a/server/Server.hs b/server/Server.hs index b07cb58..2c16834 100644 --- a/server/Server.hs +++ b/server/Server.hs @@ -99,6 +99,7 @@ data Org (loaded :: Bool) = Org , orgRepos :: [RemoteRef] , orgUrl :: Text , orgWebdir :: Text + , orgHumanWebdir :: Text , orgBacklinkPrefix :: Text , orgContactMail :: Text , orgHowtoLink :: Maybe Text @@ -163,6 +164,7 @@ orgCodec = Org <*> T.list remoteCodec "repo" .= orgRepos <*> T.text "url" .= orgUrl <*> T.text "webdir" .= orgWebdir + <*> T.text "webdir_human" .= orgHumanWebdir <*> T.text "backlink_prefix" .= orgBacklinkPrefix <*> T.text "contact_mail" .= orgContactMail <*> coerce (T.first T.text "howto_link") .= orgHowtoLink diff --git a/server/Worker.hs b/server/Worker.hs index a9ffce3..d85c44f 100644 --- a/server/Worker.hs +++ b/server/Worker.hs @@ -98,6 +98,7 @@ runJob offline config Job {..} done = do $ readgit' gitdir ["rev-parse", toString ref] let outPath = adjustedPath rev jobOrg + let humanOutPath = orgHumanWebdir jobOrg <> "/" <> reponame jobRef callgit gitdir [ "worktree", "add", "--force", workdir, toString ref ] @@ -106,13 +107,17 @@ runJob offline config Job {..} done = do liftIO (writeAdjustedRepository lintConfig workdir (toString outPath) res) >>= \case - ExitSuccess -> + ExitSuccess -> do logInfoN $ "linted map "+| (show jobRef :: Text) |+"." + logInfoN $ "symlinking"+|outPath|+"into human web dir at"+|humanOutPath|+"" + liftIO $ callProcess "ln" [ "-sfn", toString outPath, toString humanOutPath ] ExitFailure 1 -> logInfoN $ "linted map "+| (show jobRef :: Text) |+ ", which failed." - ExitFailure 2 -> + ExitFailure 2 -> do -- TODO: shouldn't have linted this map at all logErrorN $ "outpath "+|outPath|+" already exists!" + logInfoN $ "symlinking"+|outPath|+"into human web dir at"+|humanOutPath|+"" + liftIO $ callProcess "ln" [ "-sfn", toString outPath, toString humanOutPath ] ExitFailure _ -> -- writeAdjustedRepository does not return other codes $(logError) "wtf, this is impossible" |