From 3bcc4a608e078733c210e8927421b255a6829cad Mon Sep 17 00:00:00 2001
From: stuebinm
Date: Thu, 14 Apr 2022 00:27:19 +0200
Subject: 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)
---
 server/Server.hs | 2 ++
 server/Worker.hs | 9 +++++++--
 2 files changed, 9 insertions(+), 2 deletions(-)

(limited to 'server')

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"
-- 
cgit v1.2.3