    {-# LANGUAGE OverloadedStrings #-}
    {-# OPTIONS_HADDOCK show-extensions #-}

    -- |
    -- Module      :  Yi.Completion
    -- License     :  GPL-2
    -- Maintainer  :  yi-devel@googlegroups.com
    -- Stability   :  experimental
    -- Portability :  portable
    --
    -- Collection of functions for completion and matching.

    module Yi.Completion
      ( completeInList, completeInList'
      , completeInListCustomShow
      , commonPrefix
      , prefixMatch, infixUptoEndMatch
      , subsequenceMatch, subsequenceTextMatch
      , containsMatch', containsMatch, containsMatchCaseInsensitive
      , isCasePrefixOf
      )
    where

    import           Data.Function       (on)
    import           Data.List           (find, nub)
    import           Data.Maybe          (catMaybes)
    import           Data.Monoid         ((<>))
    import           Data.Text           (Text)
    import qualified Data.Text           as T (Text, breakOn, isPrefixOf, length, null, tails, toCaseFold, splitAt)
    import           Yi.Editor           (EditorM, printMsg, printMsgs)
    import           Yi.String           (commonTPrefix', showT)
    import           Yi.Utils            (commonPrefix)

    -------------------------------------------
    -- General completion

    -- | Like usual 'T.isPrefixOf' but user can specify case sensitivity.
    -- See 'T.toCaseFold' for exotic unicode gotchas.
    isCasePrefixOf :: Bool -- ^ Is case-sensitive?
                 -> T.Text
                 -> T.Text
                 -> Bool
    isCasePrefixOf :: Bool -> Text -> Text -> Bool
    isCasePrefixOf Bool
    True = Text -> Text -> Bool
    T.isPrefixOf
    isCasePrefixOf Bool
    False = Text -> Text -> Bool
    T.isPrefixOf (Text -> Text -> Bool) -> (Text -> Text) -> Text -> Text -> Bool
    forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
    `on` Text -> Text
    T.toCaseFold

    -- | Prefix matching function, for use with 'completeInList'
    prefixMatch :: T.Text -> T.Text -> Maybe T.Text
    prefixMatch :: Text -> Text -> Maybe Text
    prefixMatch Text
    prefix Text
    s = if Text
    prefix Text -> Text -> Bool
    `T.isPrefixOf` Text
    s then Text -> Maybe Text
    forall a. a -> Maybe a
    Just Text
    s else Maybe Text
    forall a. Maybe a
    Nothing

    -- | Text from the match up to the end, for use with 'completeInList'
    infixUptoEndMatch :: T.Text -> T.Text -> Maybe T.Text
    infixUptoEndMatch :: Text -> Text -> Maybe Text
    infixUptoEndMatch Text
    "" Text
    haystack = Text -> Maybe Text
    forall a. a -> Maybe a
    Just Text
    haystack
    infixUptoEndMatch Text
    needle Text
    haystack = case HasCallStack => Text -> Text -> (Text, Text)
    Text -> Text -> (Text, Text)
    T.breakOn Text
    needle Text
    haystack of
      (Text
    _, Text
    t) -> if Text -> Bool
    T.null Text
    t then Maybe Text
    forall a. Maybe a
    Nothing else Text -> Maybe Text
    forall a. a -> Maybe a
    Just Text
    t

    -- | A simple fuzzy match algorithm. Example: "abc" matches "a1b2c"
    subsequenceMatch :: String -> String -> Bool
    subsequenceMatch :: String -> String -> Bool
    subsequenceMatch String
    needle String
    haystack = String -> String -> Bool
    forall {a}. Eq a => [a] -> [a] -> Bool
    go String
    needle String
    haystack
      where go :: [a] -> [a] -> Bool
    go (a
    n:[a]
    ns) (a
    h:[a]
    hs) | a
    n a -> a -> Bool
    forall a. Eq a => a -> a -> Bool
    == a
    h = [a] -> [a] -> Bool
    go [a]
    ns [a]
    hs
            go (a
    n:[a]
    ns) (a
    h:[a]
    hs) | a
    n a -> a -> Bool
    forall a. Eq a => a -> a -> Bool
    /= a
    h = [a] -> [a] -> Bool
    go (a
    na -> [a] -> [a]
    forall a. a -> [a] -> [a]
    :[a]
    ns) [a]
    hs
            go [] [a]
    _ = Bool
    True
            go [a]
    _ [] = Bool
    False
            go [a]
    _ [a]
    _  = Bool
    False

    -- | A simple fuzzy match algorithm. Example: "abc" matches "a1b2c"
    subsequenceTextMatch :: Text -> Text -> Bool
    subsequenceTextMatch :: Text -> Text -> Bool
    subsequenceTextMatch Text
    needle Text
    haystack
      | Text -> Bool
    T.null Text
    needle   = Bool
    True
      | Text -> Bool
    T.null Text
    haystack = Bool
    False
      | Text
    n Text -> Text -> Bool
    forall a. Eq a => a -> a -> Bool
    == Text
    h     = Text -> Text -> Bool
    subsequenceTextMatch Text
    ns     Text
    hs
      | Text
    n Text -> Text -> Bool
    forall a. Eq a => a -> a -> Bool
    /= Text
    h     = Text -> Text -> Bool
    subsequenceTextMatch Text
    needle Text
    hs
      | Bool
    otherwise  = Bool
    False
      where
        n,ns,h,hs :: Text
        (Text
    n,Text
    ns) = Int -> Text -> (Text, Text)
    T.splitAt Int
    1 Text
    needle
        (Text
    h,Text
    hs) = Int -> Text -> (Text, Text)
    T.splitAt Int
    1 Text
    haystack

    -- | TODO: this is a terrible function, isn't this just
    -- case-insensitive infix? – Fūzetsu
    containsMatch' :: Bool -> T.Text -> T.Text -> Maybe T.Text
    containsMatch' :: Bool -> Text -> Text -> Maybe Text
    containsMatch' Bool
    caseSensitive Text
    pattern Text
    str =
      Text -> Text -> Text
    forall a b. a -> b -> a
    const Text
    str (Text -> Text) -> Maybe Text -> Maybe Text
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> (Text -> Bool) -> [Text] -> Maybe Text
    forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
    find (Text
    pattern Text -> Text -> Bool
    `tstPrefix`) (Text -> [Text]
    T.tails Text
    str)
      where
        tstPrefix :: Text -> Text -> Bool
    tstPrefix = Bool -> Text -> Text -> Bool
    isCasePrefixOf Bool
    caseSensitive

    containsMatch :: T.Text -> T.Text -> Maybe T.Text
    containsMatch :: Text -> Text -> Maybe Text
    containsMatch = Bool -> Text -> Text -> Maybe Text
    containsMatch' Bool
    True

    containsMatchCaseInsensitive :: T.Text -> T.Text -> Maybe T.Text
    containsMatchCaseInsensitive :: Text -> Text -> Maybe Text
    containsMatchCaseInsensitive = Bool -> Text -> Text -> Maybe Text
    containsMatch' Bool
    False

    -- | Complete a string given a user input string, a matching function
    -- and a list of possibilites. Matching function should return the
    -- part of the string that matches the user string.
    completeInList :: T.Text -- ^ Input to match on
                   -> (T.Text -> Maybe T.Text) -- ^ matcher function
                   -> [T.Text] -- ^ items to match against
                   -> EditorM T.Text
    completeInList :: Text -> (Text -> Maybe Text) -> [Text] -> EditorM Text
    completeInList = (Text -> Text)
    -> Text -> (Text -> Maybe Text) -> [Text] -> EditorM Text
    completeInListCustomShow Text -> Text
    forall a. a -> a
    id

    -- | Same as 'completeInList', but maps @showFunction@ on possible
    -- matches when printing
    completeInListCustomShow :: (T.Text -> T.Text) -- ^ Show function
                             -> T.Text -- ^ Input to match on
                             -> (T.Text -> Maybe T.Text) -- ^ matcher function
                             -> [T.Text] -- ^ items to match against
                             -> EditorM T.Text
    completeInListCustomShow :: (Text -> Text)
    -> Text -> (Text -> Maybe Text) -> [Text] -> EditorM Text
    completeInListCustomShow Text -> Text
    showFunction Text
    s Text -> Maybe Text
    match [Text]
    possibilities
        | [Text] -> Bool
    forall a. [a] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [Text]
    filtered = Text -> EditorM ()
    forall (m :: * -> *). MonadEditor m => Text -> m ()
    printMsg Text
    "No match" EditorM () -> EditorM Text -> EditorM Text
    forall a b. EditorM a -> EditorM b -> EditorM b
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> Text -> EditorM Text
    forall a. a -> EditorM a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Text
    s
        | Text
    prefix Text -> Text -> Bool
    forall a. Eq a => a -> a -> Bool
    /= Text
    s = Text -> EditorM Text
    forall a. a -> EditorM a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Text
    prefix
        | [Text] -> Bool
    forall a. [a] -> Bool
    isSingleton [Text]
    filtered = Text -> EditorM ()
    forall (m :: * -> *). MonadEditor m => Text -> m ()
    printMsg Text
    "Sole completion" EditorM () -> EditorM Text -> EditorM Text
    forall a b. EditorM a -> EditorM b -> EditorM b
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> Text -> EditorM Text
    forall a. a -> EditorM a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Text
    s
        | Text
    prefix Text -> [Text] -> Bool
    forall a. Eq a => a -> [a] -> Bool
    forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
    `elem` [Text]
    filtered =
            Text -> EditorM ()
    forall (m :: * -> *). MonadEditor m => Text -> m ()
    printMsg (Text
    "Complete, but not unique: " Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> [Text] -> Text
    forall a. Show a => a -> Text
    showT [Text]
    filtered) EditorM () -> EditorM Text -> EditorM Text
    forall a b. EditorM a -> EditorM b -> EditorM b
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> Text -> EditorM Text
    forall a. a -> EditorM a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Text
    s
        | Bool
    otherwise = [Text] -> EditorM ()
    forall (m :: * -> *). MonadEditor m => [Text] -> m ()
    printMsgs ((Text -> Text) -> [Text] -> [Text]
    forall a b. (a -> b) -> [a] -> [b]
    map Text -> Text
    showFunction [Text]
    filtered)
                      EditorM () -> EditorM Text -> EditorM Text
    forall a b. EditorM a -> EditorM b -> EditorM b
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> Text -> EditorM Text
    forall a. a -> EditorM a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ([Text] -> Text -> Text
    bestMatch [Text]
    filtered Text
    s)
        where
          prefix :: Text
    prefix   = [Text] -> Text
    commonTPrefix' [Text]
    filtered
          filtered :: [Text]
    filtered = (Text -> Maybe Text) -> [Text] -> [Text]
    forall a b. Eq a => (b -> Maybe a) -> [b] -> [a]
    filterMatches Text -> Maybe Text
    match [Text]
    possibilities

    completeInList' :: T.Text
                    -> (T.Text -> Maybe T.Text)
                    -> [T.Text]
                    -> EditorM T.Text
    completeInList' :: Text -> (Text -> Maybe Text) -> [Text] -> EditorM Text
    completeInList' Text
    s Text -> Maybe Text
    match [Text]
    l = case [Text]
    filtered of
      [] -> Text -> EditorM ()
    forall (m :: * -> *). MonadEditor m => Text -> m ()
    printMsg Text
    "No match" EditorM () -> EditorM Text -> EditorM Text
    forall a b. EditorM a -> EditorM b -> EditorM b
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> Text -> EditorM Text
    forall a. a -> EditorM a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Text
    s
      [Text
    x] | Text
    s Text -> Text -> Bool
    forall a. Eq a => a -> a -> Bool
    == Text
    x    -> Text -> EditorM ()
    forall (m :: * -> *). MonadEditor m => Text -> m ()
    printMsg Text
    "Sole completion" EditorM () -> EditorM Text -> EditorM Text
    forall a b. EditorM a -> EditorM b -> EditorM b
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> Text -> EditorM Text
    forall a. a -> EditorM a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Text
    s
          | Bool
    otherwise -> Text -> EditorM Text
    forall a. a -> EditorM a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Text
    x
      [Text]
    _ -> [Text] -> EditorM ()
    forall (m :: * -> *). MonadEditor m => [Text] -> m ()
    printMsgs [Text]
    filtered EditorM () -> EditorM Text -> EditorM Text
    forall a b. EditorM a -> EditorM b -> EditorM b
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> Text -> EditorM Text
    forall a. a -> EditorM a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ([Text] -> Text -> Text
    bestMatch [Text]
    filtered Text
    s)
      where
        filtered :: [Text]
    filtered = (Text -> Maybe Text) -> [Text] -> [Text]
    forall a b. Eq a => (b -> Maybe a) -> [b] -> [a]
    filterMatches Text -> Maybe Text
    match [Text]
    l

    -- | This function attempts to provide a better tab completion result in
    -- cases where more than one file matches our prefix. Consider directory with
    -- following files: @["Main.hs", "Main.hi", "Main.o", "Test.py", "Foo.hs"]@.
    --
    -- After inserting @Mai@ into the minibuffer and attempting to complete, the
    -- possible matches will be filtered in 'completeInList'' to
    -- @["Main.hs", "Main.hi", "Main.o"]@ however because of multiple matches,
    -- the buffer will not be updated to say @Main.@ but will instead stay at @Mai@.
    --
    -- This is extremely tedious when trying to complete filenames in directories
    -- with many files so here we try to catch common prefixes of filtered files and
    -- if the result is longer than what we have, we use it instead.
    bestMatch :: [T.Text] -> T.Text -> T.Text
    bestMatch :: [Text] -> Text -> Text
    bestMatch [Text]
    fs Text
    s = let p :: Text
    p = [Text] -> Text
    commonTPrefix' [Text]
    fs
                     in if Text -> Int
    T.length Text
    p Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    > Text -> Int
    T.length Text
    s then Text
    p else Text
    s

    filterMatches :: Eq a => (b -> Maybe a) -> [b] -> [a]
    filterMatches :: forall a b. Eq a => (b -> Maybe a) -> [b] -> [a]
    filterMatches b -> Maybe a
    match = [a] -> [a]
    forall a. Eq a => [a] -> [a]
    nub ([a] -> [a]) -> ([b] -> [a]) -> [b] -> [a]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . [Maybe a] -> [a]
    forall a. [Maybe a] -> [a]
    catMaybes ([Maybe a] -> [a]) -> ([b] -> [Maybe a]) -> [b] -> [a]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (b -> Maybe a) -> [b] -> [Maybe a]
    forall a b. (a -> b) -> [a] -> [b]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap b -> Maybe a
    match

    -- Not really necessary but a bit faster than @(length l) == 1@
    isSingleton :: [a] -> Bool
    isSingleton :: forall a. [a] -> Bool
    isSingleton [a
    _] = Bool
    True
    isSingleton [a]
    _   = Bool
    False