module Yi.Tag ( lookupTag
, importTagTable
, hintTags
, completeTag
, Tag(..)
, unTag'
, TagTable(..)
, getTags
, setTags
, resetTags
, tagsFileList
, readCTags
) where
import GHC.Generics (Generic)
import Lens.Micro.Platform (makeLenses)
import Data.Binary (Binary)
import qualified Data.ByteString as BS (readFile)
import Data.Default (Default, def)
import qualified Data.Foldable as F (concat)
import Data.Map (Map, fromListWith, keys, lookup)
import Data.Maybe (mapMaybe)
import qualified Data.Text as T (Text, append, isPrefixOf, lines, pack, unpack, words)
import qualified Data.Text.Encoding as E (decodeUtf8, encodeUtf8)
import qualified Data.Text.Read as R (decimal)
import qualified Yi.CompletionTree as CT
import System.FilePath (takeDirectory, takeFileName, (</>))
import System.FriendlyPath (expandTilda)
import Yi.Config.Simple.Types (Field, customVariable)
import Yi.Editor (EditorM, getEditorDyn, putEditorDyn)
import Yi.Types (YiConfigVariable, YiVariable)
newtype TagsFileList = TagsFileList { _unTagsFileList :: [FilePath] }
instance Default TagsFileList where
def = TagsFileList ["tags"]
instance YiConfigVariable TagsFileList
makeLenses ''TagsFileList
tagsFileList :: Field [FilePath]
tagsFileList = customVariable . unTagsFileList
newtype Tags = Tags (Maybe TagTable) deriving (Binary)
instance Default Tags where
def = Tags Nothing
instance YiVariable Tags
newtype Tag = Tag { _unTag :: T.Text } deriving (Show, Eq, Ord, Binary)
unTag' :: Tag -> T.Text
unTag' = _unTag
data TagTable = TagTable
{ tagFileName :: FilePath
, tagBaseDir :: FilePath
, tagFileMap :: Map Tag [(FilePath, Int)]
, tagCompletionTree :: CT.CompletionTree T.Text
} deriving (Generic)
lookupTag :: Tag -> TagTable -> [(FilePath, Int)]
lookupTag tag tagTable = do
(file, line) <- F.concat . Data.Map.lookup tag $ tagFileMap tagTable
return (tagBaseDir tagTable </> file, line)
readCTags :: T.Text -> Map Tag [(FilePath, Int)]
readCTags =
fromListWith (++) . mapMaybe (parseTagLine . T.words) . T.lines
where parseTagLine (tag:tagfile:lineno:_) =
if "!_TAG_" `T.isPrefixOf` tag then Nothing
else Just (Tag tag, [(T.unpack tagfile, getLineNumber lineno)])
where getLineNumber = (\(Right x) -> x) . fmap fst . R.decimal
parseTagLine _ = Nothing
importTagTable :: FilePath -> IO TagTable
importTagTable filename = do
friendlyName <- expandTilda filename
tagStr <- E.decodeUtf8 <$> BS.readFile friendlyName
let cts = readCTags tagStr
return TagTable { tagFileName = takeFileName filename
, tagBaseDir = takeDirectory filename
, tagFileMap = cts
, tagCompletionTree = CT.fromList . map (_unTag) $ keys cts
}
hintTags :: TagTable -> T.Text -> [T.Text]
hintTags tags prefix = map (prefix `T.append`) sufs
where
sufs :: [T.Text]
sufs = CT.toList (CT.update (tagCompletionTree tags) prefix)
completeTag :: TagTable -> T.Text -> T.Text
completeTag tags prefix =
prefix `T.append` fst (CT.complete (CT.update (tagCompletionTree tags) prefix))
setTags :: TagTable -> EditorM ()
setTags = putEditorDyn . Tags . Just
resetTags :: EditorM ()
resetTags = putEditorDyn $ Tags Nothing
getTags :: EditorM (Maybe TagTable)
getTags = do
Tags t <- getEditorDyn
return t
instance Binary TagTable