+-- Browing a module's contents
+
+browseCmd :: String -> GHCi ()
+browseCmd m =
+ case words m of
+ ['*':m] | looksLikeModuleName m -> browseModule m True
+ [m] | looksLikeModuleName m -> browseModule m False
+ _ -> throwDyn (CmdLineError "syntax: :browse <module>")
+
+browseModule m exports_only = do
+ cms <- getCmState
+ dflags <- io getDynFlags
+
+ is_interpreted <- io (cmModuleIsInterpreted cms m)
+ when (not is_interpreted && not exports_only) $
+ throwDyn (CmdLineError ("module `" ++ m ++ "' is not interpreted"))
+
+ -- temporarily set the context to the module we're interested in,
+ -- just so we can get an appropriate PrintUnqualified
+ (as,bs) <- io (cmGetContext cms)
+ cms1 <- io (if exports_only then cmSetContext cms dflags [] [prel,m]
+ else cmSetContext cms dflags [m] [])
+ cms2 <- io (cmSetContext cms1 dflags as bs)
+
+ (cms3, things) <- io (cmBrowseModule cms2 dflags m exports_only)
+
+ setCmState cms3
+
+ let unqual = cmGetPrintUnqual cms1 -- NOTE: cms1 with the new context
+
+ things' = filter wantToSee things
+
+ wantToSee (AnId id) = not (isDataConId id || isDataConWrapId id)
+ wantToSee _ = True
+
+ thing_names = map getName things
+
+ thingDecl thing@(AnId id) = ifaceTyThing thing
+
+ thingDecl thing@(AClass c) =
+ let rn_decl = ifaceTyThing thing in
+ case rn_decl of
+ ClassDecl { tcdSigs = cons } ->
+ rn_decl{ tcdSigs = filter methodIsVisible cons }
+ other -> other
+ where
+ methodIsVisible (ClassOpSig n _ _ _) = n `elem` thing_names
+
+ thingDecl thing@(ATyCon t) =
+ let rn_decl = ifaceTyThing thing in
+ case rn_decl of
+ TyData { tcdCons = cons } ->
+ rn_decl{ tcdCons = filter conIsVisible cons }
+ other -> other
+ where
+ conIsVisible (ConDecl n _ _ _ _ _) = n `elem` thing_names
+
+ io (putStrLn (showSDocForUser unqual (
+ vcat (map (ppr . thingDecl) things')))
+ )
+
+ where
+
+-----------------------------------------------------------------------------
projects / ghc-hetmet.git / blobdiff