mirror of
https://github.com/carp-lang/Carp.git
synced 2024-09-11 13:37:57 +03:00
docs: set infoFile on primitives and commands (#1273)
This commit is contained in:
parent
00c85cac42
commit
ca0f9f7d4f
@ -64,7 +64,7 @@ addCmd path callback doc example =
|
|||||||
XObj (Arr args) Nothing Nothing
|
XObj (Arr args) Nothing Nothing
|
||||||
]
|
]
|
||||||
)
|
)
|
||||||
(Just dummyInfo)
|
(Just dummyInfo {infoFile = "Core Commands"})
|
||||||
(Just DynamicTy)
|
(Just DynamicTy)
|
||||||
args = (\x -> XObj (Sym (SymPath [] x) Symbol) Nothing Nothing) <$> argnames
|
args = (\x -> XObj (Sym (SymPath [] x) Symbol) Nothing Nothing) <$> argnames
|
||||||
argnames = case callback of
|
argnames = case callback of
|
||||||
@ -743,7 +743,6 @@ commandSaveDocsEx ctx modulePaths filePaths = do
|
|||||||
Right ok -> saveDocs ctx ok
|
Right ok -> saveDocs ctx ok
|
||||||
where
|
where
|
||||||
globalEnv = contextGlobalEnv ctx
|
globalEnv = contextGlobalEnv ctx
|
||||||
|
|
||||||
modulesAndGlobals =
|
modulesAndGlobals =
|
||||||
let (_, mods) = modules
|
let (_, mods) = modules
|
||||||
(_, globs) = filesWithGlobals
|
(_, globs) = filesWithGlobals
|
||||||
@ -751,7 +750,6 @@ commandSaveDocsEx ctx modulePaths filePaths = do
|
|||||||
okMods <- mods
|
okMods <- mods
|
||||||
okGlobs <- globs
|
okGlobs <- globs
|
||||||
pure (okMods ++ okGlobs)
|
pure (okMods ++ okGlobs)
|
||||||
|
|
||||||
modules :: (Context, Either EvalError [(SymPath, Binder)])
|
modules :: (Context, Either EvalError [(SymPath, Binder)])
|
||||||
modules = do
|
modules = do
|
||||||
case modulePaths of
|
case modulePaths of
|
||||||
@ -764,7 +762,6 @@ commandSaveDocsEx ctx modulePaths filePaths = do
|
|||||||
Right okEnvBinders -> (ctx, Right (zip okPaths okEnvBinders))
|
Right okEnvBinders -> (ctx, Right (zip okPaths okEnvBinders))
|
||||||
x ->
|
x ->
|
||||||
evalError ctx ("Invalid first arg to save-docs-internal (expected array of symbols): " ++ pretty x) (xobjInfo modulePaths)
|
evalError ctx ("Invalid first arg to save-docs-internal (expected array of symbols): " ++ pretty x) (xobjInfo modulePaths)
|
||||||
|
|
||||||
filesWithGlobals :: (Context, Either EvalError [(SymPath, Binder)])
|
filesWithGlobals :: (Context, Either EvalError [(SymPath, Binder)])
|
||||||
filesWithGlobals = do
|
filesWithGlobals = do
|
||||||
case filePaths of
|
case filePaths of
|
||||||
@ -777,7 +774,6 @@ commandSaveDocsEx ctx modulePaths filePaths = do
|
|||||||
in (ctx, Right fauxModules)
|
in (ctx, Right fauxModules)
|
||||||
x ->
|
x ->
|
||||||
evalError ctx ("Invalid second arg to save-docs-internal (expected array of strings containing filenames): " ++ pretty x) (xobjInfo filePaths)
|
evalError ctx ("Invalid second arg to save-docs-internal (expected array of strings containing filenames): " ++ pretty x) (xobjInfo filePaths)
|
||||||
|
|
||||||
createFauxModule :: String -> Map.Map String Binder -> (SymPath, Binder)
|
createFauxModule :: String -> Map.Map String Binder -> (SymPath, Binder)
|
||||||
createFauxModule filename binders =
|
createFauxModule filename binders =
|
||||||
let moduleName = "Globals in " ++ filename
|
let moduleName = "Globals in " ++ filename
|
||||||
@ -785,7 +781,6 @@ commandSaveDocsEx ctx modulePaths filePaths = do
|
|||||||
fauxGlobalModuleWithBindings = fauxGlobalModule {envBindings = binders}
|
fauxGlobalModuleWithBindings = fauxGlobalModule {envBindings = binders}
|
||||||
fauxTypeEnv = E.new Nothing Nothing
|
fauxTypeEnv = E.new Nothing Nothing
|
||||||
in (SymPath [] moduleName, Binder emptyMeta (XObj (Mod fauxGlobalModuleWithBindings fauxTypeEnv) Nothing Nothing))
|
in (SymPath [] moduleName, Binder emptyMeta (XObj (Mod fauxGlobalModuleWithBindings fauxTypeEnv) Nothing Nothing))
|
||||||
|
|
||||||
getEnvironmentBinderForDocumentation :: Env -> SymPath -> Either String Binder
|
getEnvironmentBinderForDocumentation :: Env -> SymPath -> Either String Binder
|
||||||
getEnvironmentBinderForDocumentation env path =
|
getEnvironmentBinderForDocumentation env path =
|
||||||
case E.searchValueBinder env path of
|
case E.searchValueBinder env path of
|
||||||
@ -795,11 +790,9 @@ commandSaveDocsEx ctx modulePaths filePaths = do
|
|||||||
Left ("I can’t generate documentation for `" ++ pretty x ++ "` because it isn’t a module")
|
Left ("I can’t generate documentation for `" ++ pretty x ++ "` because it isn’t a module")
|
||||||
Left _ ->
|
Left _ ->
|
||||||
Left ("I can’t find the module `" ++ show path ++ "`")
|
Left ("I can’t find the module `" ++ show path ++ "`")
|
||||||
|
|
||||||
getGlobalBindersForDocumentation :: Env -> String -> Map.Map String Binder
|
getGlobalBindersForDocumentation :: Env -> String -> Map.Map String Binder
|
||||||
getGlobalBindersForDocumentation env filename =
|
getGlobalBindersForDocumentation env filename =
|
||||||
Map.filter (\bind -> (binderFilename bind) == filename) (envBindings env)
|
Map.filter (\bind -> (binderFilename bind) == filename) (envBindings env)
|
||||||
|
|
||||||
binderFilename :: Binder -> String
|
binderFilename :: Binder -> String
|
||||||
binderFilename = takeFileName . fromMaybe "" . fmap infoFile . xobjInfo . binderXObj
|
binderFilename = takeFileName . fromMaybe "" . fmap infoFile . xobjInfo . binderXObj
|
||||||
|
|
||||||
|
@ -74,7 +74,7 @@ makePrim path callback doc example =
|
|||||||
XObj (Arr args) Nothing Nothing
|
XObj (Arr args) Nothing Nothing
|
||||||
]
|
]
|
||||||
)
|
)
|
||||||
(Just dummyInfo)
|
(Just dummyInfo {infoFile = "Core Primitives"})
|
||||||
(Just DynamicTy)
|
(Just DynamicTy)
|
||||||
args = (\x -> XObj (Sym (SymPath [] x) Symbol) Nothing Nothing) <$> argnames
|
args = (\x -> XObj (Sym (SymPath [] x) Symbol) Nothing Nothing) <$> argnames
|
||||||
argnames = case callback of
|
argnames = case callback of
|
||||||
@ -371,7 +371,6 @@ primitiveMembers _ ctx xobj@(XObj (Sym path _) _ _) =
|
|||||||
go (XObj (Lst ((XObj (DefSumtype _) _ _) : _ : cases)) _ _) =
|
go (XObj (Lst ((XObj (DefSumtype _) _ _) : _ : cases)) _ _) =
|
||||||
pure $ (ctx, (either Left (\a -> Right (XObj (Arr (concat a)) Nothing Nothing)) (mapM getMembersFromCase cases)))
|
pure $ (ctx, (either Left (\a -> Right (XObj (Arr (concat a)) Nothing Nothing)) (mapM getMembersFromCase cases)))
|
||||||
go x = pure (toEvalError ctx x (NonTypeInTypeEnv path x))
|
go x = pure (toEvalError ctx x (NonTypeInTypeEnv path x))
|
||||||
|
|
||||||
getMembersFromCase :: XObj -> Either EvalError [XObj]
|
getMembersFromCase :: XObj -> Either EvalError [XObj]
|
||||||
getMembersFromCase (XObj (Lst members) _ _) =
|
getMembersFromCase (XObj (Lst members) _ _) =
|
||||||
Right (map (\(a, b) -> XObj (Lst [a, b]) Nothing Nothing) (pairwise members))
|
Right (map (\(a, b) -> XObj (Lst [a, b]) Nothing Nothing) (pairwise members))
|
||||||
@ -666,7 +665,6 @@ primitiveUse xobj ctx (XObj (Sym path _) _ _) =
|
|||||||
updateGlobalUsePaths :: Env -> SymPath -> (Context, Either EvalError XObj)
|
updateGlobalUsePaths :: Env -> SymPath -> (Context, Either EvalError XObj)
|
||||||
updateGlobalUsePaths e spath =
|
updateGlobalUsePaths e spath =
|
||||||
((replaceGlobalEnv ctx (addUsePath e spath)), dynamicNil)
|
((replaceGlobalEnv ctx (addUsePath e spath)), dynamicNil)
|
||||||
|
|
||||||
updateModuleUsePaths :: Env -> SymPath -> Binder -> SymPath -> (Context, Either EvalError XObj)
|
updateModuleUsePaths :: Env -> SymPath -> Binder -> SymPath -> (Context, Either EvalError XObj)
|
||||||
updateModuleUsePaths e p (Binder meta (XObj (Mod ev et) i t)) spath =
|
updateModuleUsePaths e p (Binder meta (XObj (Mod ev et) i t)) spath =
|
||||||
either
|
either
|
||||||
|
Loading…
Reference in New Issue
Block a user