diff --git a/pkg/hs/urbit-king/TODO.md b/pkg/hs/urbit-king/TODO.md index f1a292b859..d76f845308 100644 --- a/pkg/hs/urbit-king/TODO.md +++ b/pkg/hs/urbit-king/TODO.md @@ -63,12 +63,6 @@ Polish: changed too quickly. -# Finding the Serf Executable - -- [ ] Right now, `urbit-worker` is found by looking it up in the PATH. This - is wrong, but what is right? - - # Take Advantage of New IPC Features - [ ] Hook up `scry` to drivers. diff --git a/pkg/hs/urbit-king/lib/Urbit/King/Config.hs b/pkg/hs/urbit-king/lib/Urbit/King/Config.hs index 7cb9ceb2c9..4ccece736d 100644 --- a/pkg/hs/urbit-king/lib/Urbit/King/Config.hs +++ b/pkg/hs/urbit-king/lib/Urbit/King/Config.hs @@ -14,7 +14,7 @@ import qualified Urbit.Vere.Serf as Serf data PierConfig = PierConfig { _pcPierPath :: FilePath , _pcDryRun :: Bool - , _pcSerfExe :: Text + , _pcSerfExe :: Maybe Text , _pcSerfFlags :: [Serf.Flag] } deriving (Show) diff --git a/pkg/hs/urbit-king/lib/Urbit/King/Main.hs b/pkg/hs/urbit-king/lib/Urbit/King/Main.hs index 2fb280d2da..4e2def18d5 100644 --- a/pkg/hs/urbit-king/lib/Urbit/King/Main.hs +++ b/pkg/hs/urbit-king/lib/Urbit/King/Main.hs @@ -144,7 +144,7 @@ toPierConfig pierPath o@(CLI.Opts{..}) = PierConfig { .. } where _pcPierPath = pierPath _pcDryRun = oDryRun || isJust oDryFrom - _pcSerfExe = fromMaybe "urbit-worker" oSerfExe + _pcSerfExe = oSerfExe _pcSerfFlags = toSerfFlags o toNetworkConfig :: CLI.Opts -> NetworkConfig diff --git a/pkg/hs/urbit-king/lib/Urbit/Vere/Pier.hs b/pkg/hs/urbit-king/lib/Urbit/Vere/Pier.hs index 78b6d9e5da..bf8c4ae252 100644 --- a/pkg/hs/urbit-king/lib/Urbit/Vere/Pier.hs +++ b/pkg/hs/urbit-king/lib/Urbit/Vere/Pier.hs @@ -122,17 +122,24 @@ runSerf -> RAcquire e Serf runSerf vSlog pax = do env <- ask - Serf.withSerf (config env) + heuSerf <- heuristicallyFindSerf + Serf.withSerf (config env heuSerf) where slog txt = atomically (readTVar vSlog) >>= (\f -> f txt) - config env = Serf.Config - { scSerf = env ^. pierConfigL . pcSerfExe . to unpack + config env heuSerf = Serf.Config + { scSerf = env ^. pierConfigL . pcSerfExe . to (unpack . fromMaybe heuSerf) , 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" + -- Boot a new ship. ------------------------------------------------------------