{-# LANGUAGE CPP #-}
{-# LANGUAGE OverloadedStrings #-}

-- | Functions specific to vim tags.
module FastTags.Vim (
    merge, dropAdjacentInFile
    -- for tests
    , Parsed(..), parseTag, dropAdjacent, keyOnJust, showTag
) where
#if !MIN_VERSION_base(4, 8, 0)
import Control.Applicative
import Data.Monoid
#endif
import qualified Data.Set as Set
import qualified Data.Text as Text
import Data.Text (Text)
import qualified Data.Text.Read as Text.Read

import qualified FastTags.Tag as Tag
import qualified FastTags.Token as Token
import qualified FastTags.Util as Util


-- | Format new tags, drop old tags from the loaded files, merge old and
-- new, and sort.
merge :: Int -> [FilePath] -> [[Token.Pos Tag.TagVal]] -> [Text] -> [Text]
merge :: Int -> [FilePath] -> [[Pos TagVal]] -> [Text] -> [Text]
merge Int
maxSeparation [FilePath]
fns [[Pos TagVal]]
new [Text]
old = (Text
vimMagicLineText -> [Text] -> [Text]
forall a. a -> [a] -> [a]
:) ([Text] -> [Text]) -> [Text] -> [Text]
forall a b. (a -> b) -> a -> b
$
    ((Parsed, Text) -> Text) -> [(Parsed, Text)] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map (Parsed, Text) -> Text
forall a b. (a, b) -> b
snd ([(Parsed, Text)] -> [Text]) -> [(Parsed, Text)] -> [Text]
forall a b. (a -> b) -> a -> b
$ Int -> [(Parsed, Text)] -> [(Parsed, Text)]
forall a. Int -> [(Parsed, a)] -> [(Parsed, a)]
dropAdjacent Int
maxSeparation ([(Parsed, Text)] -> [(Parsed, Text)])
-> [(Parsed, Text)] -> [(Parsed, Text)]
forall a b. (a -> b) -> a -> b
$ ((Parsed, Text) -> Parsed) -> [(Parsed, Text)] -> [(Parsed, Text)]
forall k a. Ord k => (a -> k) -> [a] -> [a]
Util.sortOn (Parsed, Text) -> Parsed
forall a b. (a, b) -> a
fst ([(Parsed, Text)] -> [(Parsed, Text)])
-> [(Parsed, Text)] -> [(Parsed, Text)]
forall a b. (a -> b) -> a -> b
$ [(Parsed, Text)]
newTags [(Parsed, Text)] -> [(Parsed, Text)] -> [(Parsed, Text)]
forall a. [a] -> [a] -> [a]
++ [(Parsed, Text)]
oldTags
    -- The existing vimMagicLine will fail parseTag and be dropped.
    where
    newTags :: [(Parsed, Text)]
newTags = (Text -> Maybe Parsed) -> [Text] -> [(Parsed, Text)]
forall a k. (a -> Maybe k) -> [a] -> [(k, a)]
keyOnJust Text -> Maybe Parsed
parseTag ([Text] -> [(Parsed, Text)]) -> [Text] -> [(Parsed, Text)]
forall a b. (a -> b) -> a -> b
$ (Pos TagVal -> Text) -> [Pos TagVal] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map Pos TagVal -> Text
showTag ([[Pos TagVal]] -> [Pos TagVal]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[Pos TagVal]]
new)
    oldTags :: [(Parsed, Text)]
oldTags = ((Parsed, Text) -> Bool) -> [(Parsed, Text)] -> [(Parsed, Text)]
forall a. (a -> Bool) -> [a] -> [a]
filter ((Text -> Set Text -> Bool
forall a. Ord a => a -> Set a -> Bool
`Set.notMember` Set Text
fnSet) (Text -> Bool)
-> ((Parsed, Text) -> Text) -> (Parsed, Text) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Parsed -> Text
filename (Parsed -> Text)
-> ((Parsed, Text) -> Parsed) -> (Parsed, Text) -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Parsed, Text) -> Parsed
forall a b. (a, b) -> a
fst) ([(Parsed, Text)] -> [(Parsed, Text)])
-> [(Parsed, Text)] -> [(Parsed, Text)]
forall a b. (a -> b) -> a -> b
$
        (Text -> Maybe Parsed) -> [Text] -> [(Parsed, Text)]
forall a k. (a -> Maybe k) -> [a] -> [(k, a)]
keyOnJust Text -> Maybe Parsed
parseTag [Text]
old
    fnSet :: Set Text
fnSet = [Text] -> Set Text
forall a. Ord a => [a] -> Set a
Set.fromList ([Text] -> Set Text) -> [Text] -> Set Text
forall a b. (a -> b) -> a -> b
$ (FilePath -> Text) -> [FilePath] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map FilePath -> Text
Text.pack [FilePath]
fns

