summaryrefslogtreecommitdiff
path: root/server
diff options
context:
space:
mode:
authorstuebinm2022-04-14 00:27:19 +0200
committerstuebinm2022-04-14 00:27:19 +0200
commit3bcc4a608e078733c210e8927421b255a6829cad (patch)
treebc18033cdc41a4287f9d891fb97eaf4afc4a6adc /server
parentdb2bd423a00e582dd966d040df70d6994122b7ff (diff)
mapserver: symlink outdirs to human-readable paths
(meant for use of this server without exneuland / the whole map resolution api on a dump simple workadventure backend)
Diffstat (limited to 'server')
-rw-r--r--server/Server.hs2
-rw-r--r--server/Worker.hs9
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"