From 1e995e8f11077a450b52aca42a63dd082d7401ef Mon Sep 17 00:00:00 2001 From: pilfer-pandex <47340789+pilfer-pandex@users.noreply.github.com> Date: Fri, 24 Jul 2020 21:05:23 -0700 Subject: [PATCH] king: wtf use getExecutablePath --- pkg/hs/urbit-king/lib/Urbit/Vere/Pier.hs | 23 +++++++++++++---------- 1 file changed, 13 insertions(+), 10 deletions(-) diff --git a/pkg/hs/urbit-king/lib/Urbit/Vere/Pier.hs b/pkg/hs/urbit-king/lib/Urbit/Vere/Pier.hs index bf8c4ae252..4a954f869e 100644 --- a/pkg/hs/urbit-king/lib/Urbit/Vere/Pier.hs +++ b/pkg/hs/urbit-king/lib/Urbit/Vere/Pier.hs @@ -25,6 +25,8 @@ import Urbit.King.App import Urbit.Vere.Pier.Types import Control.Monad.STM (retry) +import System.Environment (getExecutablePath) +import System.FilePath (splitFileName, ()) import System.Posix.Files (ownerModes, setFileMode) import Urbit.EventLog.LMDB (EventLog) import Urbit.King.API (TermConn) @@ -122,24 +124,25 @@ runSerf -> RAcquire e Serf runSerf vSlog pax = do env <- ask - heuSerf <- heuristicallyFindSerf - Serf.withSerf (config env heuSerf) + serfProg <- io getSerfProg + Serf.withSerf (config env serfProg) where slog txt = atomically (readTVar vSlog) >>= (\f -> f txt) - config env heuSerf = Serf.Config - { scSerf = env ^. pierConfigL . pcSerfExe . to (unpack . fromMaybe heuSerf) + config env serfProg = Serf.Config + { scSerf = env ^. pierConfigL . pcSerfExe . to (maybe serfProg unpack) , scPier = pax , scFlag = env ^. pierConfigL . pcSerfFlags , scSlog = \(pri, tank) -> printTank slog pri tank , scStdr = \txt -> slog (txt <> "\r\n") , scDead = pure () -- TODO: What can be done? } - heuristicallyFindSerf = serfPrgm <$> listToMaybe <$> getArgs - serfPrgm = \case - Just (stripSuffix "urbit" -> Just pfix) -> pfix <> "urbit-worker" - Just (stripSuffix "urbit-king" -> Just pfix) -> pfix <> "urbit-worker" - _ -> "urbit-worker" - + getSerfProg :: IO FilePath + getSerfProg = do + (path, filename) <- splitFileName <$> getExecutablePath + pure $ case filename of + "urbit" -> path "urbit-worker" + "urbit-king" -> path "urbit-worker" + _ -> "urbit-worker" -- Boot a new ship. ------------------------------------------------------------