fcd (empty) → 1.0.0.0

raw patch · 6 files changed

+330/−0 lines, 6 filesdep +arraydep +basedep +directorysetup-changed

Dependencies added: array, base, directory, fcd, process, tasty, tasty-hunit, text, unix, vty, vty-ui

Files

• LICENSE +20/−0
• Setup.hs +2/−0
• fcd.cabal +41/−0
• src-exec/Main.hs +5/−0
• src/Fcd.hs +231/−0
• tests/Tests.hs +31/−0

@@ -0,0 +1,20 @@+Copyright (c) 2014 Benoît Faucon++Permission is hereby granted, free of charge, to any person obtaining+a copy of this software and associated documentation files (the+"Software"), to deal in the Software without restriction, including+without limitation the rights to use, copy, modify, merge, publish,+distribute, sublicense, and/or sell copies of the Software, and to+permit persons to whom the Software is furnished to do so, subject to+the following conditions:++The above copyright notice and this permission notice shall be included+in all copies or substantial portions of the Software.++THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,+EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF+MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.+IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY+CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT,+TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE+SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.

@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain

@@ -0,0 +1,41 @@+name:                fcd+version:             1.0.0.0+synopsis:            A faster way to navigate directories using the command line.+description:         Bookmark directories, then select a bookmark by fuzzy matching. You need to set up a small shell function for this to work properly (see the README).+license:             MIT+license-file:        LICENSE+author:              Benoît Faucon+maintainer:          faucon.benoit@cegetel.net+homepage:            https://github.com/Neki/fcd+category:            Utility+build-type:          Simple+cabal-version:       >=1.10+bug-reports:         https://github.com/Neki/fcd/issues++source-repository    head+  type: git+  location: git@github.com:Neki/fcd.git++executable fcd+  main-is:             Main.hs+  build-depends:       base, fcd+  hs-source-dirs:      src-exec+  default-language:    Haskell2010++library+  hs-source-dirs:      src+  default-language:    Haskell2010+  build-depends:       base >= 4.6 && < 5 , array, vty, vty-ui >= 1.7.1 && < 2, unix, directory, text, process >= 1.2.0.0+  exposed-modules:     Fcd+  other-modules:       Paths_fcd++test-suite test+  default-language:    Haskell2010+  type:                exitcode-stdio-1.0+  hs-source-dirs:      tests+  main-is:             Tests.hs+  build-depends:+    base >= 4.6 && < 5+    , tasty+    , tasty-hunit >= 0.9+    , fcd

@@ -0,0 +1,5 @@+module Main (main) where++import qualified Fcd+main :: IO ()+main = Fcd.run

