summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorJaroReinders <>2017-10-09 20:53:00 (GMT)
committerhdiff <hdiff@hdiff.luite.com>2017-10-09 20:53:00 (GMT)
commit7e55c40bb1d5ef5ba18f415899822cd3875bf44e (patch)
treee8c8df633ce05495ffc8f103ff34d3b1d0065488
parentffa188a6b1fc16547f8a1b38a69502c004f09ead (diff)
version 0.17.00.17.0
-rw-r--r--src/Data/List/PointedList/Extras.hs30
-rw-r--r--src/Yi/Fuzzy.hs386
-rw-r--r--yi-fuzzy-open.cabal12
3 files changed, 234 insertions, 194 deletions
diff --git a/src/Data/List/PointedList/Extras.hs b/src/Data/List/PointedList/Extras.hs
new file mode 100644
index 0000000..0453a11
--- /dev/null
+++ b/src/Data/List/PointedList/Extras.hs
@@ -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
+
+
diff --git a/src/Yi/Fuzzy.hs b/src/Yi/Fuzzy.hs
index ef396ea..fd42865 100644
--- a/src/Yi/Fuzzy.hs
+++ b/src/Yi/Fuzzy.hs
@@ -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)
-
--- 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
-
--- | The depth 'fuzzyOpen' should traverse by default. Currently
--- __5__.
-defaultDepth :: Int
+ = FileItem !Text
+ | BufferItem !BufferId
+ deriving (Typeable)
+
+instance Show FuzzyItem where
+ show :: FuzzyItem -> String
+ show i = case i of
+ FileItem _ -> "File " <> itemAsStr i
+ BufferItem _ -> "Buffer " <> itemAsStr i
+
+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,133 +89,133 @@ fuzzyOpen = fuzzyOpenWithDepth defaultDepth
-- | 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)
-
--- shamelessly stolen from Chapter 9 of Real World Haskell
+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))
+
+ 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
-
- 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
+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)
+ ]
+
+ 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
-
-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)))
+ 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
+
+
+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
-
-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 }
+ prevState <- withCurrentBuffer getBufferDyn
+ let newState = f prevState
+ withCurrentBuffer (putBufferDyn newState)
+ renderE newState
+
+goNext :: FuzzyState -> FuzzyState
+goNext = changeIndex PL.next
+
+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,21 +228,24 @@ 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
+ 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 :: 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."
+ 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
diff --git a/yi-fuzzy-open.cabal b/yi-fuzzy-open.cabal
index 2eecdd7..acdb72e 100644
--- a/yi-fuzzy-open.cabal
+++ b/yi-fuzzy-open.cabal
@@ -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 @@ library
, 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