module Yi.Tag ( lookupTag
, importTagTable
, hintTags
, completeTag
, Tag(..)
, mkTag
, unTag'
, TagTable(..)
, getTags
, setTags
, resetTags
, tagsFileList
) where
import Control.Applicative
import Control.Lens
import Data.Binary
import qualified Data.ByteString as BS
import qualified Data.ByteString.UTF8 as BS8
#if __GLASGOW_HASKELL__ < 708
import Data.DeriveTH
#else
import GHC.Generics (Generic)
#endif
import Data.Default
import qualified Data.Foldable as F
import Data.List (isPrefixOf)
import Data.Map (Map, fromListWith, lookup, keys)
import Data.Maybe (mapMaybe)
import qualified Data.Text as T
import qualified Data.Text.Encoding as E
import qualified Data.Trie as Trie
import Data.Typeable
import System.FilePath (takeFileName, takeDirectory, (</>))
import System.FriendlyPath
import Yi.Editor
import Yi.Config.Simple.Types (Field, customVariable)
import Yi.Types (YiVariable, YiConfigVariable)
newtype TagsFileList = TagsFileList { _unTagsFileList :: [FilePath] }
deriving Typeable
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
instance Default Tags where
def = Tags Nothing
instance YiVariable Tags
newtype Tag = Tag { _unTag :: T.Text } deriving (Show, Eq, Ord)
mkTag :: String -> Tag
mkTag = Tag . T.pack
unTag' :: Tag -> String
unTag' = T.unpack . _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
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 :: String -> Map Tag [(FilePath, Int)]
readCTags =
fromListWith (++) . mapMaybe (parseTagLine . words) . lines
where parseTagLine (tag:tagfile:lineno:_) =
if "!_TAG_" `isPrefixOf` tag then Nothing
else Just (mkTag tag, [(tagfile, fst . head . reads $ lineno)])
parseTagLine _ = Nothing
importTagTable :: FilePath -> IO TagTable
importTagTable filename = do
friendlyName <- expandTilda filename
tagStr <- fmap BS8.toString $ 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
#if __GLASGOW_HASKELL__ < 708
$(derive makeBinary ''Tags)
$(derive makeBinary ''TagTable)
$(derive makeBinary ''TagsFileList)
#else
deriving instance Generic Tags
deriving instance Generic TagTable
deriving instance Generic TagsFileList
instance Binary Tags
instance Binary TagTable
instance Binary TagsFileList
#endif