mirror of
https://github.com/GaloisInc/cryptol.git
synced 2024-09-21 19:08:51 +03:00
Detailed help for interfaces.
Still to do: modules and funcotrs
This commit is contained in:
parent
180c90f9bb
commit
d413e3559b
@ -5,6 +5,7 @@ module Cryptol.REPL.Help (helpForNamed) where
|
|||||||
|
|
||||||
import Data.Text (Text)
|
import Data.Text (Text)
|
||||||
import qualified Data.Text as Text
|
import qualified Data.Text as Text
|
||||||
|
import Data.Map (Map)
|
||||||
import qualified Data.Map as Map
|
import qualified Data.Map as Map
|
||||||
import qualified Data.Set as Set
|
import qualified Data.Set as Set
|
||||||
import Data.Maybe(fromMaybe)
|
import Data.Maybe(fromMaybe)
|
||||||
@ -55,22 +56,78 @@ noInfo nameEnv name =
|
|||||||
M.LocalName {} -> rPutStrLn "// No documentation is available."
|
M.LocalName {} -> rPutStrLn "// No documentation is available."
|
||||||
|
|
||||||
|
|
||||||
|
-- | Show help for something in the module namespace.
|
||||||
showModHelp :: M.IfaceDecls -> NameDisp -> M.Name -> REPL ()
|
showModHelp :: M.IfaceDecls -> NameDisp -> M.Name -> REPL ()
|
||||||
showModHelp _env nameEnv x =
|
showModHelp env nameEnv name =
|
||||||
rPrint $ runDoc nameEnv $ vcat [ "`" <> pp x <> "` is a module." ]
|
fromMaybe (noInfo nameEnv name) $
|
||||||
-- XXX: show doc. if any
|
msum [ attempt M.ifModules showModuleHelp
|
||||||
|
, attempt M.ifFunctors showFunctorHelp
|
||||||
|
, attempt M.ifSignatures showSigHelp
|
||||||
|
]
|
||||||
|
|
||||||
|
where
|
||||||
|
attempt :: (M.IfaceDecls -> Map M.Name a) ->
|
||||||
|
(M.IfaceDecls -> NameDisp -> M.Name -> a -> REPL ()) ->
|
||||||
|
Maybe (REPL ())
|
||||||
|
attempt inMap doShow =
|
||||||
|
do th <- Map.lookup name (inMap env)
|
||||||
|
pure (doShow env nameEnv name th)
|
||||||
|
|
||||||
|
showModuleHelp ::
|
||||||
|
M.IfaceDecls -> NameDisp -> M.Name -> M.IfaceNames M.Name -> REPL ()
|
||||||
|
showModuleHelp _env nameEnv name info =
|
||||||
|
do rPrint $ runDoc nameEnv $ indent 4 $ vcat [ " ", ppM ]
|
||||||
|
doShowDocString (M.ifsDoc info)
|
||||||
|
|
||||||
|
where
|
||||||
|
ppM = vcat [ "module" <+> pp name <+> "exports:"
|
||||||
|
, indent 2 (vcat (map ppN (Set.toList (M.ifsPublic info))))
|
||||||
|
]
|
||||||
|
ppN x = pp x
|
||||||
|
|
||||||
|
|
||||||
|
showFunctorHelp ::
|
||||||
|
M.IfaceDecls -> NameDisp -> M.Name -> M.IfaceG M.Name -> REPL ()
|
||||||
|
showFunctorHelp env nameEnv name info =
|
||||||
|
rPrint $ runDoc nameEnv
|
||||||
|
$ vcat [ "`" <> pp name <> "` is a parameterized submodule." ]
|
||||||
|
|
||||||
|
showSigHelp ::
|
||||||
|
M.IfaceDecls -> NameDisp -> M.Name -> T.ModParamNames -> REPL ()
|
||||||
|
showSigHelp _env _nameEnv name info =
|
||||||
|
do rPutStrLn ""
|
||||||
|
ppDoc (indent 4 ppS)
|
||||||
|
case T.mpnDoc info of
|
||||||
|
Just d -> do rPutStrLn ""
|
||||||
|
rPutStrLn (Text.unpack d)
|
||||||
|
Nothing -> pure ()
|
||||||
|
|
||||||
showSigHelp :: M.IfaceDecls -> NameDisp -> M.Name -> REPL ()
|
where
|
||||||
showSigHelp env nameEnv name =
|
-- qualifying stuff is too noisy
|
||||||
do rPrint $ runDoc nameEnv $ vcat [ "`" <> pp name <> "` is a signature." ]
|
disp = NameDisp \_ -> Just UnQualified
|
||||||
fromMaybe (noInfo nameEnv name)
|
ppDoc d = rPrint (runDoc disp d)
|
||||||
do s <- Map.lookup name (M.ifSignatures env)
|
|
||||||
d <- T.mpnDoc s
|
ppS = vcat [ "interface" <+> pp name <+> "requires:"
|
||||||
pure (rPrint (pp d))
|
, indent 2 (vcat [ " ", ppTPs, ppCtrs, ppFPs ])
|
||||||
-- XXX: show doc. if any, and maybe other stuff
|
]
|
||||||
|
|
||||||
|
withDoc mb x = case mb of
|
||||||
|
Nothing -> x
|
||||||
|
Just d -> vcat [x, indent 2 (pp d)]
|
||||||
|
|
||||||
|
ppTPs = vcat (map ppTP (Map.elems (T.mpnTypes info)))
|
||||||
|
ppTP x = withDoc (T.mtpDoc x)
|
||||||
|
$ hsep ["type", pp (T.mtpName x), ":", pp (T.mtpKind x)]
|
||||||
|
|
||||||
|
ppCtrs = case T.mpnConstraints info of
|
||||||
|
[] -> mempty
|
||||||
|
cs -> vcat [" ", "satisfying:"
|
||||||
|
, indent 2 (vcat (map ppCtr cs)), " "]
|
||||||
|
ppCtr x = pp (P.thing x)
|
||||||
|
|
||||||
|
ppFPs = vcat (map ppFP (Map.elems (T.mpnFuns info)))
|
||||||
|
ppFP x = withDoc (T.mvpDoc x)
|
||||||
|
$ hsep [pp (T.mvpName x), ":" <+> pp (T.mvpType x) ]
|
||||||
|
|
||||||
|
|
||||||
showTypeHelp :: T.FunctorParams -> M.IfaceDecls -> NameDisp -> T.Name -> REPL ()
|
showTypeHelp :: T.FunctorParams -> M.IfaceDecls -> NameDisp -> T.Name -> REPL ()
|
||||||
|
@ -23,6 +23,7 @@ import qualified Data.Text as T
|
|||||||
import Data.Void (Void)
|
import Data.Void (Void)
|
||||||
import GHC.Generics (Generic)
|
import GHC.Generics (Generic)
|
||||||
import qualified Prettyprinter as PP
|
import qualified Prettyprinter as PP
|
||||||
|
import qualified Prettyprinter.Util as PP
|
||||||
import qualified Prettyprinter.Render.String as PP
|
import qualified Prettyprinter.Render.String as PP
|
||||||
|
|
||||||
-- | How to pretty print things when evaluating
|
-- | How to pretty print things when evaluating
|
||||||
@ -265,6 +266,9 @@ liftPP2 f (Doc a) (Doc b) = Doc (\e -> f (a e) (b e))
|
|||||||
liftSep :: ([PP.Doc Void] -> PP.Doc Void) -> ([Doc] -> Doc)
|
liftSep :: ([PP.Doc Void] -> PP.Doc Void) -> ([Doc] -> Doc)
|
||||||
liftSep f ds = Doc (\e -> f [ d e | Doc d <- ds ])
|
liftSep f ds = Doc (\e -> f [ d e | Doc d <- ds ])
|
||||||
|
|
||||||
|
reflow :: T.Text -> Doc
|
||||||
|
reflow x = liftPP (PP.reflow x)
|
||||||
|
|
||||||
infixl 6 <.>, <+>, </>
|
infixl 6 <.>, <+>, </>
|
||||||
|
|
||||||
(<.>) :: Doc -> Doc -> Doc
|
(<.>) :: Doc -> Doc -> Doc
|
||||||
|
Loading…
Reference in New Issue
Block a user