-----------------------------------------------------------------------------
--
-- GHCi's :ctags and :etags commands
--
-- (c) The GHC Team 2005-2007
--
-----------------------------------------------------------------------------

{-# OPTIONS_GHC -fno-warn-name-shadowing #-}
{-# OPTIONS_GHC -Wno-compat-unqualified-imports #-}

module Clash.GHCi.UI.Tags (
  createCTagsWithLineNumbersCmd,
  createCTagsWithRegExesCmd,
  createETagsFileCmd
) where

import Exception
import GHC
import Clash.GHCi.UI.Monad
import Outputable

-- ToDo: figure out whether we need these, and put something appropriate
-- into the GHC API instead
import Name (nameOccName)
import OccName (pprOccName)
import ConLike
import MonadUtils

import Control.Monad
import Data.Function
import Data.List
import Data.Maybe
import Data.Ord
import DriverPhases
import Panic
import Prelude
import System.Directory
import System.IO
import System.IO.Error

-----------------------------------------------------------------------------
-- create tags file for currently loaded modules.

createCTagsWithLineNumbersCmd, createCTagsWithRegExesCmd,
  createETagsFileCmd :: String -> GHCi ()

createCTagsWithLineNumbersCmd :: String -> GHCi ()
createCTagsWithLineNumbersCmd String
""   =
  TagsKind -> String -> GHCi ()
ghciCreateTagsFile TagsKind
CTagsWithLineNumbers String
"tags"
createCTagsWithLineNumbersCmd String
file =
  TagsKind -> String -> GHCi ()
ghciCreateTagsFile TagsKind
CTagsWithLineNumbers String
file

createCTagsWithRegExesCmd :: String -> GHCi ()
createCTagsWithRegExesCmd String
""   =
  TagsKind -> String -> GHCi ()
ghciCreateTagsFile TagsKind
CTagsWithRegExes String
"tags"
createCTagsWithRegExesCmd String
file =
  TagsKind -> String -> GHCi ()
ghciCreateTagsFile TagsKind
CTagsWithRegExes String
file

createETagsFileCmd :: String -> GHCi ()
createETagsFileCmd String
""    = TagsKind -> String -> GHCi ()
ghciCreateTagsFile TagsKind
ETags String
"TAGS"
createETagsFileCmd String
file  = TagsKind -> String -> GHCi ()
ghciCreateTagsFile TagsKind
ETags String
file

data TagsKind = ETags | CTagsWithLineNumbers | CTagsWithRegExes

ghciCreateTagsFile :: TagsKind -> FilePath -> GHCi ()
ghciCreateTagsFile :: TagsKind -> String -> GHCi ()
ghciCreateTagsFile TagsKind
kind String
file = do
  TagsKind -> String -> GHCi ()
createTagsFile TagsKind
kind String
file

-- ToDo:
--      - remove restriction that all modules must be interpreted
--        (problem: we don't know source locations for entities unless
--        we compiled the module.
--
--      - extract createTagsFile so it can be used from the command-line
--        (probably need to fix first problem before this is useful).
--
createTagsFile :: TagsKind -> FilePath -> GHCi ()
createTagsFile :: TagsKind -> String -> GHCi ()
createTagsFile TagsKind
tagskind String
tagsFile = do
  ModuleGraph
graph <- GHCi ModuleGraph
forall (m :: Type -> Type). GhcMonad m => m ModuleGraph
GHC.getModuleGraph
  [[TagInfo]]
mtags <- (Module -> GHCi [TagInfo]) -> [Module] -> GHCi [[TagInfo]]
forall (t :: Type -> Type) (m :: Type -> Type) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Module -> GHCi [TagInfo]
listModuleTags ((ModSummary -> Module) -> [ModSummary] -> [Module]
forall a b. (a -> b) -> [a] -> [b]
map ModSummary -> Module
GHC.ms_mod ([ModSummary] -> [Module]) -> [ModSummary] -> [Module]
forall a b. (a -> b) -> a -> b
$ ModuleGraph -> [ModSummary]
GHC.mgModSummaries ModuleGraph
graph)
  Either IOError ()
either_res <- IO (Either IOError ()) -> GHCi (Either IOError ())
forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
liftIO (IO (Either IOError ()) -> GHCi (Either IOError ()))
-> IO (Either IOError ()) -> GHCi (Either IOError ())
forall a b. (a -> b) -> a -> b
$ TagsKind -> String -> [TagInfo] -> IO (Either IOError ())
collateAndWriteTags TagsKind
tagskind String
tagsFile ([TagInfo] -> IO (Either IOError ()))
-> [TagInfo] -> IO (Either IOError ())
forall a b. (a -> b) -> a -> b
$ [[TagInfo]] -> [TagInfo]
forall (t :: Type -> Type) a. Foldable t => t [a] -> [a]
concat [[TagInfo]]
mtags
  case Either IOError ()
either_res of
    Left IOError
e  -> IO () -> GHCi ()
forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
liftIO (IO () -> GHCi ()) -> IO () -> GHCi ()
forall a b. (a -> b) -> a -> b
$ Handle -> String -> IO ()
hPutStrLn Handle
stderr (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ IOError -> String
ioeGetErrorString IOError
e
    Right ()
_ -> () -> GHCi ()
forall (m :: Type -> Type) a. Monad m => a -> m a
return ()


listModuleTags :: GHC.Module -> GHCi [TagInfo]
listModuleTags :: Module -> GHCi [TagInfo]
listModuleTags Module
m = do
  Bool
is_interpreted <- Module -> GHCi Bool
forall (m :: Type -> Type). GhcMonad m => Module -> m Bool
GHC.moduleIsInterpreted Module
m
  -- should we just skip these?
  Bool -> GHCi () -> GHCi ()
forall (f :: Type -> Type). Applicative f => Bool -> f () -> f ()
when (Bool -> Bool
not Bool
is_interpreted) (GHCi () -> GHCi ()) -> GHCi () -> GHCi ()
forall a b. (a -> b) -> a -> b
$
    let mName :: String
mName = ModuleName -> String
GHC.moduleNameString (Module -> ModuleName
GHC.moduleName Module
m) in
    GhcException -> GHCi ()
forall a. GhcException -> a
throwGhcException (String -> GhcException
CmdLineError (String
"module '" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
mName String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"' is not interpreted"))
  Maybe ModuleInfo
mbModInfo <- Module -> GHCi (Maybe ModuleInfo)
forall (m :: Type -> Type).
GhcMonad m =>
Module -> m (Maybe ModuleInfo)
GHC.getModuleInfo Module
m
  case Maybe ModuleInfo
mbModInfo of
    Maybe ModuleInfo
Nothing -> [TagInfo] -> GHCi [TagInfo]
forall (m :: Type -> Type) a. Monad m => a -> m a
return []
    Just ModuleInfo
mInfo -> do
       DynFlags
dflags <- GHCi DynFlags
forall (m :: Type -> Type). HasDynFlags m => m DynFlags
getDynFlags
       Maybe PrintUnqualified
mb_print_unqual <- ModuleInfo -> GHCi (Maybe PrintUnqualified)
forall (m :: Type -> Type).
GhcMonad m =>
ModuleInfo -> m (Maybe PrintUnqualified)
GHC.mkPrintUnqualifiedForModule ModuleInfo
mInfo
       let unqual :: PrintUnqualified
unqual = PrintUnqualified -> Maybe PrintUnqualified -> PrintUnqualified
forall a. a -> Maybe a -> a
fromMaybe PrintUnqualified
GHC.alwaysQualify Maybe PrintUnqualified
mb_print_unqual
       let names :: [Name]
names = [Name] -> Maybe [Name] -> [Name]
forall a. a -> Maybe a -> a
fromMaybe [] (Maybe [Name] -> [Name]) -> Maybe [Name] -> [Name]
forall a b. (a -> b) -> a -> b
$ModuleInfo -> Maybe [Name]
GHC.modInfoTopLevelScope ModuleInfo
mInfo
       let localNames :: [Name]
localNames = (Name -> Bool) -> [Name] -> [Name]
forall a. (a -> Bool) -> [a] -> [a]
filter ((Module
mModule -> Module -> Bool
forall a. Eq a => a -> a -> Bool
==) (Module -> Bool) -> (Name -> Module) -> Name -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HasDebugCallStack => Name -> Module
Name -> Module
nameModule) [Name]
names
       [Maybe TyThing]
mbTyThings <- (Name -> GHCi (Maybe TyThing)) -> [Name] -> GHCi [Maybe TyThing]
forall (t :: Type -> Type) (m :: Type -> Type) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Name -> GHCi (Maybe TyThing)
forall (m :: Type -> Type). GhcMonad m => Name -> m (Maybe TyThing)
GHC.lookupName [Name]
localNames
       [TagInfo] -> GHCi [TagInfo]
forall (m :: Type -> Type) a. Monad m => a -> m a
return ([TagInfo] -> GHCi [TagInfo]) -> [TagInfo] -> GHCi [TagInfo]
forall a b. (a -> b) -> a -> b
$! [ DynFlags
-> PrintUnqualified
-> Bool
-> Char
-> Name
-> RealSrcLoc
-> TagInfo
tagInfo DynFlags
dflags PrintUnqualified
unqual Bool
exported Char
kind Name
name RealSrcLoc
realLoc
                     | TyThing
tyThing <- [Maybe TyThing] -> [TyThing]
forall a. [Maybe a] -> [a]
catMaybes [Maybe TyThing]
mbTyThings
                     , let name :: Name
name = TyThing -> Name
forall a. NamedThing a => a -> Name
getName TyThing
tyThing
                     , let exported :: Bool
exported = ModuleInfo -> Name -> Bool
GHC.modInfoIsExportedName ModuleInfo
mInfo Name
name
                     , let kind :: Char
kind = TyThing -> Char
tyThing2TagKind TyThing
tyThing
                     , let loc :: SrcLoc
loc = SrcSpan -> SrcLoc
srcSpanStart (Name -> SrcSpan
nameSrcSpan Name
name)
                     , RealSrcLoc RealSrcLoc
realLoc <- [SrcLoc
loc]
                     ]

  where
    tyThing2TagKind :: TyThing -> Char
tyThing2TagKind (AnId Id
_)                 = Char
'v'
    tyThing2TagKind (AConLike RealDataCon{}) = Char
'd'
    tyThing2TagKind (AConLike PatSynCon{})   = Char
'p'
    tyThing2TagKind (ATyCon TyCon
_)               = Char
't'
    tyThing2TagKind (ACoAxiom CoAxiom Branched
_)             = Char
'x'


data TagInfo = TagInfo
  { TagInfo -> Bool
tagExported :: Bool -- is tag exported
  , TagInfo -> Char
tagKind :: Char   -- tag kind
  , TagInfo -> String
tagName :: String -- tag name
  , TagInfo -> String
tagFile :: String -- file name
  , TagInfo -> Int
tagLine :: Int    -- line number
  , TagInfo -> Int
tagCol :: Int     -- column number
  , TagInfo -> Maybe (String, Integer)
tagSrcInfo :: Maybe (String,Integer)  -- source code line and char offset
  }


-- get tag info, for later translation into Vim or Emacs style
tagInfo :: DynFlags -> PrintUnqualified -> Bool -> Char -> Name -> RealSrcLoc
        -> TagInfo
tagInfo :: DynFlags
-> PrintUnqualified
-> Bool
-> Char
-> Name
-> RealSrcLoc
-> TagInfo
tagInfo DynFlags
dflags PrintUnqualified
unqual Bool
exported Char
kind Name
name RealSrcLoc
loc
    = Bool
-> Char
-> String
-> String
-> Int
-> Int
-> Maybe (String, Integer)
-> TagInfo
TagInfo Bool
exported Char
kind
        (DynFlags -> PrintUnqualified -> SDoc -> String
showSDocForUser DynFlags
dflags PrintUnqualified
unqual (SDoc -> String) -> SDoc -> String
forall a b. (a -> b) -> a -> b
$ OccName -> SDoc
pprOccName (Name -> OccName
nameOccName Name
name))
        (DynFlags -> PrintUnqualified -> SDoc -> String
showSDocForUser DynFlags
dflags PrintUnqualified
unqual (SDoc -> String) -> SDoc -> String
forall a b. (a -> b) -> a -> b
$ FastString -> SDoc
ftext (RealSrcLoc -> FastString
srcLocFile RealSrcLoc
loc))
        (RealSrcLoc -> Int
srcLocLine RealSrcLoc
loc) (RealSrcLoc -> Int
srcLocCol RealSrcLoc
loc) Maybe (String, Integer)
forall a. Maybe a
Nothing

-- throw an exception when someone tries to overwrite existing source file (fix for #10989)
writeTagsSafely :: FilePath -> String -> IO ()
writeTagsSafely :: String -> String -> IO ()
writeTagsSafely String
file String
str = do
    Bool
dfe <- String -> IO Bool
doesFileExist String
file
    if Bool
dfe Bool -> Bool -> Bool
&& String -> Bool
isSourceFilename String
file
        then GhcException -> IO ()
forall a. GhcException -> a
throwGhcException (String -> GhcException
CmdLineError (String
file String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" is existing source file. " String -> String -> String
forall a. [a] -> [a] -> [a]
++
             String
"Please specify another file name to store tags data"))
        else String -> String -> IO ()
writeFile String
file String
str

collateAndWriteTags :: TagsKind -> FilePath -> [TagInfo] -> IO (Either IOError ())
-- ctags style with the Ex expression being just the line number, Vim et al
collateAndWriteTags :: TagsKind -> String -> [TagInfo] -> IO (Either IOError ())
collateAndWriteTags TagsKind
CTagsWithLineNumbers String
file [TagInfo]
tagInfos = do
  let tags :: String
tags = [String] -> String
unlines ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$ [String] -> [String]
forall a. Ord a => [a] -> [a]
sort ([String] -> [String]) -> [String] -> [String]
forall a b. (a -> b) -> a -> b
$ (TagInfo -> String) -> [TagInfo] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map TagInfo -> String
showCTag [TagInfo]
tagInfos
  IO () -> IO (Either IOError ())
forall a. IO a -> IO (Either IOError a)
tryIO (String -> String -> IO ()
writeTagsSafely String
file String
tags)

-- ctags style with the Ex expression being a regex searching the line, Vim et al
collateAndWriteTags TagsKind
CTagsWithRegExes String
file [TagInfo]
tagInfos = do -- ctags style, Vim et al
  [[TagInfo]]
tagInfoGroups <- [TagInfo] -> IO [[TagInfo]]
makeTagGroupsWithSrcInfo [TagInfo]
tagInfos
  let tags :: String
tags = [String] -> String
unlines ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$ [String] -> [String]
forall a. Ord a => [a] -> [a]
sort ([String] -> [String]) -> [String] -> [String]
forall a b. (a -> b) -> a -> b
$ (TagInfo -> String) -> [TagInfo] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map TagInfo -> String
showCTag ([TagInfo] -> [String]) -> [TagInfo] -> [String]
forall a b. (a -> b) -> a -> b
$[[TagInfo]] -> [TagInfo]
forall (t :: Type -> Type) a. Foldable t => t [a] -> [a]
concat [[TagInfo]]
tagInfoGroups
  IO () -> IO (Either IOError ())
forall a. IO a -> IO (Either IOError a)
tryIO (String -> String -> IO ()
writeTagsSafely String
file String
tags)

collateAndWriteTags TagsKind
ETags String
file [TagInfo]
tagInfos = do -- etags style, Emacs/XEmacs
  [[TagInfo]]
tagInfoGroups <- [TagInfo] -> IO [[TagInfo]]
makeTagGroupsWithSrcInfo ([TagInfo] -> IO [[TagInfo]]) -> [TagInfo] -> IO [[TagInfo]]
forall a b. (a -> b) -> a -> b
$(TagInfo -> Bool) -> [TagInfo] -> [TagInfo]
forall a. (a -> Bool) -> [a] -> [a]
filter TagInfo -> Bool
tagExported [TagInfo]
tagInfos
  let tagGroups :: [String]
tagGroups = ([TagInfo] -> String) -> [[TagInfo]] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map [TagInfo] -> String
processGroup [[TagInfo]]
tagInfoGroups
  IO () -> IO (Either IOError ())
forall a. IO a -> IO (Either IOError a)
tryIO (String -> String -> IO ()
writeTagsSafely String
file (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ [String] -> String
forall (t :: Type -> Type) a. Foldable t => t [a] -> [a]
concat [String]
tagGroups)

  where
    processGroup :: [TagInfo] -> String
processGroup [] = GhcException -> String
forall a. GhcException -> a
throwGhcException (String -> GhcException
CmdLineError String
"empty tag file group??")
    processGroup group :: [TagInfo]
group@(TagInfo
tagInfo:[TagInfo]
_) =
      let tags :: String
tags = [String] -> String
unlines ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$ (TagInfo -> String) -> [TagInfo] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map TagInfo -> String
showETag [TagInfo]
group in
      String
"\x0c\n" String -> String -> String
forall a. [a] -> [a] -> [a]
++ TagInfo -> String
tagFile TagInfo
tagInfo String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"," String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show (String -> Int
forall (t :: Type -> Type) a. Foldable t => t a -> Int
length String
tags) String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"\n" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
tags


makeTagGroupsWithSrcInfo :: [TagInfo] -> IO [[TagInfo]]
makeTagGroupsWithSrcInfo :: [TagInfo] -> IO [[TagInfo]]
makeTagGroupsWithSrcInfo [TagInfo]
tagInfos = do
  let groups :: [[TagInfo]]
groups = (TagInfo -> TagInfo -> Bool) -> [TagInfo] -> [[TagInfo]]
forall a. (a -> a -> Bool) -> [a] -> [[a]]
groupBy (String -> String -> Bool
forall a. Eq a => a -> a -> Bool
(==) (String -> String -> Bool)
-> (TagInfo -> String) -> TagInfo -> TagInfo -> Bool
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` TagInfo -> String
tagFile) ([TagInfo] -> [[TagInfo]]) -> [TagInfo] -> [[TagInfo]]
forall a b. (a -> b) -> a -> b
$ (TagInfo -> TagInfo -> Ordering) -> [TagInfo] -> [TagInfo]
forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy ((TagInfo -> String) -> TagInfo -> TagInfo -> Ordering
forall a b. Ord a => (b -> a) -> b -> b -> Ordering
comparing TagInfo -> String
tagFile) [TagInfo]
tagInfos
  ([TagInfo] -> IO [TagInfo]) -> [[TagInfo]] -> IO [[TagInfo]]
forall (t :: Type -> Type) (m :: Type -> Type) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM [TagInfo] -> IO [TagInfo]
addTagSrcInfo [[TagInfo]]
groups

  where
    addTagSrcInfo :: [TagInfo] -> IO [TagInfo]
addTagSrcInfo [] = GhcException -> IO [TagInfo]
forall a. GhcException -> a
throwGhcException (String -> GhcException
CmdLineError String
"empty tag file group??")
    addTagSrcInfo group :: [TagInfo]
group@(TagInfo
tagInfo:[TagInfo]
_) = do
      String
file <- String -> IO String
readFile (String -> IO String) -> String -> IO String
forall a b. (a -> b) -> a -> b
$TagInfo -> String
tagFile TagInfo
tagInfo
      let sortedGroup :: [TagInfo]
sortedGroup = (TagInfo -> TagInfo -> Ordering) -> [TagInfo] -> [TagInfo]
forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy ((TagInfo -> Int) -> TagInfo -> TagInfo -> Ordering
forall a b. Ord a => (b -> a) -> b -> b -> Ordering
comparing TagInfo -> Int
tagLine) [TagInfo]
group
      [TagInfo] -> IO [TagInfo]
forall (m :: Type -> Type) a. Monad m => a -> m a
return ([TagInfo] -> IO [TagInfo]) -> [TagInfo] -> IO [TagInfo]
forall a b. (a -> b) -> a -> b
$ [TagInfo] -> Int -> Integer -> [String] -> [TagInfo]
perFile [TagInfo]
sortedGroup Int
1 Integer
0 ([String] -> [TagInfo]) -> [String] -> [TagInfo]
forall a b. (a -> b) -> a -> b
$ String -> [String]
lines String
file

    perFile :: [TagInfo] -> Int -> Integer -> [String] -> [TagInfo]
perFile allTags :: [TagInfo]
allTags@(TagInfo
tag:[TagInfo]
tags) Int
cnt Integer
pos allLs :: [String]
allLs@(String
l:[String]
ls)
     | TagInfo -> Int
tagLine TagInfo
tag Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
cnt =
         [TagInfo] -> Int -> Integer -> [String] -> [TagInfo]
perFile [TagInfo]
allTags (Int
cntInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) (Integer
posInteger -> Integer -> Integer
forall a. Num a => a -> a -> a
+Int -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral(String -> Int
forall (t :: Type -> Type) a. Foldable t => t a -> Int
length String
l)) [String]
ls
     | TagInfo -> Int
tagLine TagInfo
tag Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
cnt =
         TagInfo
tag{ tagSrcInfo :: Maybe (String, Integer)
tagSrcInfo = (String, Integer) -> Maybe (String, Integer)
forall a. a -> Maybe a
Just(String
l,Integer
pos) } TagInfo -> [TagInfo] -> [TagInfo]
forall a. a -> [a] -> [a]
: [TagInfo] -> Int -> Integer -> [String] -> [TagInfo]
perFile [TagInfo]
tags Int
cnt Integer
pos [String]
allLs
    perFile [TagInfo]
_ Int
_ Integer
_ [String]
_ = []


-- ctags format, for Vim et al
showCTag :: TagInfo -> String
showCTag :: TagInfo -> String
showCTag TagInfo
ti =
  TagInfo -> String
tagName TagInfo
ti String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"\t" String -> String -> String
forall a. [a] -> [a] -> [a]
++ TagInfo -> String
tagFile TagInfo
ti String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"\t" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
tagCmd String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
";\"\t" String -> String -> String
forall a. [a] -> [a] -> [a]
++
    TagInfo -> Char
tagKind TagInfo
ti Char -> String -> String
forall a. a -> [a] -> [a]
: ( if TagInfo -> Bool
tagExported TagInfo
ti then String
"" else String
"\tfile:" )

  where
    tagCmd :: String
tagCmd =
      case TagInfo -> Maybe (String, Integer)
tagSrcInfo TagInfo
ti of
        Maybe (String, Integer)
Nothing -> Int -> String
forall a. Show a => a -> String
show (Int -> String) -> Int -> String
forall a b. (a -> b) -> a -> b
$TagInfo -> Int
tagLine TagInfo
ti
        Just (String
srcLine,Integer
_) -> String
"/^"String -> String -> String
forall a. [a] -> [a] -> [a]
++ (Char -> String -> String) -> String -> String -> String
forall (t :: Type -> Type) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Char -> String -> String
escapeSlashes [] String
srcLine String -> String -> String
forall a. [a] -> [a] -> [a]
++String
"$/"

      where
        escapeSlashes :: Char -> String -> String
escapeSlashes Char
'/' String
r = Char
'\\' Char -> String -> String
forall a. a -> [a] -> [a]
: Char
'/' Char -> String -> String
forall a. a -> [a] -> [a]
: String
r
        escapeSlashes Char
'\\' String
r = Char
'\\' Char -> String -> String
forall a. a -> [a] -> [a]
: Char
'\\' Char -> String -> String
forall a. a -> [a] -> [a]
: String
r
        escapeSlashes Char
c String
r = Char
c Char -> String -> String
forall a. a -> [a] -> [a]
: String
r


-- etags format, for Emacs/XEmacs
showETag :: TagInfo -> String
showETag :: TagInfo -> String
showETag TagInfo{ tagName :: TagInfo -> String
tagName = String
tag, tagLine :: TagInfo -> Int
tagLine = Int
lineNo, tagCol :: TagInfo -> Int
tagCol = Int
colNo,
                  tagSrcInfo :: TagInfo -> Maybe (String, Integer)
tagSrcInfo = Just (String
srcLine,Integer
charPos) }
    =  Int -> String -> String
forall a. Int -> [a] -> [a]
take (Int
colNo Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) String
srcLine String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
tag
    String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"\x7f" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
tag
    String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"\x01" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
lineNo
    String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"," String -> String -> String
forall a. [a] -> [a] -> [a]
++ Integer -> String
forall a. Show a => a -> String
show Integer
charPos
showETag TagInfo
_ = GhcException -> String
forall a. GhcException -> a
throwGhcException (String -> GhcException
CmdLineError String
"missing source file info in showETag")