{-# LANGUAGE CPP #-}
{-# LANGUAGE OverloadedStrings #-}
module FastTags.Vim (
merge, dropAdjacentInFile
, 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
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
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]
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
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
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
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)
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
vimMagicLine :: Text
vimMagicLine :: Text
vimMagicLine = Text
"!_TAG_FILE_SORTED\t1\t//"
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)
]
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