@@ -0,0 +1,231 @@+module Fcd (+    run+  , lcs+  , sortCandidates+) where++import Control.Monad+import Control.Concurrent.MVar+import Data.Array+import Data.List+import qualified Data.Text as T+import qualified Data.Text.IO as T.IO+import System.Directory+import System.Posix.Signals+import System.Environment (getArgs)++import Graphics.Vty.Widgets.List+import Graphics.Vty.Widgets.Text+import Graphics.Vty.Widgets.Edit+import Graphics.Vty.Widgets.Box+import Graphics.Vty.Attributes+import Graphics.Vty.Widgets.Core+import Graphics.Vty.Widgets.EventLoop+import Graphics.Vty.LLInput++import Paths_fcd (version)+import Data.Version++data Command = Add | List | PrintVersion | Help | Select | Delete deriving (Eq, Show)+data Args = Args { command :: Command, name :: String, shortcut :: String, description :: String, execute :: [String] -> IO ()}++availableCommands :: [Args]+availableCommands = [ Args { command = Add, name = "add", shortcut = "a", description = "Add new bookmarks. If no additional parameter is provided, bookmark the current directory.", execute = addBookmarks }+                    , Args { command = List, name = "list", shortcut = "l", description = "List the available bookmarks.", execute = const listBookmarks}+                    , Args { command = PrintVersion, name = "version", shortcut = "v", description = "Print version number.", execute = const printVersion}+                    , Args { command = Help, name = "help", shortcut = "h", description = "Print this help.", execute = const printHelp}+                    , Args { command = Select, name = "select", shortcut = "s", description = "Select a bookmark. This is equivalent to calling fcd without arguments.", execute = selectBookmark }+                    , Args { command = Delete, name = "delete", shortcut = "d", description = "Delete a bookmark.", execute = deleteBookmark }+                    ]++-- |Main entry point for the program+run :: IO ()+run = do+  args <- getArgs+  let (cmdName:opts) = if null args then ["s"] else args+  case parseCommand cmdName of+    Nothing -> error $ "Unrecognized command: " ++ cmdName ++ ".\nAvailable commands are: " ++ commandList+    Just cmd -> execute cmd opts++-- |Given a command name or a short-hand version of a command name, returns the+-- corresponding command+parseCommand :: String -> Maybe Args+parseCommand cmd = find (\arg -> name arg == cmd || shortcut arg == cmd) availableCommands++-- |Add each path in the provided list to the bookmarks file.+addBookmarks :: [String] -> IO ()+addBookmarks [] = addBookmarks ["."]+addBookmarks xs = do+  allBookmarks <- readBookmarks+  mapM_ (addBookmark allBookmarks . T.pack) xs++-- |Print to stdout the list of bookmarks.+listBookmarks :: IO ()+listBookmarks = liftM (T.unpack . T.intercalate (T.pack "\n")) readBookmarks >>= putStrLn++-- |Print to stdout the version number.+printVersion :: IO ()+printVersion = putStrLn $ "fcd version " ++ showVersion version++-- |Print to stdout a short help about the program.+printHelp :: IO ()+printHelp = do+  printVersion+  putStrLn "Usage: fcd [select [PATH]] | fcd add [PATH1 [...]] | fcd delete [PATH] | fcd list | fcd help | ..."+  putStrLn ""+  putStrLn "Available commands:"+  forM_ availableCommands $ \cmd ->+    putStrLn $ name cmd ++ " (" ++ shortcut cmd ++ ") -- " ++ description cmd+  putStrLn ""+  putStrLn "Each command can be abbreviated to its first letter."+  putStrLn "When in prompt mode, use C-h and C-l to navigate the result list."++-- |Prompt the user to select a bookmark, then write the selected bookmark in+-- the bookmark file.+selectBookmark :: [String] -> IO ()+selectBookmark opts = displayPrompt (T.pack $ unwords opts) >>= writeResult++-- |Prompt the user to select a bookmark, then delete the selected bookmark from+-- the bookmark file.+deleteBookmark :: [String] -> IO ()+deleteBookmark opts = do+  toDelete <- displayPrompt $ T.pack $ unwords opts+  path <- bookmarkFile+  bookmarks <- liftM T.lines (T.IO.readFile path)+  let filtered = filter (/= toDelete) bookmarks+  T.IO.writeFile path $ T.concat $ map (flip T.append $ T.pack "\n") filtered++-- |Return the path to the bookmark file.+bookmarkFile :: IO String+bookmarkFile = fmap (++ "/.fcdbookmarks") getHomeDirectory++-- |Return the path to the result file.+resultFile :: IO String+resultFile = fmap (++ "/.fcdresult") getHomeDirectory++-- |Return the list of the available commands (list, add, etc.)+commandList :: String+commandList = intercalate ", " $ map name availableCommands++-- |Add a bookmark (a directory path) to the bookmark file.+-- If the bookmark already exists, then do nothing.+addBookmark :: [T.Text] -> T.Text -> IO ()+addBookmark allBookmarks bookmark = do+  path <- bookmarkFile+  bookmarkClean <- canonicalizePath $ T.unpack bookmark+  unless (T.pack bookmarkClean `elem` allBookmarks) $+    appendFile path (bookmarkClean ++ "\n")++-- |Prompt the user to select a bookmark. The given parameter is used to+-- prepopulate the prompt. Return the user selection.+displayPrompt :: T.Text -> IO T.Text+displayPrompt prefill = do+  result <- newMVar $ T.pack "."+  inputLine <- editWidget+  setEditText inputLine prefill++  candidates <- readBookmarks+  candidatesList <- newTextList def_attr [] 1+  box <- vBox inputLine candidatesList++  mainFocusGroup <- newFocusGroup+  mainFocusGroup `onKeyPressed` \_ key modifiers ->+    if key == KASCII 'c' && modifiers == [MCtrl] then+      raiseSignal sigINT >> return True+    else if key == KASCII 'd' && modifiers == [MCtrl] then+      raiseSignal sigKILL >> return True+    else if key == KASCII 'h' && modifiers == [MCtrl] then+      moveSelectionDown candidatesList >> return True+    else if key == KASCII 'l' && modifiers == [MCtrl] then+      moveSelectionUp candidatesList >> return True+    else return False++  _ <- addToFocusGroup mainFocusGroup box++  collection <- newCollection+  _ <- addToCollection collection box mainFocusGroup++  inputLine `onChange` \inputText -> updateCandidates inputText candidates candidatesList++  inputLine `onActivate` \_ -> do+    choice <- getSelected candidatesList+    let selection = case choice of+                  Nothing -> T.pack "."+                  Just (_pos, (entry, _) ) -> entry+    modifyMVar_ result (const $ return selection)+    shutdownUi++  updateCandidates prefill candidates candidatesList++  runUi collection defaultContext+  takeMVar result++moveSelectionDown :: Widget (List T.Text FormattedText) -> IO ()+moveSelectionDown listWidget = do+  selected <- getSelected listWidget+  case selected of+    Nothing -> return ()+    Just (pos, _) -> unless (pos == 0) (setSelected listWidget (pos - 1))++moveSelectionUp :: Widget (List T.Text FormattedText) -> IO ()+moveSelectionUp listWidget = do+  selected <- getSelected listWidget+  case selected of+    Nothing -> return ()+    Just (pos, _) -> setSelected listWidget (pos + 1) -- vty-ui takes care of not going out of bounds++-- |Update a list widget by sorting the candidates list according to a reference+updateCandidates :: T.Text                              -- a reference (user provided input)+                  -> [T.Text]                           -- a list of candidates+                  -> Widget (List T.Text FormattedText) -- the list widget to update+                  -> IO ()+updateCandidates inputText candidates candidatesList = do+  let sortedCandidates = sortCandidates (map T.unpack candidates) (T.unpack inputText)+      displayedCandidates = map T.pack sortedCandidates+  setCandidates displayedCandidates candidatesList++-- |Write the selected bookmark to the result file+writeResult :: T.Text -> IO ()+writeResult selection = resultFile >>= flip T.IO.writeFile selection++-- |Retrieve the bookmark list from disk+readBookmarks :: IO [T.Text]+readBookmarks = do+  path <- bookmarkFile+  exist <-  doesFileExist path+  if exist+  then liftM T.lines $ T.IO.readFile path+  else return []++setCandidates :: [T.Text] -> Widget (List T.Text FormattedText) -> IO ()+setCandidates candidates list = do+  clearList list+  forM_ candidates (\el -> addToList list el =<< plainText el)++-- |Compute the length of the longest common subsequence of two lists.+-- This is a simple implementation with memoization that uses quadratic space+-- (O(n*m) where n and m are the length of the inputs).+-- Note: a possible optimization would be to cache the memoized matrix as a lot+-- of it is still relevant when a new character is added.+lcs :: (Eq a) => [a] -> [a] -> Int+lcs xs ys = memoized ! (n,m)+  where memoized = array ((0,0),(n,m)) [((i,j), lcs' i j) | i <- [0..n], j <- [0..m] ]+        n = length xs+        m = length ys+        as = listArray (1, n) xs+        bs = listArray (1, m) ys+        lcs' _ 0 = 0+        lcs' 0 _ = 0+        lcs' u v = if as ! u == bs ! v+                   then memoized ! (u - 1, v - 1) + 1+                   else max (memoized ! (u - 1, v)) (memoized ! (u, v - 1))++sortCandidates :: (Eq a) => [[a]] -> [a] -> [[a]]+sortCandidates candidates reference = sortBy comparator candidates+  where comparator x y =+         let distRefToX = distance x reference+             distRefToY = distance y reference+             distance a b  = - lcs a b+         in compare distRefToX distRefToY++

@@ -0,0 +1,31 @@+module Main (main) where++import Test.Tasty+import Test.Tasty.HUnit++import Fcd++main :: IO ()+main = defaultMain tests++tests :: TestTree+tests = testGroup "Tests" [unitTests]++unitTests :: TestTree+unitTests = testGroup "Unit tests" [distanceTests]++distanceTests :: TestTree+distanceTests = testGroup "Longest common subsequence tests"+  [ testCase "Some LCS" $ do+      0 @=? lcs "" "42"+      0 @=? lcs "abc" "def"+      1 @=? lcs "ab" "b"+      1 @=? lcs "ab" "ba"+      4 @=? lcs "hello" "hullo"+      5 @=? lcs "my word" "their words"+      4 @=? lcs "abcdef" "acedf"+  , testCase "Sort candidates according to the distance to a reference" $+      ["abcd", "ab", "efg"] @=? sortCandidates ["ab", "abcd", "efg"] "abdc"+  ]++