{-# LANGUAGE CPP                #-}
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE DeriveGeneric      #-}
{-# LANGUAGE FlexibleContexts   #-}
{-# LANGUAGE LambdaCase         #-}
{-# LANGUAGE OverloadedStrings  #-}
{-# LANGUAGE TemplateHaskell    #-}
{-# OPTIONS_HADDOCK show-extensions #-}

-- |
-- Module      :  Yi.Keymap.Vim.Tag
-- License     :  GPL-2
-- Maintainer  :  yi-devel@googlegroups.com
-- Stability   :  experimental
-- Portability :  portable

module Yi.Keymap.Vim.Tag
    ( completeVimTag
    , gotoTag
    , nextTag
    , popTag
    , unpopTag
    ) where

import           GHC.Generics (Generic)

import           Lens.Micro.Platform        (view)
import           Control.Monad       (foldM, void)
import           Data.Binary         (Binary (..))
import           Data.Default        (Default (..))
import           Data.Maybe          (maybeToList)
import           Data.Monoid         ((<>))
import qualified Data.Text           as T (Text)
import           Data.Typeable       (Typeable)
import           System.Directory    (doesFileExist)
import           System.FilePath     (takeDirectory, (</>))
import           System.FriendlyPath (userToCanonPath)
import           Yi.Buffer
import           Yi.Core             (errorEditor)
import           Yi.Editor
import           Yi.File             (openingNewFile)
import           Yi.Keymap           (YiM)
import           Yi.Tag
import           Yi.Types            (YiVariable)
import           Yi.Utils            (io)

-- | List of tags and the file/line/char that they originate from.
-- (the location that :tag or Ctrl-[ was called from).
data VimTagStack = VimTagStack
    { VimTagStack -> [(Tag, Int, FilePath, Int, Int)]
tagStackList :: [(Tag, Int, FilePath, Int, Int)]
    , VimTagStack -> Int
tagStackIndex :: Int
    } deriving (Typeable, (forall x. VimTagStack -> Rep VimTagStack x)
-> (forall x. Rep VimTagStack x -> VimTagStack)
-> Generic VimTagStack
forall x. Rep VimTagStack x -> VimTagStack
forall x. VimTagStack -> Rep VimTagStack x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep VimTagStack x -> VimTagStack
$cfrom :: forall x. VimTagStack -> Rep VimTagStack x
Generic)

instance Default VimTagStack where
    def :: VimTagStack
def = [(Tag, Int, FilePath, Int, Int)] -> Int -> VimTagStack
VimTagStack [] Int
0

instance YiVariable VimTagStack

instance Binary VimTagStack

-- | Returns tag, tag index, filepath, line number, char number
getTagList :: EditorM [(Tag, Int, FilePath, Int, Int)]
getTagList :: EditorM [(Tag, Int, FilePath, Int, Int)]
getTagList = do
    VimTagStack [(Tag, Int, FilePath, Int, Int)]
ts Int
_ <- EditorM VimTagStack
forall (m :: * -> *) a.
(MonadEditor m, YiVariable a, Default a, Functor m) =>
m a
getEditorDyn
    [(Tag, Int, FilePath, Int, Int)]
-> EditorM [(Tag, Int, FilePath, Int, Int)]
forall (m :: * -> *) a. Monad m => a -> m a
return [(Tag, Int, FilePath, Int, Int)]
ts

getTagIndex :: EditorM Int
getTagIndex :: EditorM Int
getTagIndex = do
    VimTagStack [(Tag, Int, FilePath, Int, Int)]
_ Int
ti <- EditorM VimTagStack
forall (m :: * -> *) a.
(MonadEditor m, YiVariable a, Default a, Functor m) =>
m a
getEditorDyn
    Int -> EditorM Int
forall (m :: * -> *) a. Monad m => a -> m a
return Int
ti

setTagList :: [(Tag, Int, FilePath, Int, Int)] -> EditorM ()
setTagList :: [(Tag, Int, FilePath, Int, Int)] -> EditorM ()
setTagList [(Tag, Int, FilePath, Int, Int)]
tl =  do
    t :: VimTagStack
t@(VimTagStack [(Tag, Int, FilePath, Int, Int)]
_ Int
_) <- EditorM VimTagStack
forall (m :: * -> *) a.
(MonadEditor m, YiVariable a, Default a, Functor m) =>
m a
getEditorDyn
    VimTagStack -> EditorM ()
forall (m :: * -> *) a.
(MonadEditor m, YiVariable a, Functor m) =>
a -> m ()
putEditorDyn (VimTagStack -> EditorM ()) -> VimTagStack -> EditorM ()
forall a b. (a -> b) -> a -> b
$ VimTagStack
t { tagStackList :: [(Tag, Int, FilePath, Int, Int)]
tagStackList = [(Tag, Int, FilePath, Int, Int)]
tl }

setTagIndex :: Int -> EditorM ()
setTagIndex :: Int -> EditorM ()
setTagIndex Int
ti = do
    t :: VimTagStack
t@(VimTagStack [(Tag, Int, FilePath, Int, Int)]
_ Int
_) <- EditorM VimTagStack
forall (m :: * -> *) a.
(MonadEditor m, YiVariable a, Default a, Functor m) =>
m a
getEditorDyn
    VimTagStack -> EditorM ()
forall (m :: * -> *) a.
(MonadEditor m, YiVariable a, Functor m) =>
a -> m ()
putEditorDyn (VimTagStack -> EditorM ()) -> VimTagStack -> EditorM ()
forall a b. (a -> b) -> a -> b
$ VimTagStack
t { tagStackIndex :: Int
tagStackIndex = Int
ti }

-- | Push tag at index.
pushTagStack :: Tag -> Int -> FilePath -> Int -> Int -> EditorM ()
pushTagStack :: Tag -> Int -> FilePath -> Int -> Int -> EditorM ()
pushTagStack Tag
tag Int
ind FilePath
fp Int
ln Int
cn = do
    [(Tag, Int, FilePath, Int, Int)]
tl <- EditorM [(Tag, Int, FilePath, Int, Int)]
getTagList
    Int
ti <- EditorM Int
getTagIndex
    [(Tag, Int, FilePath, Int, Int)] -> EditorM ()
setTagList ([(Tag, Int, FilePath, Int, Int)] -> EditorM ())
-> [(Tag, Int, FilePath, Int, Int)] -> EditorM ()
forall a b. (a -> b) -> a -> b
$ (Int
-> [(Tag, Int, FilePath, Int, Int)]
-> [(Tag, Int, FilePath, Int, Int)]
forall a. Int -> [a] -> [a]
take Int
ti [(Tag, Int, FilePath, Int, Int)]
tl) [(Tag, Int, FilePath, Int, Int)]
-> [(Tag, Int, FilePath, Int, Int)]
-> [(Tag, Int, FilePath, Int, Int)]
forall a. [a] -> [a] -> [a]
++ [(Tag
tag, Int
ind, FilePath
fp, Int
ln, Int
cn)]
    Int -> EditorM ()
setTagIndex (Int -> EditorM ()) -> Int -> EditorM ()
forall a b. (a -> b) -> a -> b
$ Int
ti Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1

-- | Get tag and decrement index (so that when a new push is done, the current
-- tag is popped)
popTagStack :: EditorM (Maybe (Tag, Int, FilePath, Int, Int))
popTagStack :: EditorM (Maybe (Tag, Int, FilePath, Int, Int))
popTagStack = do
    [(Tag, Int, FilePath, Int, Int)]
tl <- EditorM [(Tag, Int, FilePath, Int, Int)]
getTagList
    Int
ti <- EditorM Int
getTagIndex
    case [(Tag, Int, FilePath, Int, Int)]
tl of
        [] -> Maybe (Tag, Int, FilePath, Int, Int)
-> EditorM (Maybe (Tag, Int, FilePath, Int, Int))
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (Tag, Int, FilePath, Int, Int)
forall a. Maybe a
Nothing
        [(Tag, Int, FilePath, Int, Int)]
_  -> case Int
ti of
                Int
0 -> Maybe (Tag, Int, FilePath, Int, Int)
-> EditorM (Maybe (Tag, Int, FilePath, Int, Int))
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (Tag, Int, FilePath, Int, Int)
forall a. Maybe a
Nothing
                Int
_ -> Int -> EditorM ()
setTagIndex (Int
ti Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) EditorM ()
-> EditorM (Maybe (Tag, Int, FilePath, Int, Int))
-> EditorM (Maybe (Tag, Int, FilePath, Int, Int))
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Maybe (Tag, Int, FilePath, Int, Int)
-> EditorM (Maybe (Tag, Int, FilePath, Int, Int))
forall (m :: * -> *) a. Monad m => a -> m a
return ((Tag, Int, FilePath, Int, Int)
-> Maybe (Tag, Int, FilePath, Int, Int)
forall a. a -> Maybe a
Just ((Tag, Int, FilePath, Int, Int)
 -> Maybe (Tag, Int, FilePath, Int, Int))
-> (Tag, Int, FilePath, Int, Int)
-> Maybe (Tag, Int, FilePath, Int, Int)
forall a b. (a -> b) -> a -> b
$ [(Tag, Int, FilePath, Int, Int)]
tl [(Tag, Int, FilePath, Int, Int)]
-> Int -> (Tag, Int, FilePath, Int, Int)
forall a. [a] -> Int -> a
!! (Int
ti Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1))

-- | Opens the file that contains @tag@. Uses the global tag table or uses
-- the first valid tag file in @TagsFileList@.
gotoTag :: Tag -> Int -> Maybe (FilePath, Int, Int) -> YiM ()
gotoTag :: Tag -> Int -> Maybe (FilePath, Int, Int) -> YiM ()
gotoTag Tag
tag Int
ind Maybe (FilePath, Int, Int)
ret =
    YiM (Maybe ()) -> YiM ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (YiM (Maybe ()) -> YiM ())
-> ((TagTable -> YiM ()) -> YiM (Maybe ()))
-> (TagTable -> YiM ())
-> YiM ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (TagTable -> YiM ()) -> YiM (Maybe ())
forall a. (TagTable -> YiM a) -> YiM (Maybe a)
visitTagTable ((TagTable -> YiM ()) -> YiM ()) -> (TagTable -> YiM ()) -> YiM ()
forall a b. (a -> b) -> a -> b
$ \TagTable
tagTable -> do
        let lis :: [(FilePath, Int)]
lis = Tag -> TagTable -> [(FilePath, Int)]
lookupTag Tag
tag TagTable
tagTable
        if ([(FilePath, Int)] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [(FilePath, Int)]
lis) Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
ind
          then Text -> YiM ()
errorEditor (Text -> YiM ()) -> Text -> YiM ()
forall a b. (a -> b) -> a -> b
$ Text
"tag not found: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Tag -> Text
_unTag Tag
tag
          else do
            BufferFileInfo
bufinf <- BufferM BufferFileInfo -> YiM BufferFileInfo
forall (m :: * -> *) a. MonadEditor m => BufferM a -> m a
withCurrentBuffer BufferM BufferFileInfo
bufInfoB

            let (FilePath
filename, Int
line) = [(FilePath, Int)]
lis [(FilePath, Int)] -> Int -> (FilePath, Int)
forall a. [a] -> Int -> a
!! Int
ind
                (FilePath
fn, Int
ln, Int
cn) = case Maybe (FilePath, Int, Int)
ret of
                   Just (FilePath, Int, Int)
ret' -> (FilePath, Int, Int)
ret'
                   Maybe (FilePath, Int, Int)
Nothing -> (BufferFileInfo -> FilePath
bufInfoFileName BufferFileInfo
bufinf, 
                               BufferFileInfo -> Int
bufInfoLineNo BufferFileInfo
bufinf, 
                               BufferFileInfo -> Int
bufInfoColNo BufferFileInfo
bufinf)
            EditorM () -> YiM ()
forall (m :: * -> *) a. MonadEditor m => EditorM a -> m a
withEditor (EditorM () -> YiM ()) -> EditorM () -> YiM ()
forall a b. (a -> b) -> a -> b
$ Tag -> Int -> FilePath -> Int -> Int -> EditorM ()
pushTagStack Tag
tag Int
ind FilePath
fn Int
ln Int
cn
            FilePath -> BufferM Int -> YiM ()
forall a. FilePath -> BufferM a -> YiM ()
openingNewFile FilePath
filename (BufferM Int -> YiM ()) -> BufferM Int -> YiM ()
forall a b. (a -> b) -> a -> b
$ Int -> BufferM Int
gotoLn Int
line

-- | Goes to the next tag. (:tnext)
nextTag :: YiM ()
nextTag :: YiM ()
nextTag = do
    Maybe (Tag, Int, FilePath, Int, Int)
prev <- EditorM (Maybe (Tag, Int, FilePath, Int, Int))
-> YiM (Maybe (Tag, Int, FilePath, Int, Int))
forall (m :: * -> *) a. MonadEditor m => EditorM a -> m a
withEditor EditorM (Maybe (Tag, Int, FilePath, Int, Int))
popTagStack 
    case Maybe (Tag, Int, FilePath, Int, Int)
prev of
        Maybe (Tag, Int, FilePath, Int, Int)
Nothing -> Text -> YiM ()
errorEditor (Text -> YiM ()) -> Text -> YiM ()
forall a b. (a -> b) -> a -> b
$ Text
"tag stack empty"
        Just (Tag
tag, Int
ind, FilePath
fn, Int
ln, Int
cn) -> Tag -> Int -> Maybe (FilePath, Int, Int) -> YiM ()
gotoTag Tag
tag (Int
ind Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) ((FilePath, Int, Int) -> Maybe (FilePath, Int, Int)
forall a. a -> Maybe a
Just (FilePath
fn, Int
ln, Int
cn))

-- | Return to location from before last tag jump.
popTag :: YiM ()
popTag :: YiM ()
popTag = do
    [(Tag, Int, FilePath, Int, Int)]
tl <- EditorM [(Tag, Int, FilePath, Int, Int)]
-> YiM [(Tag, Int, FilePath, Int, Int)]
forall (m :: * -> *) a. MonadEditor m => EditorM a -> m a
withEditor EditorM [(Tag, Int, FilePath, Int, Int)]
getTagList
    case [(Tag, Int, FilePath, Int, Int)]
tl of
        [] -> Text -> YiM ()
errorEditor Text
"tag stack empty"
        [(Tag, Int, FilePath, Int, Int)]
_ -> do
            Maybe (Tag, Int, FilePath, Int, Int)
posloc <- EditorM (Maybe (Tag, Int, FilePath, Int, Int))
-> YiM (Maybe (Tag, Int, FilePath, Int, Int))
forall (m :: * -> *) a. MonadEditor m => EditorM a -> m a
withEditor EditorM (Maybe (Tag, Int, FilePath, Int, Int))
popTagStack
            case Maybe (Tag, Int, FilePath, Int, Int)
posloc of
                Maybe (Tag, Int, FilePath, Int, Int)
Nothing -> Text -> YiM ()
errorEditor Text
"at bottom of tag stack"
                Just (Tag
_, Int
_, FilePath
fn, Int
ln, Int
cn) -> FilePath -> BufferM () -> YiM ()
forall a. FilePath -> BufferM a -> YiM ()
openingNewFile FilePath
fn (BufferM () -> YiM ()) -> BufferM () -> YiM ()
forall a b. (a -> b) -> a -> b
$ Int -> Int -> BufferM ()
moveToLineColB Int
ln Int
cn

-- | Go to next tag in the tag stack. Represents :tag without any
-- specified tag.
unpopTag :: YiM ()
unpopTag :: YiM ()
unpopTag = do
  [(Tag, Int, FilePath, Int, Int)]
tl <- EditorM [(Tag, Int, FilePath, Int, Int)]
-> YiM [(Tag, Int, FilePath, Int, Int)]
forall (m :: * -> *) a. MonadEditor m => EditorM a -> m a
withEditor EditorM [(Tag, Int, FilePath, Int, Int)]
getTagList
  Int
ti <- EditorM Int -> YiM Int
forall (m :: * -> *) a. MonadEditor m => EditorM a -> m a
withEditor EditorM Int
getTagIndex
  if Int
ti Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= [(Tag, Int, FilePath, Int, Int)] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [(Tag, Int, FilePath, Int, Int)]
tl
    then case [(Tag, Int, FilePath, Int, Int)]
tl of
            [] -> Text -> YiM ()
errorEditor Text
"tag stack empty"
            [(Tag, Int, FilePath, Int, Int)]
_ -> Text -> YiM ()
errorEditor Text
"at top of tag stack"
    else let (Tag
tag, Int
ind, FilePath
_, Int
_, Int
_) = [(Tag, Int, FilePath, Int, Int)]
tl [(Tag, Int, FilePath, Int, Int)]
-> Int -> (Tag, Int, FilePath, Int, Int)
forall a. [a] -> Int -> a
!! Int
ti
         in YiM (Maybe ()) -> YiM ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (YiM (Maybe ()) -> YiM ())
-> ((TagTable -> YiM ()) -> YiM (Maybe ()))
-> (TagTable -> YiM ())
-> YiM ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (TagTable -> YiM ()) -> YiM (Maybe ())
forall a. (TagTable -> YiM a) -> YiM (Maybe a)
visitTagTable ((TagTable -> YiM ()) -> YiM ()) -> (TagTable -> YiM ()) -> YiM ()
forall a b. (a -> b) -> a -> b
$ \TagTable
tagTable -> do
             let lis :: [(FilePath, Int)]
lis =  Tag -> TagTable -> [(FilePath, Int)]
lookupTag Tag
tag TagTable
tagTable
             if ([(FilePath, Int)] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [(FilePath, Int)]
lis) Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
ind
               then Text -> YiM ()
errorEditor (Text -> YiM ()) -> Text -> YiM ()
forall a b. (a -> b) -> a -> b
$ Text
"tag not found: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Tag -> Text
_unTag Tag
tag
               else do
                   BufferFileInfo
bufinf <- BufferM BufferFileInfo -> YiM BufferFileInfo
forall (m :: * -> *) a. MonadEditor m => BufferM a -> m a
withCurrentBuffer BufferM BufferFileInfo
bufInfoB
                   let (FilePath
filename, Int
line) = [(FilePath, Int)]
lis [(FilePath, Int)] -> Int -> (FilePath, Int)
forall a. [a] -> Int -> a
!! Int
ind
                       ln :: Int
ln = BufferFileInfo -> Int
bufInfoLineNo BufferFileInfo
bufinf
                       cn :: Int
cn = BufferFileInfo -> Int
bufInfoColNo BufferFileInfo
bufinf
                       fn :: FilePath
fn = BufferFileInfo -> FilePath
bufInfoFileName BufferFileInfo
bufinf
                       tl' :: [(Tag, Int, FilePath, Int, Int)]
tl' = Int
-> [(Tag, Int, FilePath, Int, Int)]
-> [(Tag, Int, FilePath, Int, Int)]
forall a. Int -> [a] -> [a]
take Int
ti [(Tag, Int, FilePath, Int, Int)]
tl
                               [(Tag, Int, FilePath, Int, Int)]
-> [(Tag, Int, FilePath, Int, Int)]
-> [(Tag, Int, FilePath, Int, Int)]
forall a. [a] -> [a] -> [a]
++ (Tag
tag, Int
ind, FilePath
fn, Int
ln, Int
cn)(Tag, Int, FilePath, Int, Int)
-> [(Tag, Int, FilePath, Int, Int)]
-> [(Tag, Int, FilePath, Int, Int)]
forall a. a -> [a] -> [a]
:(Int
-> [(Tag, Int, FilePath, Int, Int)]
-> [(Tag, Int, FilePath, Int, Int)]
forall a. Int -> [a] -> [a]
drop (Int
ti Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) [(Tag, Int, FilePath, Int, Int)]
tl)
                   EditorM () -> YiM ()
forall (m :: * -> *) a. MonadEditor m => EditorM a -> m a
withEditor (EditorM () -> YiM ()) -> EditorM () -> YiM ()
forall a b. (a -> b) -> a -> b
$ [(Tag, Int, FilePath, Int, Int)] -> EditorM ()
setTagList [(Tag, Int, FilePath, Int, Int)]
tl'
                   FilePath -> BufferM Int -> YiM ()
forall a. FilePath -> BufferM a -> YiM ()
openingNewFile FilePath
filename (BufferM Int -> YiM ()) -> BufferM Int -> YiM ()
forall a b. (a -> b) -> a -> b
$ Int -> BufferM Int
gotoLn Int
line

completeVimTag :: T.Text -> YiM [T.Text]
completeVimTag :: Text -> YiM [Text]
completeVimTag Text
s =
  (Maybe Text -> [Text]) -> YiM (Maybe Text) -> YiM [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Maybe Text -> [Text]
forall a. Maybe a -> [a]
maybeToList (YiM (Maybe Text) -> YiM [Text])
-> ((TagTable -> YiM Text) -> YiM (Maybe Text))
-> (TagTable -> YiM Text)
-> YiM [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (TagTable -> YiM Text) -> YiM (Maybe Text)
forall a. (TagTable -> YiM a) -> YiM (Maybe a)
visitTagTable ((TagTable -> YiM Text) -> YiM [Text])
-> (TagTable -> YiM Text) -> YiM [Text]
forall a b. (a -> b) -> a -> b
$ Text -> YiM Text
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> YiM Text) -> (TagTable -> Text) -> TagTable -> YiM Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (TagTable -> Text -> Text) -> Text -> TagTable -> Text
forall a b c. (a -> b -> c) -> b -> a -> c
flip TagTable -> Text -> Text
completeTag Text
s

-- | Gets the first valid tags file in @TagsFileList@, if such a valid
-- file exists.
tagsFile :: YiM (Maybe FilePath)
tagsFile :: YiM (Maybe FilePath)
tagsFile = do
    [FilePath]
fs <- Getting [FilePath] Config [FilePath] -> Config -> [FilePath]
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting [FilePath] Config [FilePath]
Field [FilePath]
tagsFileList (Config -> [FilePath]) -> YiM Config -> YiM [FilePath]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> YiM Config
forall (m :: * -> *). MonadEditor m => m Config
askCfg
    let g :: Maybe FilePath -> FilePath -> YiM (Maybe FilePath)
g Maybe FilePath
f' FilePath
f = case Maybe FilePath
f' of
            Just FilePath
_ -> Maybe FilePath -> YiM (Maybe FilePath)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe FilePath
f'
            Maybe FilePath
Nothing -> FilePath -> YiM (Maybe FilePath)
tagsFileLocation FilePath
f
    (Maybe FilePath -> FilePath -> YiM (Maybe FilePath))
-> Maybe FilePath -> [FilePath] -> YiM (Maybe FilePath)
forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldM Maybe FilePath -> FilePath -> YiM (Maybe FilePath)
g Maybe FilePath
forall a. Maybe a
Nothing [FilePath]
fs

-- | Handles paths of the form ./[path], which represents a tags file relative
-- to the path of the current directory of a file rather than the directory
-- of the process.
tagsFileLocation :: String -> YiM (Maybe FilePath)
tagsFileLocation :: FilePath -> YiM (Maybe FilePath)
tagsFileLocation FilePath
s
    | FilePath -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length FilePath
s Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
2 Bool -> Bool -> Bool
|| Int -> FilePath -> FilePath
forall a. Int -> [a] -> [a]
take Int
2 FilePath
s FilePath -> FilePath -> Bool
forall a. Eq a => a -> a -> Bool
/= FilePath
"./" = FilePath -> YiM (Maybe FilePath)
forall (m :: * -> *).
MonadBase IO m =>
FilePath -> m (Maybe FilePath)
check FilePath
s
    | Bool
otherwise = do
       let s' :: FilePath
s' = Int -> FilePath -> FilePath
forall a. Int -> [a] -> [a]
drop Int
2 FilePath
s
       FilePath
dir <- FilePath -> FilePath
takeDirectory (FilePath -> FilePath) -> YiM FilePath -> YiM FilePath
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
                 (BufferM FilePath -> YiM FilePath
forall (m :: * -> *) a. MonadEditor m => BufferM a -> m a
withCurrentBuffer (BufferM FilePath -> YiM FilePath)
-> BufferM FilePath -> YiM FilePath
forall a b. (a -> b) -> a -> b
$ BufferM BufferFileInfo
bufInfoB BufferM BufferFileInfo
-> (BufferFileInfo -> BufferM FilePath) -> BufferM FilePath
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= FilePath -> BufferM FilePath
forall (m :: * -> *) a. Monad m => a -> m a
return (FilePath -> BufferM FilePath)
-> (BufferFileInfo -> FilePath)
-> BufferFileInfo
-> BufferM FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BufferFileInfo -> FilePath
bufInfoFileName)
       FilePath -> YiM (Maybe FilePath)
forall (m :: * -> *).
MonadBase IO m =>
FilePath -> m (Maybe FilePath)
check (FilePath -> YiM (Maybe FilePath))
-> FilePath -> YiM (Maybe FilePath)
forall a b. (a -> b) -> a -> b
$ FilePath
dir FilePath -> FilePath -> FilePath
</> FilePath
s'
    where check :: FilePath -> m (Maybe FilePath)
check FilePath
f = do
            FilePath
f' <- IO FilePath -> m FilePath
forall (m :: * -> *) a. MonadBase IO m => IO a -> m a
io (IO FilePath -> m FilePath) -> IO FilePath -> m FilePath
forall a b. (a -> b) -> a -> b
$ FilePath -> IO FilePath
userToCanonPath FilePath
f
            Bool
fileExists <- IO Bool -> m Bool
forall (m :: * -> *) a. MonadBase IO m => IO a -> m a
io (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ FilePath -> IO Bool
doesFileExist FilePath
f'
            if Bool
fileExists
                then Maybe FilePath -> m (Maybe FilePath)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe FilePath -> m (Maybe FilePath))
-> Maybe FilePath -> m (Maybe FilePath)
forall a b. (a -> b) -> a -> b
$ FilePath -> Maybe FilePath
forall a. a -> Maybe a
Just FilePath
f'
                else Maybe FilePath -> m (Maybe FilePath)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe FilePath
forall a. Maybe a
Nothing

-- | Call continuation @act@ with the TagTable. Uses the global table
-- or, if it doesn't exist, uses the first valid tag file in
-- @TagsFileList@.
visitTagTable :: (TagTable -> YiM a) -> YiM (Maybe a)
visitTagTable :: (TagTable -> YiM a) -> YiM (Maybe a)
visitTagTable TagTable -> YiM a
act = do
    Maybe TagTable
posTagTable <- EditorM (Maybe TagTable) -> YiM (Maybe TagTable)
forall (m :: * -> *) a. MonadEditor m => EditorM a -> m a
withEditor EditorM (Maybe TagTable)
getTags
    case Maybe TagTable
posTagTable of
        Just TagTable
tagTable -> a -> Maybe a
forall a. a -> Maybe a
Just (a -> Maybe a) -> YiM a -> YiM (Maybe a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TagTable -> YiM a
act TagTable
tagTable
        Maybe TagTable
Nothing -> do
            Maybe FilePath
f <- YiM (Maybe FilePath)
tagsFile
            case Maybe FilePath
f of
                Maybe FilePath
Nothing -> Text -> YiM ()
errorEditor Text
"No tags file" YiM () -> YiM (Maybe a) -> YiM (Maybe a)
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Maybe a -> YiM (Maybe a)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe a
forall a. Maybe a
Nothing
                Just FilePath
f' -> do
                    TagTable
tagTable <- IO TagTable -> YiM TagTable
forall (m :: * -> *) a. MonadBase IO m => IO a -> m a
io (IO TagTable -> YiM TagTable) -> IO TagTable -> YiM TagTable
forall a b. (a -> b) -> a -> b
$ FilePath -> IO TagTable
importTagTable FilePath
f'
                    EditorM () -> YiM ()
forall (m :: * -> *) a. MonadEditor m => EditorM a -> m a
withEditor (EditorM () -> YiM ()) -> EditorM () -> YiM ()
forall a b. (a -> b) -> a -> b
$ TagTable -> EditorM ()
setTags TagTable
tagTable
                    a -> Maybe a
forall a. a -> Maybe a
Just (a -> Maybe a) -> YiM a -> YiM (Maybe a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TagTable -> YiM a
act TagTable
tagTable