urbit/shrub
1
1
Fork 0
mirror of https://github.com/urbit/shrub.git synced 2024-12-20 09:21:42 +03:00
Code Issues Packages Projects Releases Wiki Activity

king: use c vere's heuristics for finding the serf binary

Browse Source
This commit is contained in:
pilfer-pandex 2020-07-24 16:29:39 -07:00
parent 1953e4e2b3
commit fc92fd3611
4 changed files with 12 additions and 11 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

6
pkg/hs/urbit-king/TODO.md
View File

@ -63,12 +63,6 @@ Polish:
changed too quickly. 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 # Take Advantage of New IPC Features
- [ ] Hook up `scry` to drivers. - [ ] Hook up `scry` to drivers.

2
pkg/hs/urbit-king/lib/Urbit/King/Config.hs
View File

@ -14,7 +14,7 @@ import qualified Urbit.Vere.Serf as Serf
data PierConfig = PierConfig data PierConfig = PierConfig
{ _pcPierPath :: FilePath { _pcPierPath :: FilePath
, _pcDryRun :: Bool , _pcDryRun :: Bool
, _pcSerfExe :: Text , _pcSerfExe :: Maybe Text
, _pcSerfFlags :: [Serf.Flag] , _pcSerfFlags :: [Serf.Flag]
} deriving (Show) } deriving (Show)

2
pkg/hs/urbit-king/lib/Urbit/King/Main.hs
View File

@ -144,7 +144,7 @@ toPierConfig pierPath o@(CLI.Opts{..}) = PierConfig { .. }
where where
_pcPierPath = pierPath _pcPierPath = pierPath
_pcDryRun = oDryRun || isJust oDryFrom _pcDryRun = oDryRun || isJust oDryFrom
_pcSerfExe = fromMaybe "urbit-worker" oSerfExe _pcSerfExe = oSerfExe
_pcSerfFlags = toSerfFlags o _pcSerfFlags = toSerfFlags o
toNetworkConfig :: CLI.Opts -> NetworkConfig toNetworkConfig :: CLI.Opts -> NetworkConfig

13
pkg/hs/urbit-king/lib/Urbit/Vere/Pier.hs
View File

@ -122,17 +122,24 @@ runSerf
-> RAcquire e Serf -> RAcquire e Serf
runSerf vSlog pax = do runSerf vSlog pax = do
env <- ask env <- ask
Serf.withSerf (config env) heuSerf <- heuristicallyFindSerf
Serf.withSerf (config env heuSerf)
where where
slog txt = atomically (readTVar vSlog) >>= (\f -> f txt) slog txt = atomically (readTVar vSlog) >>= (\f -> f txt)
config env = Serf.Config config env heuSerf = Serf.Config
{ scSerf = env ^. pierConfigL . pcSerfExe . to unpack { scSerf = env ^. pierConfigL . pcSerfExe . to (unpack . fromMaybe heuSerf)
, scPier = pax , scPier = pax
, scFlag = env ^. pierConfigL . pcSerfFlags , scFlag = env ^. pierConfigL . pcSerfFlags
, scSlog = \(pri, tank) -> printTank slog pri tank , scSlog = \(pri, tank) -> printTank slog pri tank
, scStdr = \txt -> slog (txt <> "\r\n") , scStdr = \txt -> slog (txt <> "\r\n")
, scDead = pure () -- TODO: What can be done? , 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. ------------------------------------------------------------ -- Boot a new ship. ------------------------------------------------------------