bf6: show man for bound alias

This commit is contained in:
voidlizard 2025-02-23 06:42:35 +03:00
parent f96f37f9d1
commit 1edd50008c
3 changed files with 24 additions and 14 deletions

View File

@ -487,6 +487,8 @@ compression ; prints compression level
manifest <- Repo.getRepoManifest manifest <- Repo.getRepoManifest
liftIO $ print $ pretty $ mkForm "manifest" (coerce manifest) liftIO $ print $ pretty $ mkForm "manifest" (coerce manifest)
entry $ bindAlias "manifest" "repo:manifest"
brief "shows repo reflog" $ brief "shows repo reflog" $
entry $ bindMatch "repo:reflog" $ nil_ $ \syn -> lift $ connectedDo do entry $ bindMatch "repo:reflog" $ nil_ $ \syn -> lift $ connectedDo do
resolveRepo syn resolveRepo syn

View File

@ -40,12 +40,18 @@ helpList hasDoc p = do
docDefined _ = False docDefined _ = False
helpEntry :: MonadUnliftIO m => Id -> RunM c m () helpEntry :: MonadUnliftIO m => Id -> RunM c m ()
helpEntry what = do helpEntry what' = do
man <- ask >>= readTVarIO
<&> HM.lookup what
<&> maybe mzero bindMan
liftIO $ hPutDoc stdout (pretty man) found <- flip fix what' $ \next what -> do
ask >>= readTVarIO
<&> HM.lookup what
<&> (bindMan =<<)
>>= \case
Nothing -> pure Nothing
Just (Man{manIsAliasFor = Just x, manBrief = Nothing}) -> next x
Just x -> pure (Just ( x { manName = Just (ManName what') } ))
liftIO $ hPutDoc stdout (pretty found)
pattern HelpEntryBound :: forall {c}. Id -> [Syntax c] pattern HelpEntryBound :: forall {c}. Id -> [Syntax c]
pattern HelpEntryBound what <- [ListVal (SymbolVal "builtin:lambda" : SymbolVal what : _ )] pattern HelpEntryBound what <- [ListVal (SymbolVal "builtin:lambda" : SymbolVal what : _ )]

View File

@ -120,11 +120,12 @@ data Man a =
, manDesc :: Maybe ManDesc , manDesc :: Maybe ManDesc
, manReturns :: Maybe ManReturns , manReturns :: Maybe ManReturns
, manExamples :: [ManExamples] , manExamples :: [ManExamples]
, manIsAliasFor :: Maybe Id
} }
deriving stock (Eq,Show,Generic) deriving stock (Eq,Show,Generic)
instance Monoid (Man a) where instance Monoid (Man a) where
mempty = Man Nothing False Nothing mempty Nothing Nothing mempty mempty = Man Nothing False Nothing mempty Nothing Nothing mempty Nothing
instance Semigroup (Man a) where instance Semigroup (Man a) where
(<>) a b = Man (manName b <|> manName a) (<>) a b = Man (manName b <|> manName a)
@ -134,6 +135,7 @@ instance Semigroup (Man a) where
(manDesc b <|> manDesc a) (manDesc b <|> manDesc a)
(manReturns b <|> manReturns a) (manReturns b <|> manReturns a)
(manExamples a <> manExamples b) (manExamples a <> manExamples b)
(manIsAliasFor b <|> manIsAliasFor a)
instance ManNameOf Id a where instance ManNameOf Id a where
manNameOf = ManName manNameOf = ManName
@ -873,7 +875,7 @@ bindAlias :: forall c m . ( MonadUnliftIO m
=> Id -> Id -> Dict c m => Id -> Id -> Dict c m
bindAlias n fn = HM.singleton n (Bind man (BindLambda callAlias)) bindAlias n fn = HM.singleton n (Bind man (BindLambda callAlias))
where where
man = Just $ mempty { manName = Just (manNameOf n) } man = Just $ mempty { manName = Just (manNameOf n), manIsAliasFor = Just fn }
callAlias syn = do callAlias syn = do
ask >>= readTVarIO ask >>= readTVarIO
<&> (fmap bindAction . HM.lookup fn) <&> (fmap bindAction . HM.lookup fn)