keyOnJust :: (a -> Maybe k) -> [a] -> [(k, a)]
keyOnJust :: (a -> Maybe k) -> [a] -> [(k, a)]
keyOnJust a -> Maybe k
f [a]
xs = [(k
k, a
x) | (Just k
k, a
x) <- (a -> Maybe k) -> [a] -> [(Maybe k, a)]
forall a k. (a -> k) -> [a] -> [(k, a)]
Util.keyOn a -> Maybe k
f [a]
xs]

-- | If there are multiple tags with the same name and filename within a few
-- lines, drop all but the first.
dropAdjacent :: Int -> [(Parsed, a)] -> [(Parsed, a)]
dropAdjacent :: Int -> [(Parsed, a)] -> [(Parsed, a)]
dropAdjacent Int
maxSeparation =
    ([(Parsed, a)] -> [(Parsed, a)])
-> [[(Parsed, a)]] -> [(Parsed, a)]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (((Parsed, a) -> Parsed) -> [(Parsed, a)] -> [(Parsed, a)]
forall k a. Ord k => (a -> k) -> [a] -> [a]
Util.sortOn (Parsed, a) -> Parsed
forall a b. (a, b) -> a
fst ([(Parsed, a)] -> [(Parsed, a)])
-> ([(Parsed, a)] -> [(Parsed, a)])
-> [(Parsed, a)]
-> [(Parsed, a)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(Parsed, a)] -> [(Parsed, a)]
forall b. [(Parsed, b)] -> [(Parsed, b)]
dropInName)([[(Parsed, a)]] -> [(Parsed, a)])
-> ([(Parsed, a)] -> [[(Parsed, a)]])
-> [(Parsed, a)]
-> [(Parsed, a)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Parsed, a) -> Text) -> [(Parsed, a)] -> [[(Parsed, a)]]
forall k a. Eq k => (a -> k) -> [a] -> [[a]]
Util.groupOn (Parsed -> Text
name (Parsed -> Text) -> ((Parsed, a) -> Parsed) -> (Parsed, a) -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Parsed, a) -> Parsed
forall a b. (a, b) -> a
fst)
    where
    -- Group by filename, sort by line number, drop lines too close.
    dropInName :: [(Parsed, b)] -> [(Parsed, b)]
dropInName tag :: [(Parsed, b)]
tag@[(Parsed, b)
_] = [(Parsed, b)]
tag
    dropInName [(Parsed, b)]
tags = ([(Parsed, b)] -> [(Parsed, b)])
-> [[(Parsed, b)]] -> [(Parsed, b)]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap [(Parsed, b)] -> [(Parsed, b)]
forall b. [(Parsed, b)] -> [(Parsed, b)]
dropInFile ([[(Parsed, b)]] -> [(Parsed, b)])
-> ([(Parsed, b)] -> [[(Parsed, b)]])
-> [(Parsed, b)]
-> [(Parsed, b)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Parsed, b) -> Text) -> [(Parsed, b)] -> [[(Parsed, b)]]
forall k a. Eq k => (a -> k) -> [a] -> [[a]]
Util.groupOn (Parsed -> Text
filename (Parsed -> Text) -> ((Parsed, b) -> Parsed) -> (Parsed, b) -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Parsed, b) -> Parsed
forall a b. (a, b) -> a
fst)
        ([(Parsed, b)] -> [[(Parsed, b)]])
-> ([(Parsed, b)] -> [(Parsed, b)])
-> [(Parsed, b)]
-> [[(Parsed, b)]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Parsed, b) -> Text) -> [(Parsed, b)] -> [(Parsed, b)]
forall k a. Ord k => (a -> k) -> [a] -> [a]
Util.sortOn (Parsed -> Text
filename (Parsed -> Text) -> ((Parsed, b) -> Parsed) -> (Parsed, b) -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Parsed, b) -> Parsed
forall a b. (a, b) -> a
fst) ([(Parsed, b)] -> [(Parsed, b)]) -> [(Parsed, b)] -> [(Parsed, b)]
forall a b. (a -> b) -> a -> b
$ [(Parsed, b)]
tags
    dropInFile :: [(Parsed, b)] -> [(Parsed, b)]
dropInFile = ((Parsed, b) -> Int) -> Int -> [(Parsed, b)] -> [(Parsed, b)]
forall a. (a -> Int) -> Int -> [a] -> [a]
dropAdjacentInFile (Parsed -> Int
line (Parsed -> Int) -> ((Parsed, b) -> Parsed) -> (Parsed, b) -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Parsed, b) -> Parsed
forall a b. (a, b) -> a
fst) Int
maxSeparation

