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

    -- |
    -- Module      :  Yi.Tag
    -- License     :  GPL-2
    -- Maintainer  :  yi-devel@googlegroups.com
    -- Stability   :  experimental
    -- Portability :  portable
    --
    -- A module for CTags integration. Note that this reads the ‘tags’
    -- file produced by @hasktags@, not the ‘TAGS’ file which uses a
    -- different format (etags).

    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 :: Field [FilePath]
    tagsFileList = (TagsFileList -> f TagsFileList) -> Config -> f Config
    forall a. YiConfigVariable a => Field a
    Field TagsFileList
    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
    $cput :: Tags -> Put
    put :: Tags -> Put
    $cget :: Get Tags
    get :: Get Tags
    $cputList :: [Tags] -> Put
    putList :: [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
    $cshowsPrec :: Int -> Tag -> ShowS
    showsPrec :: Int -> Tag -> ShowS
    $cshow :: Tag -> FilePath
    show :: Tag -> FilePath
    $cshowList :: [Tag] -> ShowS
    showList :: [Tag] -> ShowS
    Show, Tag -> Tag -> Bool
    (Tag -> Tag -> Bool) -> (Tag -> Tag -> Bool) -> Eq Tag
    forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
    $c== :: Tag -> Tag -> Bool
    == :: Tag -> Tag -> Bool
    $c/= :: Tag -> Tag -> Bool
    /= :: 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
    $ccompare :: Tag -> Tag -> Ordering
    compare :: Tag -> Tag -> Ordering
    $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
    >= :: Tag -> Tag -> Bool
    $cmax :: Tag -> Tag -> Tag
    max :: Tag -> Tag -> Tag
    $cmin :: Tag -> Tag -> Tag
    min :: Tag -> Tag -> 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
    $cput :: Tag -> Put
    put :: Tag -> Put
    $cget :: Get Tag
    get :: Get Tag
    $cputList :: [Tag] -> Put
    putList :: [Tag] -> Put
    Binary)

    unTag' :: Tag -> T.Text
    unTag' :: Tag -> Text
    unTag' =  Tag -> Text
    _unTag

    data TagTable = TagTable
        { TagTable -> FilePath
    tagFileName :: FilePath
        -- ^ local name of the tag file
        -- TODO: reload if this file is changed
        , TagTable -> FilePath
    tagBaseDir :: FilePath
        -- ^ path to the tag file directory
        -- tags are relative to this path
        , TagTable -> Map Tag [(FilePath, Int)]
    tagFileMap :: Map Tag [(FilePath, Int)]
        -- ^ map from tags to files
        , TagTable -> CompletionTree Text
    tagCompletionTree :: CT.CompletionTree T.Text
        -- ^ trie to speed up tag hinting
        } 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
    $cfrom :: forall x. TagTable -> Rep TagTable x
    from :: forall x. TagTable -> Rep TagTable x
    $cto :: forall x. Rep TagTable x -> TagTable
    to :: forall x. Rep TagTable x -> TagTable
    Generic)

    -- | Find the location of a tag using the tag table.
    -- Returns a full path and line number
    lookupTag :: Tag -> TagTable -> [(FilePath, Int)]
    lookupTag :: Tag -> TagTable -> [(FilePath, Int)]
    lookupTag Tag
    tag TagTable
    tagTable = do
      (file, 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
      return (tagBaseDir tagTable </> file, line)

    -- | Super simple parsing CTag format 1 parsing algorithm
    -- TODO: support search patterns in addition to lineno
    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]
    _) =
                  -- remove ctag control lines
                  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 a b. (a -> b) -> Either FilePath a -> 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

    -- | Read in a tag file from the system
    importTagTable :: FilePath -> IO TagTable
    importTagTable :: FilePath -> IO TagTable
    importTagTable FilePath
    filename = do
      friendlyName <-  FilePath -> IO FilePath
    expandTilda FilePath
    filename
      tagStr <- E.decodeUtf8 <$> BS.readFile friendlyName
      let cts = Text -> Map Tag [(FilePath, Int)]
    readCTags Text
    tagStr
      return TagTable { tagFileName = takeFileName filename
                      , tagBaseDir  = takeDirectory filename
                      , tagFileMap  = cts
                      , tagCompletionTree = CT.fromList . map (_unTag) $ keys cts
                      }

    -- | Gives all the possible expanded tags that could match a given @prefix@
    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)

    -- | Extends the string to the longest certain length
    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))

    -- ---------------------------------------------------------------------
    -- Direct access interface to TagTable.

    -- | Set a new TagTable
    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

    -- | Reset the TagTable
    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

    -- | Get the currently registered tag table
    getTags :: EditorM (Maybe TagTable)
    getTags :: EditorM (Maybe TagTable)
    getTags = do
      Tags t <- EditorM Tags
    forall (m :: * -> *) a.
    (MonadEditor m, YiVariable a, Default a, Functor m) =>
    m a
    getEditorDyn
      return t

    instance Binary TagTable