module Language.Haskell.HBB.Locate (
locate,
locateM,
showLocateResult,
BufLoc(..),
BufSpan(..)
) where
import Language.Haskell.HBB.Internal.GHCHighlevel
import Language.Haskell.HBB.Internal.SrcSpan
import Language.Haskell.HBB.Internal.GHC
import System.Directory (getCurrentDirectory)
import FastString (unpackFS)
import GHC.Paths (libdir)
import GhcMonad (liftIO)
import SrcLoc
import GHC (GhcMonad)
locate :: [String] -> FilePath -> BufLoc -> IO (FilePath,BufSpan)
locate ghcOptions filename reqLoc =
runGhcWithCmdLineFlags ghcOptions (Just libdir) $ locateM filename reqLoc
showLocateResult
:: (FilePath,BufSpan)
-> String
showLocateResult loc = showSpan Nothing loc
locateM :: GhcMonad m => FilePath -> BufLoc -> m (FilePath,BufSpan)
locateM filename reqLoc = do
cwd <- liftIO $ getCurrentDirectory
(SearchedTokenInfo { result = (searchedBinding,sig) }) <- searchFunctionBindingM filename reqLoc Nothing
let (L (RealSrcSpan bindLoc) _) = searchedBinding
r = case sig of
Nothing -> toBufSpan bindLoc
Just (L (RealSrcSpan l) _) ->
let (BufSpan (BufLoc bl bc) end) = toBufSpan bindLoc
(BufSpan (BufLoc sl sc) _ ) = toBufSpan l
in if bc == sc && bl == (sl + 1)
then BufSpan (BufLoc sl sc) end
else toBufSpan bindLoc
Just _ -> toBufSpan bindLoc
bindingFile = normalisePath cwd $ unpackFS $ srcSpanFile bindLoc
return (bindingFile,r)