-e_dumpthing (FoundThing name (Pos filename line token fullline)) =
- ---- (concat $ take (token + 1) $ spacedwords fullline)
- name
- ++ "\x7f" ++ (show line) ++ "," ++ (show $ line+1) ++ "\n"
-
-
--- like "words", but keeping the whitespace, and so letting us build
--- accurate prefixes
-
-spacedwords :: String -> [String]
-spacedwords [] = []
-spacedwords xs = (blanks ++ wordchars):(spacedwords rest2)
- where
- (blanks,rest) = span Char.isSpace xs
- (wordchars,rest2) = span (\x -> not $ Char.isSpace x) rest
-
-
--- Find the definitions in a file
-
-modsummary :: ModuleGraph -> FileName -> Maybe ModSummary
-modsummary graph n =
- List.find matches graph
- where matches ms = n == msHsFilePath ms
-
-modname :: ModSummary -> ModuleName
-modname summary = moduleName $ ms_mod $ summary
-
-findthings :: Session -> FileName -> IO FileData
-findthings session filename = do
- setTargets session [Target (TargetFile filename Nothing) Nothing]
- print "set targets"
- success <- load session LoadAllTargets --- bring module graph up to date
- case success of
- Failed -> do { print "load failed"; return emptyFileData }
- Succeeded ->
- do print "loaded all targets"
- graph <- getModuleGraph session
- print "got modules graph"
- case modsummary graph filename of
- Nothing -> panic "loaded a module from a file but then could not find its summary"
- Just ms -> do
- mod <- checkModule session (modname ms)
- print "got the module"
- case mod of
- Nothing -> return emptyFileData
- Just m -> case renamedSource m of
- Nothing -> return emptyFileData
- Just s -> return $ fileData filename s
- where emptyFileData = FileData filename []
-
-
-fileData :: FileName -> RenamedSource -> FileData
-fileData filename (group, imports, lie) =
- -- lie is related to type checking and so is irrelevant
- -- imports contains import declarations and no definitions
- FileData filename (boundValues group)
-
-boundValues :: HsGroup Name -> [FoundThing]
-boundValues group =
- let vals = case hs_valds group of
- ValBindsOut nest sigs ->
- [ x | (_rec, binds) <- nest, bind <- bagToList binds, x <- boundThings bind ]
- tys = concat $ map tyBound (hs_tyclds group)
- where tyBound ltcd = case unLoc ltcd of
- ForeignType { tcdLName = n } -> [foundOfLName n]
- TyData { tcdLName = n } -> [foundOfLName n]
- TySynonym { tcdLName = n } -> [foundOfLName n]
- ClassDecl { tcdLName = n } -> [foundOfLName n]
- fors = concat $ map forBound (hs_fords group)
- where forBound lford = case unLoc lford of
- ForeignImport n _ _ -> [foundOfLName n]
- ForeignExport { } -> []
- in vals ++ tys ++ fors
-
-posOfLocated :: Located a -> Pos
-posOfLocated lHs = srcLocToPos $ srcSpanStart $ getLoc lHs
-
-foundOfLName :: Located Name -> FoundThing
-foundOfLName id = FoundThing (getOccString $ unLoc id) (posOfLocated id)
-
-boundThings :: LHsBind Name -> [FoundThing]
-boundThings lbinding =
- let thing = foundOfLName
- in case unLoc lbinding of
- FunBind { fun_id = id } -> [thing id]
- PatBind { pat_lhs = lhs } -> panic "Pattern at top level"
- VarBind { var_id = id } -> [FoundThing (getOccString id) (posOfLocated lbinding)]
- AbsBinds { } -> [] -- nothing interesting in a type abstraction