Locate.hs

{-# OPTIONS -Wall #-}

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 FastString (unpackFS)
import GHC.Paths (libdir)
import SrcLoc
import GHC (GhcMonad)

-- | This function implements the mode 'locate'.
--
-- 'locate' takes the name of a file and a position within this file.  If this
-- position points to a value or function binding this function returns the
-- source-range where the binding is defined. If the position doesn't point to
-- an according binding, the function will fail with an exception. In this
-- case nothing is written to standard output.
--
-- The first two command line parameters is:
--
--  - The GHC options as string list (as they should appear on the command
--    line, e.g. @[\"-isrc\"]@)
locate :: [String] -> FilePath -> BufLoc -> IO (FilePath,BufSpan)
locate ghcOptions filename reqLoc = 
    runGhcWithCmdLineFlags ghcOptions (Just libdir) $ locateM filename reqLoc

-- | This function creates a string of the result returned by locate or
-- locateM.
--
-- The string has exactly the format that should be understood by text editors
-- that are using the mode locate.
showLocateResult 
    :: FilePath           -- ^ The current working dir (to make pathes relative)
    -> (FilePath,BufSpan) -- ^ The position that should be converted to string
    -> String
showLocateResult cwd loc = showSpan cwd loc

-- | This is a variant of locate that runs within the GHC monad and therefore
-- allows a more fine-grained control over the behaviour of GHC.
locateM :: GhcMonad m => FilePath -> BufLoc -> m (FilePath,BufSpan)
locateM filename reqLoc = do

    (SearchedTokenInfo { result = (searchedBinding,sig) }) <- searchFunctionBindingM filename reqLoc Nothing
    -- 
    -- The mode locate is only able to return one (single) source range.
    -- However in most cases the user will want to get shown the binding
    -- signature as well. So in cases where the signature is located directly
    -- before the binding (this will be in most cases) 'locate' returns a span
    -- that also coverts the function signature.
    --
    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                             = unpackFS $ srcSpanFile bindLoc
    return (bindingFile,r)