{-# LANGUAGE CPP #-}
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TemplateHaskell #-}
{-# OPTIONS_HADDOCK show-extensions #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
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, unpack, words)
import qualified Data.Text.Encoding as E (decodeUtf8)
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 { TagsFileList -> [FilePath]
_unTagsFileList :: [FilePath] }
instance Default TagsFileList where
def :: TagsFileList
def = [FilePath] -> TagsFileList
TagsFileList [FilePath
"tags"]
instance YiConfigVariable TagsFileList
makeLenses ''TagsFileList
tagsFileList :: Field [FilePath]
tagsFileList :: ([FilePath] -> f [FilePath]) -> Config -> f Config
tagsFileList = (TagsFileList -> f TagsFileList) -> Config -> f Config
forall a. YiConfigVariable a => Field a
customVariable ((TagsFileList -> f TagsFileList) -> Config -> f Config)
-> (([FilePath] -> f [FilePath]) -> TagsFileList -> f TagsFileList)
-> ([FilePath] -> f [FilePath])
-> Config
-> f Config
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([FilePath] -> f [FilePath]) -> TagsFileList -> f TagsFileList
Lens' TagsFileList [FilePath]
unTagsFileList
newtype Tags = Tags (Maybe TagTable) deriving (Get Tags
[Tags] -> Put
Tags -> Put
(Tags -> Put) -> Get Tags -> ([Tags] -> Put) -> Binary Tags
forall t. (t -> Put) -> Get t -> ([t] -> Put) -> Binary t
putList :: [Tags] -> Put
$cputList :: [Tags] -> Put
get :: Get Tags
$cget :: Get Tags
put :: Tags -> Put
$cput :: Tags -> Put
Binary)
instance Default Tags where
def :: Tags
def = Maybe TagTable -> Tags
Tags Maybe TagTable
forall a. Maybe a
Nothing
instance YiVariable Tags
newtype Tag = Tag { Tag -> Text
_unTag :: T.Text } deriving (Int -> Tag -> ShowS
[Tag] -> ShowS
Tag -> FilePath
(Int -> Tag -> ShowS)
-> (Tag -> FilePath) -> ([Tag] -> ShowS) -> Show Tag
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [Tag] -> ShowS
$cshowList :: [Tag] -> ShowS
show :: Tag -> FilePath
$cshow :: Tag -> FilePath
showsPrec :: Int -> Tag -> ShowS
$cshowsPrec :: Int -> Tag -> ShowS
Show, Tag -> Tag -> Bool
(Tag -> Tag -> Bool) -> (Tag -> Tag -> Bool) -> Eq Tag
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Tag -> Tag -> Bool
$c/= :: Tag -> Tag -> Bool
== :: Tag -> Tag -> Bool
$c== :: Tag -> Tag -> Bool
Eq, Eq Tag
Eq Tag
-> (Tag -> Tag -> Ordering)
-> (Tag -> Tag -> Bool)
-> (Tag -> Tag -> Bool)
-> (Tag -> Tag -> Bool)
-> (Tag -> Tag -> Bool)
-> (Tag -> Tag -> Tag)
-> (Tag -> Tag -> Tag)
-> Ord Tag
Tag -> Tag -> Bool
Tag -> Tag -> Ordering
Tag -> Tag -> Tag
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 :: Tag -> Tag -> Tag
$cmin :: Tag -> Tag -> Tag
max :: Tag -> Tag -> Tag
$cmax :: Tag -> Tag -> Tag
>= :: Tag -> Tag -> Bool
$c>= :: Tag -> Tag -> Bool
> :: Tag -> Tag -> Bool
$c> :: Tag -> Tag -> Bool
<= :: Tag -> Tag -> Bool
$c<= :: Tag -> Tag -> Bool
< :: Tag -> Tag -> Bool
$c< :: Tag -> Tag -> Bool
compare :: Tag -> Tag -> Ordering
$ccompare :: Tag -> Tag -> Ordering
$cp1Ord :: Eq Tag
Ord, Get Tag
[Tag] -> Put
Tag -> Put
(Tag -> Put) -> Get Tag -> ([Tag] -> Put) -> Binary Tag
forall t. (t -> Put) -> Get t -> ([t] -> Put) -> Binary t
putList :: [Tag] -> Put
$cputList :: [Tag] -> Put
get :: Get Tag
$cget :: Get Tag
put :: Tag -> Put
$cput :: Tag -> Put
Binary)
unTag' :: Tag -> T.Text
unTag' :: Tag -> Text
unTag' = Tag -> Text
_unTag
data TagTable = TagTable
{ TagTable -> FilePath
tagFileName :: FilePath
, TagTable -> FilePath
tagBaseDir :: FilePath
, TagTable -> Map Tag [(FilePath, Int)]
tagFileMap :: Map Tag [(FilePath, Int)]
, TagTable -> CompletionTree Text
tagCompletionTree :: CT.CompletionTree T.Text
} deriving ((forall x. TagTable -> Rep TagTable x)
-> (forall x. Rep TagTable x -> TagTable) -> Generic TagTable
forall x. Rep TagTable x -> TagTable
forall x. TagTable -> Rep TagTable x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep TagTable x -> TagTable
$cfrom :: forall x. TagTable -> Rep TagTable x
Generic)
lookupTag :: Tag -> TagTable -> [(FilePath, Int)]
lookupTag :: Tag -> TagTable -> [(FilePath, Int)]
lookupTag Tag
tag TagTable
tagTable = do
(FilePath
file, Int
line) <- Maybe [(FilePath, Int)] -> [(FilePath, Int)]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
F.concat (Maybe [(FilePath, Int)] -> [(FilePath, Int)])
-> (Map Tag [(FilePath, Int)] -> Maybe [(FilePath, Int)])
-> Map Tag [(FilePath, Int)]
-> [(FilePath, Int)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Tag -> Map Tag [(FilePath, Int)] -> Maybe [(FilePath, Int)]
forall k a. Ord k => k -> Map k a -> Maybe a
Data.Map.lookup Tag
tag (Map Tag [(FilePath, Int)] -> [(FilePath, Int)])
-> Map Tag [(FilePath, Int)] -> [(FilePath, Int)]
forall a b. (a -> b) -> a -> b
$ TagTable -> Map Tag [(FilePath, Int)]
tagFileMap TagTable
tagTable
(FilePath, Int) -> [(FilePath, Int)]
forall (m :: * -> *) a. Monad m => a -> m a
return (TagTable -> FilePath
tagBaseDir TagTable
tagTable FilePath -> ShowS
</> FilePath
file, Int
line)
readCTags :: T.Text -> Map Tag [(FilePath, Int)]
readCTags :: Text -> Map Tag [(FilePath, Int)]
readCTags =
([(FilePath, Int)] -> [(FilePath, Int)] -> [(FilePath, Int)])
-> [(Tag, [(FilePath, Int)])] -> Map Tag [(FilePath, Int)]
forall k a. Ord k => (a -> a -> a) -> [(k, a)] -> Map k a
fromListWith [(FilePath, Int)] -> [(FilePath, Int)] -> [(FilePath, Int)]
forall a. [a] -> [a] -> [a]
(++) ([(Tag, [(FilePath, Int)])] -> Map Tag [(FilePath, Int)])
-> (Text -> [(Tag, [(FilePath, Int)])])
-> Text
-> Map Tag [(FilePath, Int)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> Maybe (Tag, [(FilePath, Int)]))
-> [Text] -> [(Tag, [(FilePath, Int)])]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe ([Text] -> Maybe (Tag, [(FilePath, Int)])
forall b. Integral b => [Text] -> Maybe (Tag, [(FilePath, b)])
parseTagLine ([Text] -> Maybe (Tag, [(FilePath, Int)]))
-> (Text -> [Text]) -> Text -> Maybe (Tag, [(FilePath, Int)])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Text]
T.words) ([Text] -> [(Tag, [(FilePath, Int)])])
-> (Text -> [Text]) -> Text -> [(Tag, [(FilePath, Int)])]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Text]
T.lines
where parseTagLine :: [Text] -> Maybe (Tag, [(FilePath, b)])
parseTagLine (Text
tag:Text
tagfile:Text
lineno:[Text]
_) =
if Text
"!_TAG_" Text -> Text -> Bool
`T.isPrefixOf` Text
tag then Maybe (Tag, [(FilePath, b)])
forall a. Maybe a
Nothing
else (Tag, [(FilePath, b)]) -> Maybe (Tag, [(FilePath, b)])
forall a. a -> Maybe a
Just (Text -> Tag
Tag Text
tag, [(Text -> FilePath
T.unpack Text
tagfile, Text -> b
getLineNumber Text
lineno)])
where getLineNumber :: Text -> b
getLineNumber = (\(Right b
x) -> b
x) (Either FilePath b -> b)
-> (Text -> Either FilePath b) -> Text -> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((b, Text) -> b) -> Either FilePath (b, Text) -> Either FilePath b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (b, Text) -> b
forall a b. (a, b) -> a
fst (Either FilePath (b, Text) -> Either FilePath b)
-> (Text -> Either FilePath (b, Text)) -> Text -> Either FilePath b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Either FilePath (b, Text)
forall a. Integral a => Reader a
R.decimal
parseTagLine [Text]
_ = Maybe (Tag, [(FilePath, b)])
forall a. Maybe a
Nothing
importTagTable :: FilePath -> IO TagTable
importTagTable :: FilePath -> IO TagTable
importTagTable FilePath
filename = do
FilePath
friendlyName <- FilePath -> IO FilePath
expandTilda FilePath
filename
Text
tagStr <- ByteString -> Text
E.decodeUtf8 (ByteString -> Text) -> IO ByteString -> IO Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FilePath -> IO ByteString
BS.readFile FilePath
friendlyName
let cts :: Map Tag [(FilePath, Int)]
cts = Text -> Map Tag [(FilePath, Int)]
readCTags Text
tagStr
TagTable -> IO TagTable
forall (m :: * -> *) a. Monad m => a -> m a
return TagTable :: FilePath
-> FilePath
-> Map Tag [(FilePath, Int)]
-> CompletionTree Text
-> TagTable
TagTable { tagFileName :: FilePath
tagFileName = ShowS
takeFileName FilePath
filename
, tagBaseDir :: FilePath
tagBaseDir = ShowS
takeDirectory FilePath
filename
, tagFileMap :: Map Tag [(FilePath, Int)]
tagFileMap = Map Tag [(FilePath, Int)]
cts
, tagCompletionTree :: CompletionTree Text
tagCompletionTree = [Text] -> CompletionTree Text
forall a i. (Ord a, ListLike a i, Eq i) => [a] -> CompletionTree a
CT.fromList ([Text] -> CompletionTree Text)
-> ([Tag] -> [Text]) -> [Tag] -> CompletionTree Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Tag -> Text) -> [Tag] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map (Tag -> Text
_unTag) ([Tag] -> CompletionTree Text) -> [Tag] -> CompletionTree Text
forall a b. (a -> b) -> a -> b
$ Map Tag [(FilePath, Int)] -> [Tag]
forall k a. Map k a -> [k]
keys Map Tag [(FilePath, Int)]
cts
}
hintTags :: TagTable -> T.Text -> [T.Text]
hintTags :: TagTable -> Text -> [Text]
hintTags TagTable
tags Text
prefix = (Text -> Text) -> [Text] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map (Text
prefix Text -> Text -> Text
`T.append`) [Text]
sufs
where
sufs :: [T.Text]
sufs :: [Text]
sufs = CompletionTree Text -> [Text]
forall a i. (Ord a, ListLike a i) => CompletionTree a -> [a]
CT.toList (CompletionTree Text -> Text -> CompletionTree Text
forall a i.
(Ord a, ListLike a i, Eq i) =>
CompletionTree a -> a -> CompletionTree a
CT.update (TagTable -> CompletionTree Text
tagCompletionTree TagTable
tags) Text
prefix)
completeTag :: TagTable -> T.Text -> T.Text
completeTag :: TagTable -> Text -> Text
completeTag TagTable
tags Text
prefix =
Text
prefix Text -> Text -> Text
`T.append` (Text, CompletionTree Text) -> Text
forall a b. (a, b) -> a
fst (CompletionTree Text -> (Text, CompletionTree Text)
forall i a.
(Eq i, Ord a, ListLike a i) =>
CompletionTree a -> (a, CompletionTree a)
CT.complete (CompletionTree Text -> Text -> CompletionTree Text
forall a i.
(Ord a, ListLike a i, Eq i) =>
CompletionTree a -> a -> CompletionTree a
CT.update (TagTable -> CompletionTree Text
tagCompletionTree TagTable
tags) Text
prefix))
setTags :: TagTable -> EditorM ()
setTags :: TagTable -> EditorM ()
setTags = Tags -> EditorM ()
forall (m :: * -> *) a.
(MonadEditor m, YiVariable a, Functor m) =>
a -> m ()
putEditorDyn (Tags -> EditorM ())
-> (TagTable -> Tags) -> TagTable -> EditorM ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe TagTable -> Tags
Tags (Maybe TagTable -> Tags)
-> (TagTable -> Maybe TagTable) -> TagTable -> Tags
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TagTable -> Maybe TagTable
forall a. a -> Maybe a
Just
resetTags :: EditorM ()
resetTags :: EditorM ()
resetTags = Tags -> EditorM ()
forall (m :: * -> *) a.
(MonadEditor m, YiVariable a, Functor m) =>
a -> m ()
putEditorDyn (Tags -> EditorM ()) -> Tags -> EditorM ()
forall a b. (a -> b) -> a -> b
$ Maybe TagTable -> Tags
Tags Maybe TagTable
forall a. Maybe a
Nothing
getTags :: EditorM (Maybe TagTable)
getTags :: EditorM (Maybe TagTable)
getTags = do
Tags Maybe TagTable
t <- EditorM Tags
forall (m :: * -> *) a.
(MonadEditor m, YiVariable a, Default a, Functor m) =>
m a
getEditorDyn
Maybe TagTable -> EditorM (Maybe TagTable)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe TagTable
t
instance Binary TagTable