module Yi.Fuzzy (fuzzyOpen, fuzzyOpenWithDepth, defaultDepth) where
import Control.Applicative
import Control.Monad
import Control.Monad.Base
import Control.Monad.State (gets)
import Data.Binary
import Data.Default
import Data.List (isSuffixOf)
import qualified Data.Map.Strict as M
import Data.Monoid
import qualified Data.Text as T
import qualified Data.Text.Encoding as T
import Data.Typeable
import qualified Data.Vector as V
import GHC.Generics
import System.Directory (doesDirectoryExist, getDirectoryContents)
import System.FilePath ((</>))
import System.IO.Error
import Yi
import Yi.Completion
import Yi.MiniBuffer
import qualified Yi.Rope as R
import Yi.Types
import Yi.Utils ()
import Prelude
data FuzzyState = FuzzyState
{ _fsItems :: !(V.Vector FuzzyItem)
, fsSelectedIndex :: !(Maybe Int)
, fsNeedle :: !T.Text
} deriving (Show, Generic, Typeable)
data FuzzyItem
= FileItem { _filePath :: !FilePath }
| BufferItem { _bufferIdent :: !BufferId }
deriving (Show, Typeable)
itemToString :: FuzzyItem -> String
itemToString (FileItem x) = x
itemToString (BufferItem (MemBuffer x)) = T.unpack x
itemToString (BufferItem (FileBuffer x)) = x
defaultDepth :: Int
defaultDepth = 5
fuzzyOpen :: YiM ()
fuzzyOpen = fuzzyOpenWithDepth defaultDepth
fuzzyOpenWithDepth :: Int -> YiM ()
fuzzyOpenWithDepth d = case () of
_ | d <= 0 -> printMsg "You need at least depth of 1 for fuzzyOpenWithDepth"
| otherwise -> do
fileList <- fmap (fmap FileItem)
(liftBase (getRecursiveContents d "."))
bufList <- fmap (fmap (BufferItem . ident . attributes))
(withEditor (gets (M.elems . buffers)))
promptRef <- withEditor (spawnMinibufferE "" (const localKeymap))
let initialState =
FuzzyState (fileList <> V.fromList bufList)
(Just 0)
""
withGivenBuffer promptRef $ do
putBufferDyn initialState
withEditor (renderE initialState)
getRecursiveContents :: Int -> FilePath -> IO (V.Vector FilePath)
getRecursiveContents d _ | d <= 0 = return mempty
getRecursiveContents d t = tryIOError (getDirectoryContents t) >>= \case
Left _ -> return mempty
Right names -> do
let properNames = filter predicate names
predicate :: FilePath -> Bool
predicate fileName = and
[ fileName `notElem` [".", "..", ".git", ".svn"]
, not (".hi" `isSuffixOf` fileName)
, not ("-boot" `isSuffixOf` fileName)
]
paths <- forM properNames $ \name -> do
let path = t </> name
isDirectory <- doesDirectoryExist path
if isDirectory
then getRecursiveContents (d 1) path
else return $ V.singleton path
return $ mconcat paths
localKeymap :: Keymap
localKeymap =
choice
[ spec KEnter ?>>! openInThisWindow
, ctrlCh 't' ?>>! openInNewTab
, ctrlCh 's' ?>>! openInSplit
, spec KEsc ?>>! cleanupE
, ctrlCh 'g' ?>>! cleanupE
, ctrlCh 'h' ?>>! updatingB (deleteB Character Backward)
, spec KBS ?>>! updatingB (deleteB Character Backward)
, spec KDel ?>>! updatingB (deleteB Character Backward)
, ctrlCh 'a' ?>>! moveToSol
, ctrlCh 'e' ?>>! moveToEol
, spec KLeft ?>>! moveXorSol 1
, spec KRight ?>>! moveXorEol 1
, ctrlCh 'p' ?>>! modifyE decrementIndex
, spec KUp ?>>! modifyE decrementIndex
, ctrlCh 'n' ?>>! modifyE incrementIndex
, spec KDown ?>>! modifyE incrementIndex
, ctrlCh 'w' ?>>! updatingB (deleteB unitWord Backward)
, ctrlCh 'u' ?>>! updatingB (moveToSol >> deleteToEol)
, ctrlCh 'k' ?>>! updatingB deleteToEol
]
<|| (insertChar >>! ((withCurrentBuffer updateNeedleB) >>= renderE))
where updatingB :: BufferM () -> EditorM ()
updatingB bufAction = withCurrentBuffer (bufAction >> updateNeedleB) >>= renderE
updateNeedleB :: BufferM FuzzyState
updateNeedleB = do
needle <- R.toText <$> readLnB
oldState <- getBufferDyn
let intermediateState = oldState { fsNeedle = needle }
newState = intermediateState
{ fsSelectedIndex =
case V.toList (filteredItems intermediateState) of
[] -> Nothing
(_, index) : _ -> Just index
}
putBufferDyn newState
return newState
filteredItems :: FuzzyState -> (V.Vector (FuzzyItem, Int))
filteredItems (FuzzyState items _ needle) =
V.filter (subsequenceMatch (T.unpack needle) . itemToString . fst)
(V.zip items (V.enumFromTo 0 (V.length items)))
modifyE :: (FuzzyState -> FuzzyState) -> EditorM ()
modifyE f = do
prevState <- withCurrentBuffer getBufferDyn
let newState = f prevState
withCurrentBuffer (putBufferDyn newState)
renderE newState
incrementIndex :: FuzzyState -> FuzzyState
incrementIndex fs@(FuzzyState _ Nothing _) = fs
incrementIndex fs@(FuzzyState _ (Just index) _) =
let fitems = filteredItems fs
steps = V.zipWith (\x y -> (snd x, snd y)) fitems (V.tail fitems)
newIndex = case V.find ((== index) . fst) steps of
Nothing -> Just index
Just (_, nextIndex) -> Just nextIndex
in fs { fsSelectedIndex = newIndex }
decrementIndex :: FuzzyState -> FuzzyState
decrementIndex fs@(FuzzyState _ Nothing _) = fs
decrementIndex fs@(FuzzyState _ (Just index) _) =
let fitems = filteredItems fs
steps = V.zipWith (\x y -> (snd x, snd y)) (V.tail fitems) fitems
newIndex = case V.find ((== index) . fst) steps of
Nothing -> Just index
Just (_, prevIndex) -> Just prevIndex
in fs { fsSelectedIndex = newIndex }
renderE :: FuzzyState -> EditorM ()
renderE fs@(FuzzyState _ selIndex _) = do
let content = V.toList (fmap renderItem (filteredItems fs))
renderItem (item, itemIndex) = (T.justifyLeft 79 ' ' . mconcat)
[ (if Just itemIndex == selIndex then "* " else " ")
, renderItem' item
]
renderItem' (FileItem x) = "File " <> T.pack x
renderItem' (BufferItem (MemBuffer x)) = "Buffer " <> x
renderItem' (BufferItem (FileBuffer x)) = "Buffer " <> T.pack x
setStatus (content, defaultStyle)
openInThisWindow :: YiM ()
openInThisWindow = openRoutine (return ())
openInSplit :: YiM ()
openInSplit = openRoutine splitE
openInNewTab :: YiM ()
openInNewTab = openRoutine newTabE
openRoutine :: EditorM () -> YiM ()
openRoutine preOpenAction = do
FuzzyState items mselIndex _ <- withCurrentBuffer getBufferDyn
case mselIndex of
Nothing -> printMsg "Nothing selected"
Just selIndex -> do
let action = case items V.! selIndex of
FileItem x -> void (editFile x)
BufferItem x -> withEditor $ do
bufs <- gets (M.assocs . buffers)
case filter ((== x) . ident . attributes . snd) bufs of
[] -> error ("Couldn't find buffer" <> show x)
(bufRef, _) : _ -> switchToBufferE bufRef
withEditor $ do
cleanupE
preOpenAction
action
insertChar :: Keymap
insertChar = textChar >>= write . insertB
cleanupE :: EditorM ()
cleanupE = clrStatus >> closeBufferAndWindowE
instance Binary FuzzyItem where
put (FileItem x) = put (0 :: Int) >> put x
put (BufferItem x) = put (1 :: Int) >> put x
get = do
tag :: Int <- get
case tag of
0 -> liftM FileItem get
1 -> liftM BufferItem get
_ -> error "Unexpected FuzzyItem Binary."
instance Binary FuzzyState where
put (FuzzyState items index needle) = do
put (V.length items)
V.mapM_ put items
put index
put (T.encodeUtf8 needle)
get = do
itemCount <- get
items <- liftM V.fromList (replicateM itemCount get)
liftM2 (FuzzyState items) get (liftM T.decodeUtf8 get)
instance Default FuzzyState where
def = FuzzyState mempty Nothing mempty
instance YiVariable FuzzyState