{-# 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 maxSeparation fns new old = (vimMagicLine:) $
map snd $ dropAdjacent maxSeparation $ Util.sortOn fst $ newTags ++ oldTags
where
newTags = keyOnJust parseTag $ map showTag (concat new)
oldTags = filter ((`Set.notMember` fnSet) . filename . fst) $
keyOnJust parseTag old
fnSet = Set.fromList $ map Text.pack fns
keyOnJust :: (a -> Maybe k) -> [a] -> [(k, a)]
keyOnJust f xs = [(k, x) | (Just k, x) <- Util.keyOn f xs]
dropAdjacent :: Int -> [(Parsed, a)] -> [(Parsed, a)]
dropAdjacent maxSeparation =
concatMap (Util.sortOn fst . dropInName). Util.groupOn (name . fst)
where
dropInName tag@[_] = tag
dropInName tags = concatMap dropInFile . Util.groupOn (filename . fst)
. Util.sortOn (filename . fst) $ tags
dropInFile = dropAdjacentInFile (line . fst) maxSeparation
dropAdjacentInFile :: (a -> Int) -> Int -> [a] -> [a]
dropAdjacentInFile lineOf maxSeparation = stripLine . Util.sortOn lineOf
where
stripLine [] = []
stripLine (tag : tags) =
tag : stripLine (dropWhile (tooClose tag) tags)
tooClose tag = (<= lineOf tag + maxSeparation) . lineOf
data Parsed = Parsed {
name :: !Text
, type_ :: !Tag.Type
, filename :: !Text
, line :: !Int
} deriving (Eq, Ord, Show)
parseTag :: Text -> Maybe Parsed
parseTag t = case Text.split (=='\t') t of
text : fname : line : type_ : _ -> Parsed
<$> Just text
<*> (fromType =<< Util.headt type_)
<*> Just fname
<*> either (const Nothing) (Just . fst) (Text.Read.decimal line)
_ -> Nothing
vimMagicLine :: Text
vimMagicLine = "!_TAG_FILE_SORTED\t1\t//"
showTag :: Token.Pos Tag.TagVal -> Text
showTag (Token.Pos pos (Tag.TagVal text typ _)) = mconcat
[ text, "\t"
, Text.pack (Token.posFile pos), "\t"
, Text.pack (show $ Token.unLine (Token.posLine pos)), ";\"\t"
, Text.singleton (toType typ)
]
toType :: Tag.Type -> Char
toType typ = case typ of
Tag.Module -> 'm'
Tag.Function -> 'f'
Tag.Class -> 'c'
Tag.Type -> 't'
Tag.Constructor -> 'C'
Tag.Operator -> 'o'
Tag.Pattern -> 'p'
Tag.Family -> 'F'
fromType :: Char -> Maybe Tag.Type
fromType c = case c of
'm' -> Just Tag.Module
'f' -> Just Tag.Function
'c' -> Just Tag.Class
't' -> Just Tag.Type
'C' -> Just Tag.Constructor
'o' -> Just Tag.Operator
'p' -> Just Tag.Pattern
'F' -> Just Tag.Family
_ -> Nothing