-- | Split this out so I can share it with emacs.
dropAdjacentInFile :: (a -> Int) -> Int -> [a] -> [a]
dropAdjacentInFile :: (a -> Int) -> Int -> [a] -> [a]
dropAdjacentInFile a -> Int
lineOf Int
maxSeparation = [a] -> [a]
stripLine ([a] -> [a]) -> ([a] -> [a]) -> [a] -> [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> Int) -> [a] -> [a]
forall k a. Ord k => (a -> k) -> [a] -> [a]
Util.sortOn a -> Int
lineOf
    where
    stripLine :: [a] -> [a]
stripLine [] = []
    stripLine (a
tag : [a]
tags) =
        a
tag a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a] -> [a]
stripLine ((a -> Bool) -> [a] -> [a]
forall a. (a -> Bool) -> [a] -> [a]
dropWhile (a -> a -> Bool
tooClose a
tag) [a]
tags)
    tooClose :: a -> a -> Bool
tooClose a
tag = (Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= a -> Int
lineOf a
tag Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
maxSeparation) (Int -> Bool) -> (a -> Int) -> a -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Int
lineOf


-- | The Ord instance determines the sort order for the tags file.
data Parsed = Parsed {
    Parsed -> Text
name :: !Text
    , Parsed -> Type
type_ :: !Tag.Type
    , Parsed -> Text
filename :: !Text
    , Parsed -> Int
line :: !Int
    } deriving (Parsed -> Parsed -> Bool
(Parsed -> Parsed -> Bool)
-> (Parsed -> Parsed -> Bool) -> Eq Parsed
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Parsed -> Parsed -> Bool
$c/= :: Parsed -> Parsed -> Bool
== :: Parsed -> Parsed -> Bool
$c== :: Parsed -> Parsed -> Bool
Eq, Eq Parsed
Eq Parsed
-> (Parsed -> Parsed -> Ordering)
-> (Parsed -> Parsed -> Bool)
-> (Parsed -> Parsed -> Bool)
-> (Parsed -> Parsed -> Bool)
-> (Parsed -> Parsed -> Bool)
-> (Parsed -> Parsed -> Parsed)
-> (Parsed -> Parsed -> Parsed)
-> Ord Parsed
Parsed -> Parsed -> Bool
Parsed -> Parsed -> Ordering
Parsed -> Parsed -> Parsed
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Parsed -> Parsed -> Parsed
$cmin :: Parsed -> Parsed -> Parsed
max :: Parsed -> Parsed -> Parsed
$cmax :: Parsed -> Parsed -> Parsed
>= :: Parsed -> Parsed -> Bool
$c>= :: Parsed -> Parsed -> Bool
> :: Parsed -> Parsed -> Bool
$c> :: Parsed -> Parsed -> Bool
<= :: Parsed -> Parsed -> Bool
$c<= :: Parsed -> Parsed -> Bool
< :: Parsed -> Parsed -> Bool
$c< :: Parsed -> Parsed -> Bool
compare :: Parsed -> Parsed -> Ordering
$ccompare :: Parsed -> Parsed -> Ordering
$cp1Ord :: Eq Parsed
Ord, Int -> Parsed -> ShowS
[Parsed] -> ShowS
Parsed -> FilePath
(Int -> Parsed -> ShowS)
-> (Parsed -> FilePath) -> ([Parsed] -> ShowS) -> Show Parsed
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [Parsed] -> ShowS
$cshowList :: [Parsed] -> ShowS
show :: Parsed -> FilePath
$cshow :: Parsed -> FilePath
showsPrec :: Int -> Parsed -> ShowS
$cshowsPrec :: Int -> Parsed -> ShowS
Show)

-- text <tab> fname <tab> line;" <tab> type
parseTag :: Text -> Maybe Parsed
parseTag :: Text -> Maybe Parsed
parseTag Text
t = case (Char -> Bool) -> Text -> [Text]
Text.split (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
==Char
'\t') Text
t of
    Text
text : Text
fname : Text
line : Text
type_ : [Text]
_ -> Text -> Type -> Text -> Int -> Parsed
Parsed
        (Text -> Type -> Text -> Int -> Parsed)
-> Maybe Text -> Maybe (Type -> Text -> Int -> Parsed)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> Maybe Text
forall a. a -> Maybe a
Just Text
text
        Maybe (Type -> Text -> Int -> Parsed)
-> Maybe Type -> Maybe (Text -> Int -> Parsed)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Char -> Maybe Type
fromType (Char -> Maybe Type) -> Maybe Char -> Maybe Type
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Text -> Maybe Char
Util.headt Text
type_)
        Maybe (Text -> Int -> Parsed)
