yi-fuzzy-open 0.16.0 → 0.17.0
raw patch · 3 files changed
+227/−187 lines, 3 filesdep +pointedlistdep ~yi-coredep ~yi-ropenew-uploaderPVP ok
version bump matches the API change (PVP)
Dependencies added: pointedlist
Dependency ranges changed: yi-core, yi-rope
API changes (from Hackage documentation)
- Yi.Fuzzy: defaultDepth :: Int
+ Yi.Fuzzy: defaultDepth :: Natural
- Yi.Fuzzy: fuzzyOpenWithDepth :: Int -> YiM ()
+ Yi.Fuzzy: fuzzyOpenWithDepth :: Natural -> YiM ()
Files
- src/Data/List/PointedList/Extras.hs +30/−0
- src/Yi/Fuzzy.hs +192/−180
- yi-fuzzy-open.cabal +5/−7
+ src/Data/List/PointedList/Extras.hs view
@@ -0,0 +1,30 @@+{-# LANGUAGE ScopedTypeVariables #-}+module Data.List.PointedList.Extras+ ( filterr+ , catMaybesr+ ) where++import Control.Monad (guard)+import Data.List.PointedList (PointedList(..))+import qualified Data.Maybe as M (catMaybes)++-- | filter a pointed list, preferring the right list as the new focus if the focus is lost.+filterr :: (a -> Bool) -> PointedList a -> Maybe (PointedList a)+filterr filt pl = catMaybesr $ fmap (\a -> guard (filt a) >> Just a) pl++-- | catMaybes on a pointed list, preferring the right list as the new focus if the focus is lost.+catMaybesr :: forall a . PointedList (Maybe a) -> Maybe (PointedList a)+catMaybesr (PointedList mls mf mrs) = case mf of+ Nothing -> shiftFocus rs ss+ Just f -> pure $ PointedList rs f ss+ where+ rs, ss :: [a]+ rs = M.catMaybes mls+ ss = M.catMaybes mrs++ shiftFocus :: [a] -> [a] -> Maybe (PointedList a)+ shiftFocus [] (f:rs) = pure $ PointedList [] f rs+ shiftFocus (f:ls) [] = pure $ PointedList ls f []+ shiftFocus _ _ = Nothing++
src/Yi/Fuzzy.hs view
@@ -1,8 +1,8 @@ {-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE DeriveGeneric #-}-{-# LANGUAGE LambdaCase #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE InstanceSigs #-} {-# OPTIONS_HADDOCK show-extensions #-} -- |@@ -17,55 +17,68 @@ 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 Control.Monad (void)+import Control.Monad.Base (liftBase)+import Control.Monad.State (gets)+import Data.Binary (Binary(..), Word8)+import Data.Default (Default(..))+import Data.Foldable (Foldable(..))+import Data.List (isSuffixOf)+import Data.List.NonEmpty (NonEmpty(..), nonEmpty)+import Data.List.PointedList (PointedList(..))+import Data.Maybe (fromMaybe)+import Data.Monoid ((<>))+import Data.Text (Text)+import Data.Typeable (Typeable)+import GHC.Generics (Generic)+import GHC.Natural (Natural)+import System.Directory (doesDirectoryExist, getDirectoryContents)+import System.FilePath ((</>))+import System.IO.Error (tryIOError)+ 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 Data.Map.Strict as M+import qualified Data.List.PointedList as PL++import Data.List.PointedList.Extras as PL++import Yi+import Yi.Completion+import Yi.MiniBuffer+import Yi.Types+import Yi.Utils () import qualified Yi.Rope as R-import Yi.Types-import Yi.Utils () --- The following import is a hack which silences redundant import--- warnings on recent (4.8.0.0) base-import Prelude -- FuzzyState is stored in minibuffer's dynamic state data FuzzyState = FuzzyState- { _fsItems :: !(V.Vector FuzzyItem)- , fsSelectedIndex :: !(Maybe Int)- , fsNeedle :: !T.Text- } deriving (Show, Generic, Typeable)+ { items :: !(Maybe (PointedList FuzzyItem))+ , search :: !Text+ } deriving (Show, Generic, Typeable) data FuzzyItem- = FileItem { _filePath :: !FilePath }- | BufferItem { _bufferIdent :: !BufferId }- deriving (Show, Typeable)+ = FileItem !Text+ | BufferItem !BufferId+ deriving (Typeable) --- TODO: make subsequenceMatch work on Text-itemToString :: FuzzyItem -> String-itemToString (FileItem x) = x-itemToString (BufferItem (MemBuffer x)) = T.unpack x-itemToString (BufferItem (FileBuffer x)) = x+instance Show FuzzyItem where+ show :: FuzzyItem -> String+ show i = case i of+ FileItem _ -> "File " <> itemAsStr i+ BufferItem _ -> "Buffer " <> itemAsStr i --- | The depth 'fuzzyOpen' should traverse by default. Currently--- __5__.-defaultDepth :: Int+itemAsTxt :: FuzzyItem -> Text+itemAsTxt f = case f of+ FileItem x -> x+ BufferItem (MemBuffer x) -> x+ BufferItem (FileBuffer x) -> T.pack x++itemAsStr :: FuzzyItem -> String+itemAsStr = T.unpack . itemAsTxt++-- | The depth 'fuzzyOpen' should traverse by default. Currently __5__.+defaultDepth :: Natural defaultDepth = 5 -- | Fuzzy open the current directory. The depth searched is@@ -76,134 +89,134 @@ -- | Fuzzy-opens the directory to the specified depth. The depth needs -- to be at least @1@ for it to do anything meaningful.-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)+fuzzyOpenWithDepth :: Natural -> YiM ()+fuzzyOpenWithDepth d = do+ fileList <- (fmap . fmap) (FileItem . T.pack) (liftBase $ getRecursiveContents d ".")+ bufList <- (fmap . fmap) (BufferItem . ident . attributes) (withEditor (gets (M.elems . buffers)))+ promptRef <- withEditor (spawnMinibufferE "" (const localKeymap)) --- shamelessly stolen from Chapter 9 of Real World Haskell+ let initialState = FuzzyState (PL.fromList (filterNotCommon bufList <> fileList)) ""+ withGivenBuffer promptRef $ putBufferDyn initialState+ withEditor (renderE initialState)+ where+ filterNotCommon :: [FuzzyItem] -> [FuzzyItem]+ filterNotCommon = filter ((\n -> not (n == "console" || n == "messages")) . itemAsTxt)++ -- takes about 3 seconds to traverse linux kernel, which is not too outrageous -- TODO: check if it works at all with cyclic links -- TODO: perform in background, limit file count or directory depth-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+getRecursiveContents :: Natural -> FilePath -> IO [FilePath]+getRecursiveContents d t+ | d == 0 = return mempty+ | otherwise = do+ x <- tryIOError (getDirectoryContents t)+ case x of+ Left _ -> return mempty+ Right names -> do+ paths <- mapM withName (filter isProperName names)+ return $ mconcat paths+ where+ isProperName :: FilePath -> Bool+ isProperName fileName = and+ [ fileName `notElem` [".", "..", ".git", ".svn"]+ , not (".hi" `isSuffixOf` fileName)+ , not ("-boot" `isSuffixOf` fileName)+ ] - 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+ withName :: FilePath -> IO [FilePath]+ withName name = do+ let path = t </> name+ isDirectory <- doesDirectoryExist path+ if isDirectory then getRecursiveContents (d - 1) path else pure [path] 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+ 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 goPrevious+ , ctrlCh 'n' ?>>! modifyE goNext+ , spec KDown ?>>! modifyE goNext+ , Event KTab [MShift] ?>>! modifyE goPrevious+ , Event KTab [] ?>>! modifyE goNext+ , 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+ s <- R.toText <$> readLnB+ oldState <- getBufferDyn+ let newState = oldState `filterState` s+ putBufferDyn newState+ return newState+ where+ filterState :: FuzzyState -> Text -> FuzzyState+ filterState old s = old { search = s, items = newItems }+ where+ newItems :: Maybe (PointedList FuzzyItem)+ newItems = do+ o <- items old+ f <- filterItems s o+ PL.moveTo 0 f -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))) +filterItems :: Text -> PointedList FuzzyItem -> Maybe (PointedList FuzzyItem)+filterItems s zipper = PL.filterr (subsequenceTextMatch s . itemAsTxt) zipper+ modifyE :: (FuzzyState -> FuzzyState) -> EditorM () modifyE f = do- prevState <- withCurrentBuffer getBufferDyn- let newState = f prevState- withCurrentBuffer (putBufferDyn newState)- renderE newState+ 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 }+goNext :: FuzzyState -> FuzzyState+goNext = changeIndex PL.next -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 }+goPrevious :: FuzzyState -> FuzzyState+goPrevious = changeIndex PL.previous +changeIndex :: (PointedList FuzzyItem -> Maybe (PointedList FuzzyItem)) -> FuzzyState -> FuzzyState+changeIndex dir fs = fs { items = items fs >>= dir }+ renderE :: FuzzyState -> EditorM ()-renderE fs@(FuzzyState _ selIndex _) = do- let content = V.toList (fmap renderItem (filteredItems fs))- -- TODO justify to actual screen width- 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)+renderE (FuzzyState maybeZipper s) = do+ case mcontent of+ Nothing -> printMsg "No match found"+ Just content -> setStatus (toList content, defaultStyle)+ where+ tshow :: Show s => s -> Text+ tshow = T.pack . show+ mcontent :: Maybe (NonEmpty Text)+ mcontent = do+ zipper <- maybeZipper+ zipper' <- PL.withFocus <$> filterItems s zipper+ nonEmpty . toList $ fmap (uncurry $ flip renderItem) zipper' + -- TODO justify to actual screen width+ renderItem :: Bool -> FuzzyItem -> Text+ renderItem isFocus fi = renderStar isFocus (T.justifyLeft 79 ' ' . T.pack . show $ fi)++ renderStar :: Bool -> (Text -> Text)+ renderStar y = if y then ("* "<>) else (" "<>)+ openInThisWindow :: YiM () openInThisWindow = openRoutine (return ()) @@ -215,22 +228,25 @@ 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+ mzipper <- items <$> withCurrentBuffer getBufferDyn+ case mzipper of+ Nothing -> printMsg "Nothing selected"+ Just (PointedList _ f _) -> do+ withEditor $ do+ cleanupE+ preOpenAction+ action f+ where+ action :: FuzzyItem -> YiM ()+ action fi = case fi of+ FileItem x -> void (editFile (T.unpack x))+ BufferItem x -> withEditor $ do+ bufs <- gets (M.assocs . buffers)+ case filter ((==x) . ident . attributes . snd) bufs of+ [] -> error ("Couldn't find " <> show x)+ (bufRef, _):_ -> switchToBufferE bufRef + insertChar :: Keymap insertChar = textChar >>= write . insertB @@ -238,27 +254,23 @@ 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."+ put (FileItem x) = put (0 :: Word8) >> put x+ put (BufferItem x) = put (1 :: Word8) >> put x+ get = do+ tag :: Word8 <- get+ case tag of+ 0 -> FileItem <$> get+ 1 -> 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)+ put (FuzzyState mzipper s) = do+ put mzipper+ put (T.encodeUtf8 s) + get = FuzzyState <$> get <*> fmap T.decodeUtf8 get+ instance Default FuzzyState where- def = FuzzyState mempty Nothing mempty+ def = FuzzyState Nothing mempty instance YiVariable FuzzyState
yi-fuzzy-open.cabal view
@@ -1,9 +1,5 @@--- This file has been generated from package.yaml by hpack version 0.17.1.------ see: https://github.com/sol/hpack- name: yi-fuzzy-open-version: 0.16.0+version: 0.17.0 synopsis: Fuzzy open plugin for yi description: This plugin tries to do what ctrl-p does for vim and helm does for emacs. category: Yi@@ -30,14 +26,16 @@ , directory >= 1.2.2 , filepath >= 1.4.0 , mtl >= 2.2+ , pointedlist >= 0.5 , text >= 1.2 , transformers-base >= 0.4.4 , vector >= 0.11- , yi-core >= 0.16.0+ , yi-core >= 0.17.0 , yi-language >= 0.16.0- , yi-rope >= 0.7+ , yi-rope >= 0.10 exposed-modules: Yi.Fuzzy other-modules:+ Data.List.PointedList.Extras Paths_yi_fuzzy_open default-language: Haskell2010