module Yi.Tag ( lookupTag
, importTagTable
, hintTags
, completeTag
, Tag(..)
, unTag'
, TagTable(..)
, getTags
, setTags
, resetTags
, tagsFileList
) where
import GHC.Generics (Generic)
import Control.Applicative ((<$>))
import Control.Lens (makeLenses)
import Data.Binary (Binary, get, put)
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 Data.Trie as Trie (Trie, certainSuffix, fromList, possibleSuffixes)
import Data.Typeable (Typeable)
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] }
deriving (Typeable, Generic)
instance Default TagsFileList where
def = TagsFileList ["tags"]
instance YiConfigVariable TagsFileList
makeLenses ''TagsFileList
tagsFileList :: Field [FilePath]
tagsFileList = customVariable . unTagsFileList
newtype Tags = Tags (Maybe TagTable) deriving (Typeable, Generic)
instance Default Tags where
def = Tags Nothing
instance YiVariable Tags
newtype Tag = Tag { _unTag :: T.Text } deriving (Show, Eq, Ord)
unTag' :: Tag -> T.Text
unTag' = _unTag
instance Binary Tag where
put (Tag t) = put (E.encodeUtf8 t)
get = Tag . E.decodeUtf8 <$> get
data TagTable = TagTable
{ tagFileName :: FilePath
, tagBaseDir :: FilePath
, tagFileMap :: Map Tag [(FilePath, Int)]
, tagTrie :: Trie.Trie
} deriving (Typeable, 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
, tagTrie = Trie.fromList . map (T.unpack . _unTag) $ keys cts
}
hintTags :: TagTable -> T.Text -> [T.Text]
hintTags tags prefix = map (T.append prefix . T.pack) sufs
where
sufs = Trie.possibleSuffixes (T.unpack prefix) $ tagTrie tags
completeTag :: TagTable -> T.Text -> T.Text
completeTag tags prefix =
prefix `T.append` T.pack (Trie.certainSuffix (T.unpack prefix) (tagTrie tags))
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 Tags
instance Binary TagTable
instance Binary TagsFileList