-> Maybe Text -> Maybe (Int -> Parsed)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Text -> Maybe Text
forall a. a -> Maybe a
Just Text
fname
        Maybe (Int -> Parsed) -> Maybe Int -> Maybe Parsed
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (FilePath -> Maybe Int)
-> ((Int, Text) -> Maybe Int)
-> Either FilePath (Int, Text)
-> Maybe Int
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Maybe Int -> FilePath -> Maybe Int
forall a b. a -> b -> a
const Maybe Int
forall a. Maybe a
Nothing) (Int -> Maybe Int
forall a. a -> Maybe a
Just (Int -> Maybe Int)
-> ((Int, Text) -> Int) -> (Int, Text) -> Maybe Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int, Text) -> Int
forall a b. (a, b) -> a
fst) (Reader Int
forall a. Integral a => Reader a
Text.Read.decimal Text
line)
    [Text]
_ -> Maybe Parsed
forall a. Maybe a
Nothing

-- | This line is to tell vim that the file is sorted, so it can use binary
-- search when looking for tags. This must come first in the tags file, and the
-- format is documented in :h tags-file-format as:
--
--   !_TAG_FILE_SORTED<Tab>1<Tab>{anything}
--
-- However, simply leaving {anything} part empty or putting something random
-- like ~ doesn't work when we want to extend the tags file with some tags from
-- C files using ctags. ctags requires //, with optional comments in between two
-- slashes. More about ctags' file format can be seen here:
-- http://ctags.sourceforge.net/FORMAT.
vimMagicLine :: Text
vimMagicLine :: Text
vimMagicLine = Text
"!_TAG_FILE_SORTED\t1\t//"

-- | Convert a Tag to text, e.g.: AbsoluteMark\tCmd/TimeStep.hs 67 ;" f
showTag :: Token.Pos Tag.TagVal -> Text
showTag :: Pos TagVal -> Text
showTag (Token.Pos SrcPos
pos (Tag.TagVal Text
text Type
typ Maybe Text
_)) = [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat
    [ Text
text, Text
"\t"
    , FilePath -> Text
Text.pack (SrcPos -> FilePath
Token.posFile SrcPos
pos), Text
"\t"
    , FilePath -> Text
Text.pack (Int -> FilePath
forall a. Show a => a -> FilePath
show (Int -> FilePath) -> Int -> FilePath
forall a b. (a -> b) -> a -> b
$ Line -> Int
Token.unLine (SrcPos -> Line
Token.posLine SrcPos
pos)), Text
";\"\t"
    , Char -> Text
Text.singleton (Type -> Char
toType Type
typ)
    ]

-- | Vim takes this to be the \"kind:\" annotation.  It's just an arbitrary
-- string and these letters conform to no standard.  Presumably there are some
-- vim extensions that can make use of it.
toType :: Tag.Type -> Char
toType :: Type -> Char
toType Type
typ = case Type
typ of
    Type
Tag.Module      -> Char
'm'
    Type
Tag.Function    -> Char
'f'
    Type
Tag.Class       -> Char
'c'
    Type
Tag.Type        -> Char
't'
    Type
Tag.Constructor -> Char
'C'
    Type
Tag.Operator    -> Char
'o'
    Type
Tag.Pattern     -> Char
'p'
    Type
Tag.Family      -> Char
'F'
    Type
Tag.Define      -> Char
'D'

fromType :: Char -> Maybe Tag.Type
fromType :: Char -> Maybe Type
fromType Char
c = case Char
c of
    Char
'm' -> Type -> Maybe Type
forall a. a -> Maybe a
Just Type
Tag.Module
    Char
'f' -> Type -> Maybe Type
forall a. a -> Maybe a
Just Type
Tag.Function
    Char
'c' -> Type -> Maybe Type
forall a. a -> Maybe a
Just Type
Tag.Class
    Char
't' -> Type -> Maybe Type
forall a. a -> Maybe a
Just Type
Tag.Type
    Char
'C' -> Type -> Maybe Type
forall a. a -> Maybe a
Just Type
Tag.Constructor
    Char
'o' -> Type -> Maybe Type
forall a. a -> Maybe a
Just Type
Tag.Operator
    Char
'p' -> Type -> Maybe Type
forall a. a -> Maybe a
Just Type
Tag.Pattern
    Char
'F' -> Type -> Maybe Type
forall a. a -> Maybe a
Just Type
Tag.Family
    Char
'D' -> Type -> Maybe Type
forall a. a -> Maybe a
Just Type
Tag.Define
    Char
_   -> Maybe Type
forall a. Maybe a
Nothing