escoger (empty) → 0.1.0.0

raw patch · 11 files changed

+374/−0 lines, 11 filesdep +HUnitdep +basedep +bytestringsetup-changed

Dependencies added: HUnit, base, bytestring, criterion, escoger, mtl, test-framework, test-framework-hunit, unix, vector, vector-algorithms, vty

Files

• Benchmarks/Bench.hs +14/−0
• Exec/Main.hs +22/−0
• LICENSE +20/−0
• Lib/Escoger/Interactive.hs +87/−0
• Lib/Escoger/Internal.hs +23/−0
• Lib/Escoger/Matches.hs +61/−0
• Lib/Escoger/Utils.hs +20/−0
• Setup.hs +2/−0
• Tests/Test.hs +7/−0
• Tests/Unit/Matches.hs +30/−0
• escoger.cabal +88/−0

@@ -0,0 +1,14 @@+{-# LANGUAGE OverloadedStrings #-}++import Escoger.Matches+import Criterion.Main+import qualified Data.ByteString.Char8 as BC+import qualified Data.Vector as V++main :: IO ()+main = do+  content <- BC.readFile "Benchmarks/Random.txt"+  let content' = V.fromList $ BC.split '\n' content+  defaultMain [+      bench "sortByScore" $ nf (sortByScore "aeu") content'+    ]

@@ -0,0 +1,22 @@+{-# LANGUAGE OverloadedStrings #-}++import           Control.Monad.Reader+import           Control.Monad.State.Strict+import qualified Data.ByteString.Char8 as BC+import qualified Data.Vector as V+import           Escoger.Interactive+import           Escoger.Internal+import           Graphics.Vty+import           System.Posix.IO++main :: IO ()+main = do+  content <- BC.getContents+  let content' = (V.filter (not . BC.null) . V.fromList . BC.split '\n') content+  ifd <- openFd "/dev/tty" ReadOnly Nothing defaultFileFlags+  ofd <- openFd "/dev/tty" WriteOnly Nothing defaultFileFlags+  vty <- mkVty defaultConfig { inputFd = Just ifd, outputFd = Just ofd }+  selection <- flip evalStateT (SearchState content' "" 1) $+    flip runReaderT (SearchData content' vty) $+      interactiveLoop+  BC.putStrLn selection

@@ -0,0 +1,20 @@+The MIT License (MIT)++Copyright (c) 2014 Travis Staton++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,87 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE OverloadedLists #-}++module Escoger.Interactive (interactiveLoop) where++import           Control.Monad.Reader+import           Control.Monad.State.Strict+import           Data.ByteString (ByteString)+import qualified Data.ByteString as B+import qualified Data.ByteString.Char8 as BC+import           Data.Maybe (fromMaybe)+import qualified Data.Vector as V+import           Escoger.Internal+import           Escoger.Matches (sortByScore)+import           Escoger.Utils+import           Graphics.Vty+import           System.Exit (exitSuccess)++interactiveLoop :: SearchM ByteString+interactiveLoop = do+  render+  loop+  where+    loop :: SearchM ByteString+    loop = do+      vty <- asks _vty+      st <- get+      e <- liftIO $ nextEvent vty+      let result = handleKeyPress e st+      case result of+        Right selectionIndex -> do+          liftIO $ shutdown vty+          if selectionIndex > 0+          then do+            matches <- gets _matches+            return $ fromMaybe "" $ matches V.!? (selectionIndex - 1)+          else liftIO exitSuccess+        Left ss -> do+          updateMatches ss+          render+          loop++render :: SearchM ()+render = do+  vty <- asks _vty+  term <- gets _term+  index <- gets _index+  matches <- gets _matches+  let termLine = utf8Bytestring' defAttr $ mconcat ["> ", term]+      imatches = (V.map (formatMatch index) . V.zip [1..maxRows] . V.take maxRows) matches+      img = V.foldl' vertJoin termLine imatches+      pic = picForImage img+  liftIO $ update vty pic+  where+    formatMatch :: Index -> (Index,ByteString) -> Image+    formatMatch i (x,y) = if i == x+                            then utf8Bytestring' (defAttr `withBackColor` white `withForeColor` black) y+                            else utf8Bytestring' defAttr y++handleKeyPress :: Event -> SearchState -> Either SearchState Index+handleKeyPress e ss@(SearchState m t i) = do+  case e of+    (EvKey KBS []) -> Left $ ss { _term = safeInit t }+    (EvKey KDel []) -> Left $ ss { _term = safeInit t }+    (EvKey KUp []) -> Left $ ss { _index = safePred i }+    (EvKey KDown []) -> Left $ ss { _index = safeSucc' i }+    (EvKey KEnter []) -> Right i+    (EvKey (KChar 'p') [MCtrl]) -> Left $ ss { _index = safePred i }+    (EvKey (KChar 'n') [MCtrl]) -> Left $ ss { _index = safeSucc' i }+    (EvKey (KChar 'u') [MCtrl]) -> Left $ ss { _term = "" }+    (EvKey (KChar 'w') [MCtrl]) -> Left $ ss { _term = (BC.unwords . init . BC.words) t }+    (EvKey (KChar 'c') [MCtrl]) -> Right (-1)+    (EvKey (KChar c) []) -> Left $ ss { _index = 1, _term = BC.snoc t c }+    (EvKey KEsc []) -> Right (-1)+    _ -> Left ss+  where+    safeSucc' = safeSucc (V.length m)++updateMatches :: SearchState -> SearchM ()+updateMatches (SearchState _ t i) = do+  st <- get+  term <- gets _term+  if B.length t /= B.length term+    then do+      terms <- if BC.length term < BC.length t then gets _matches else asks _content+      put $ st { _index = i, _term = t, _matches = sortByScore t terms }+    else put $ st { _index = i }

@@ -0,0 +1,23 @@+module Escoger.Internal where++import Control.Monad.State.Strict+import Control.Monad.Reader+import Data.ByteString (ByteString)+import Data.Vector (Vector)+import Graphics.Vty (Vty)++data SearchState = SearchState { _matches :: Vector ByteString+                               , _term    :: ByteString+                               , _index   :: Int+                               } deriving (Show)++data SearchData = SearchData { _content :: Vector ByteString+                             , _vty     :: Vty+                             }++type SearchM a = ReaderT SearchData (StateT SearchState IO) a++type Index = Int++maxRows :: Int+maxRows = 100

@@ -0,0 +1,61 @@+module Escoger.Matches+( sortByScore+, score+, matchLength+, findEndOfMatch+) where++import           Control.Applicative+import           Data.ByteString (ByteString)+import qualified Data.ByteString as B+import qualified Data.ByteString.Char8 as BC+import           Data.Char (ord, chr)+import           Data.Maybe (mapMaybe)+import           Data.Ord (comparing)+import           Data.Vector (Vector)+import qualified Data.Vector as V+import qualified Data.Vector.Algorithms.Intro as VA+import           GHC.Unicode (isAsciiUpper)++sortByScore :: ByteString -> Vector ByteString -> Vector ByteString+sortByScore query choices = sortFilter choiceScores+  where+    sortFilter = V.map fst . V.modify (VA.sortBy $ comparing (negate . snd)) . V.filter (\(_,y) -> y /= 0)+    choiceScores = V.map (\x -> (x, score x query)) choices++score :: ByteString -> ByteString -> Double+score choice query+  | B.null query = 1+  | B.null choice = 0+  | otherwise = case matchLength c q of+    Nothing -> 0+    Just len -> let tmpScore = fromIntegral (B.length q) / fromIntegral len+                    choiceLength = fromIntegral $ B.length c+                in tmpScore / choiceLength+    where+      c = BC.map toAsciiLower choice+      q = BC.map toAsciiLower query++matchLength :: ByteString -> ByteString -> Maybe Int+matchLength choice query =+  if null matches then Nothing else Just $ minimum matches+  where+    matches :: [Int]+    matches = (filter (0<=) . mapMaybe findNorm) indices+    findNorm i = findEndOfMatch choice query i >>= normalize i+    normalize i m = return $ 1 + subtract i m+    indices :: [Int]+    indices = B.elemIndices (B.head query) choice++findEndOfMatch :: ByteString -> ByteString -> Int -> Maybe Int+findEndOfMatch choice query index =+  B.foldl' func (Just index) (B.tail query)+  where+    func m_lastIndex q = let findNextMatch i = B.findIndex (q ==) (B.drop (i+1) choice)+                             acc = ((+) <$> ((+1) <$> m_lastIndex) <*>)+                    in m_lastIndex >>= findNextMatch >>= acc . return++toAsciiLower :: Char -> Char+toAsciiLower c = if isAsciiUpper c+                   then chr (ord c + 32)+                   else c

@@ -0,0 +1,20 @@+{-# LANGUAGE OverloadedStrings #-}++module Escoger.Utils where++import Control.Applicative+import Data.ByteString (ByteString)+import qualified Data.ByteString.Char8 as BC+import Escoger.Internal (maxRows)++safeInit :: ByteString -> ByteString+safeInit "" = ""+safeInit bs = BC.init bs++safePred :: Int -> Int+safePred 1 = 1+safePred x = pred x++safeSucc :: Int -> Int -> Int+safeSucc x y = if c then y else succ y+  where c = or $ [(x==), (maxRows==)] <*> [y]

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

@@ -0,0 +1,7 @@+import Test.Framework (defaultMain)+import Unit.Matches++tests = [unit_matches]++main :: IO ()+main = defaultMain tests

@@ -0,0 +1,30 @@+{-# LANGUAGE OverloadedStrings #-}++module Unit.Matches (unit_matches) where++import qualified Data.Vector as V+import           Escoger.Matches+import           Test.Framework (defaultMain, testGroup)+import           Test.Framework.Providers.HUnit (testCase)+import           Test.HUnit++shorter_terms = assertEqual "favors shorter terms" correctOrder resultOrder+  where+    correctOrder = ["kite", "kitch", "kitten"]+    resultOrder = V.toList . sortByScore "kit" $ V.fromList ["kitten", "kitch", "kite"]++ordered_terms = assertEqual "ignores out of order terms" correctOrder resultOrder+  where+    correctOrder = ["ectwdaokxycaojxh"]+    resultOrder = V.toList . sortByScore "each" $ V.fromList ["aech", "ectwdaokxycaojxh"]++ignores_case = assertEqual "ignores case" correctOrder resultOrder+  where+    correctOrder = ["Each", "eachr"]+    resultOrder = V.toList . sortByScore "each" $ V.fromList ["eachr", "Each"]++unit_matches = testGroup "matches"+               [ testCase "favor shorter terms" shorter_terms+               , testCase "ignore out of order terms" ordered_terms+               , testCase "ignores case" ignores_case+               ]

@@ -0,0 +1,88 @@+name:                escoger+version:             0.1.0.0+license:             MIT+license-file:        LICENSE+author:              Travis Staton+maintainer:          hello@travisstaton.com+bug-reports:         https://github.com/tstat/escoger/issues+synopsis:            Terminal fuzzy selector+description:         Interactive fuzzy selector for the terminal. Escoger accepts+                     a newline separated input on stdin, and provides an interactive+                     prompt to select one of these lines to output to stdout.+category:            Tools+build-type:          Simple+cabal-version:       2.0++Source-Repository head+    Type: git+    Location: https://github.com/tstat/escoger++library escoger-lib+  exposed-modules:     Escoger.Interactive+                       Escoger.Internal+                       Escoger.Matches+                       Escoger.Utils++  build-depends:         base >= 4.6 && < 5.0+                       , vty  >= 5.19 && <= 5.20+                       , unix >= 2.7 && <= 2.8+                       , bytestring+                       , vector+                       , vector-algorithms+                       , mtl++  hs-source-dirs:      Lib+  default-language:    Haskell2010+  ghc-options:         -Wall+                       -O2++executable escoger+  main-is:             Main.hs+  hs-source-dirs:      Exec++  build-depends:       base >=4.6 && <= 5.0+                       , escoger-lib+                       , vty+                       , unix+                       , bytestring+                       , vector+                       , mtl++  default-language:    Haskell2010+  ghc-options:         -Wall+                       -threaded+                       -rtsopts+                       -with-rtsopts=-N++benchmark bench+  type:                exitcode-stdio-1.0+  hs-source-dirs:      Exec, Benchmarks+  main-is:             Bench.hs+  build-depends:       base+                       , escoger-lib+                       , vty+                       , unix+                       , bytestring+                       , vector++  build-depends:       criterion++  default-language:    Haskell2010+  ghc-options:         -Wall+                       -threaded+                       -rtsopts+                       -with-rtsopts=-N++test-suite tests+  type:                exitcode-stdio-1.0+  hs-source-dirs:      Exec, Tests+  main-is:             Test.hs+  other-modules:       Unit.Matches+  build-depends:         base+                       , escoger-lib+                       , vector+                       , HUnit+                       , test-framework+                       , test-framework-hunit++  default-language:    Haskell2010