talash 0.1.1.1 → 0.3.0

raw patch · 14 files changed

+809/−670 lines, 14 filesdep +bitvecdep +containersdep +extradep −introdep ~alfred-margaretdep ~brickdep ~bytestringPVP ok

version bump matches the API change (PVP)

Dependencies added: bitvec, containers, extra, io-streams, mtl, primitive, safe, vector-th-unbox

Dependencies removed: intro

Dependency ranges changed: alfred-margaret, brick, bytestring, directory, text, vty

API changes (from Hackage documentation)

Files

• CHANGELOG.md +7/−1
• app/Main.hs +4/−2
• src/Talash/Brick.hs +66/−165
• src/Talash/Brick/Columns.hs +54/−188
• src/Talash/Brick/Internal.hs +171/−19
• src/Talash/Chunked.hs +202/−0
• src/Talash/Core.hs +62/−85
• src/Talash/Files.hs +16/−16
• src/Talash/Internal.hs +0/−94
• src/Talash/Intro.hs +33/−0
• src/Talash/Piped.hs +52/−81
• src/Talash/ScoredMatch.hs +39/−0
• src/Talash/SimpleSearcher.hs +80/−0
• talash.cabal +23/−19

@@ -13,7 +13,13 @@ * FileTree is now a record. * Some internal changes to get it to build on somewhat older versions of ghc. Tested with 8.2.2  -## 0.1.1.1 -- 20121-06-06+## 0.1.1.1 -- 2021-06-06  * Removed the spurious dependency on containers. * Loosened some bounds on the packages.++## 0.3 -- 2022-09-25++* Use a new chunked interface which gives much better code sharing and improves performance too.+* Various internal refactors. +* A lot of documentation either outdated/doesn't exist as a result and needs to be revamped.

@@ -2,15 +2,17 @@  import qualified Talash.Brick as B import qualified Talash.Piped as P-import Intro+import qualified Talash.SimpleSearcher as S+import Prelude import System.Environment (getArgs)  run :: [String] -> IO () run ("piped":xs) = P.run' xs run ("tui"  :xs) = B.run' xs+run ["test"]     = S.simpleSearcherTest run  _           = putStrLn usageString -usageString :: Text+usageString :: String usageString =    "talash is the demo program for the talash library. It has two set of subcommand:\n"               <> "talash tui : for the terminal user interface, use 'talash tui help' for details.\n"               <> "talash piped : for the piped interface, use 'talash piped help' for details.\n"

@@ -4,88 +4,36 @@ -- return a single selection but more complicated actions can be performed by using the `_hooks` which allow abitrary IO actions (due to `EventM` being a `MonadIO`) -- in response to input events. The most convenient function to use the brick app are `selected` and related functions. `runApp` provides some more flexibility. module Talash.Brick (-- * Types-                     Searcher (..) , SearchEvent (..) , SearchEnv (..) , SearchFunctions (..) ,  EventHooks (..) , AppTheme (..) , AppSettings (..)+                     Searcher (..) , SearchEvent (..) , SearchEnv (..) ,  EventHooks (..) , AppTheme (..) , AppSettings (..) , AppSettingsG (..) , CaseSensitivity (..)                      -- * The Brick App and Helpers-                    , searchApp , defSettings , searchFunctionsFuzzy , searchFunctionsOL , runApp , runAppFromHandle-                    , selected , selectedFromHandle , selectedFromHandleWith , selectedFromFileNamesSorted , selectedFromFiles , runSearch+                    , searchApp , defSettings , fuzzyFunctions , orderlessFunctions , runApp , runAppFromHandle , selected , selectedFromHandle+                    , selectedFromHandleWith , selectedFromFileNamesSorted , selectedFromFiles , selectedUsing , runSearch , makeChunks                     -- * Default program                     , run , run'                      -- * Lenses                      -- ** Searcher-                    , query , prevQuery , allMatches , matches , numMatches , wait+                    , queryEditor , allMatches , matches , numMatches                      -- ** SearchEvent                     , matchedTop , totalMatches , term                      -- ** SearchEnv-                    , searchFunctions , candidates , eventSource+                    , candidates , eventSource                      -- ** SearchFunctions-                    , makeMatcher , lister , displayer+                    , makeMatcher , match , display                      -- ** AppTheme                     , prompt , themeAttrs , borderStyle                      -- ** SearchSettings-                    , theme , hooks+                    , theme , hooks , defTheme , defHooks                      -- * Exposed Internals-                    , makeQuery , haltQuit , handleKeyEvent , handleSearch , editStep , replaceSearch , search , searcherWidget , initialSearcher-                    , searchWithMatcher , readVectorStdIn , readVectorHandle , readVectorHandleWith , emptyIndices) where+                    , handleKeyEvent , handleSearch , searcherWidget , initialSearcher , readVectorHandleWith)+where -import Control.Concurrent(forkIO , killThread, ThreadId)-import Data.IORef (IORef , newIORef , atomicModifyIORef' , atomicWriteIORef)-import qualified Data.Text as T-import Data.Vector (Vector , (!), force , generate , take, singleton , convert, enumFromN, unfoldr, unfoldrM , uniq , modify, concat)-import qualified Data.Vector.Unboxed as U-import qualified Data.Vector.Unboxed.Sized as S+import Data.Monoid.Colorful as C+import Data.Vector (unsafeIndex , elemIndex) import GHC.Compact (Compact , compact , getCompact)-import Intro hiding (sort, on,replicate , take , modify)-import System.Environment (getArgs)+import qualified System.IO.Streams as I import Talash.Brick.Internal-import Talash.Core hiding (makeMatcher) import Talash.Files-import Talash.Internal-import Data.Monoid.Colorful as C--data Searcher a = Searcher { -- | The editor to get the query from.-                             _query :: Editor Text Bool-                           -- | The last query which is saved to check if we should only search among the matches for it or all the candidates.-                           , _prevQuery :: Maybe Text-                           -- | An IORef containing the indices of the filtered candidates. These are in an IORef to make it easier to deal with them in a different thread-                           --   than the UI of the app. Maybe it should be moved to `SearchEnv`-                           , _allMatches :: IORef (U.Vector Int)-                           -- | The matches received split up as alternating sequences of match substrings and the gap between them. The first substring is always a gap-                           --   and can be empty, the rest should be no empty.-                           , _matches :: List Bool [Text]-                           -- | The (maximum possible) number of matches. This is the length of vector stored in `_allMatches` which also contains the indices of-                           --   which weren't matched in case enough matches were found before going through all the candidates.-                           , _numMatches :: Int-                           -- | ThreadId of the thread currently computing matches. Nothing if there is no such thread.-                           , _wait :: Maybe ThreadId-                           -- | Unused by default but can be used store extra state needed for any extension to the functionality. For example to have multiple-                           --   selections this can be set to a `Vector` that stores them.-                           , _extension :: a} deriving (Functor)-makeLenses ''Searcher--data SearchEvent = SearchEvent {-                     -- | The matches received.-                     _matchedTop :: Vector [Text] ,-                     -- | The (maximum possible) number of matches. See the note on `_numMatches`.-                     _totalMatches :: Int ,-                     -- | The term which was searched for.-                     _term :: Maybe Text}-makeLenses ''SearchEvent---- | The constant environment in which the search app runs.-data SearchEnv a = SearchEnv { _searchFunctions :: SearchFunctions a  -- ^ The functions used to find and display matches.-                             , _candidates :: Vector Text -- ^ The vector of candidates.-                             , _eventSource :: BChan SearchEvent -- ^ The BChan from which the app receives search events.-                             }-makeLenses ''SearchEnv---- | Event hooks are almost direct translations of the events from vty i.e. see `Event`.-data EventHooks a = EventHooks { keyHook :: Key -> [Modifier] -> a -> EventM Bool (Next a)-                               , pasteHook :: ByteString -> a -> EventM Bool (Next a)-                               , resizeHook :: Int -> Int -> a -> EventM Bool (Next a)-                               , mouseDownHook :: Int -> Int -> Button -> [Modifier] -> a -> EventM Bool (Next a)-                               , mouseUpHook   :: Int -> Int -> Maybe Button -> a -> EventM Bool (Next a)-                               , focusLostHook :: a -> EventM Bool (Next a)-                               , focusGainedHook :: a -> EventM Bool (Next a)}+import Talash.Intro hiding (sort, on , take)  data AppTheme = AppTheme { _prompt :: Text -- ^ The prompt to display next to the editor.                          , _themeAttrs :: [(AttrName, Attr)]  -- ^ This is used to construct the `attrMap` for the app. By default the used attarNmaes are@@ -94,138 +42,91 @@                          } makeLenses ''AppTheme -data AppSettings a b = AppSettings { _theme :: AppTheme-                                 , _hooks :: ReaderT (SearchEnv a) EventHooks (Searcher b) -- ^ The event hooks which can make use of the search environment.-                                 }-makeLenses ''AppSettings--defHooks :: EventHooks a-defHooks = EventHooks (const . const continue) (const continue) (const . const continue) (const . const . const . const continue)-                                (const . const . const continue) continue continue--- This is a comment--- | Get the current query from the editor of the searcher.-makeQuery :: Searcher a -> Maybe Text-makeQuery s = headMay . getEditContents $ s ^. query---- | Quit without any selection.-haltQuit :: Searcher a -> EventM n (Next (Searcher a))-haltQuit = halt . ((matches . listSelectedL) .~ Nothing)---- | Handling of keypresses. The default bindings are---  @Enter@ exits the app with the current selection.---  @Esc@ exits without any selection---  @Up@ , @Down@ , @PageUp@ and @PageDown@ move through the matches.--- All others keys are used for editing the query. See `handleEditorEvent` for details.-handleKeyEvent :: SearchEnv a -> Key -> [Modifier] -> Searcher b -> EventM Bool (Next (Searcher b))-handleKeyEvent e@(SearchEnv fs v b) k m s-  | k == KEnter                                  , null m = halt s-  | k == KEsc                                    , null m = haltQuit s-  | k `elem` [KUp , KDown , KPageUp , KPageDown] , null m = continue =<< handleEventLensed s matches handleListEvent (EvKey k m)-  | otherwise                                             = continue =<< liftIO . editStep e =<< handleEventLensed s query handleEditorEvent (EvKey k m)---- | Handle a search event by updating `_numMatches` , `_matches` and `_wait`.-handleSearch :: Vector Text -> Searcher a -> SearchEvent -> EventM Bool (Next (Searcher a))-handleSearch v s e = continue . (numMatches .~ e ^. totalMatches) . (matches %~ listReplace (e ^. matchedTop) Nothing) . (wait .~ Nothing) $ s+type AppSettings n a = AppSettingsG n a (Widget Bool) AppTheme  -- | The brick widget used to display the editor and the search result.-searcherWidget :: Text -> Text -> Searcher a -> Widget Bool-searcherWidget p n s = joinBorders . border $    searchWidgetAux True p (s ^. query) (withAttr "Stats" . txt $ show (s ^. numMatches) <>  "/" <> n)-                                             <=> hBorder  <=> joinBorders (listWithHighlights "➜ " id False (s ^. matches))---- | Handle the editing of the query by starting the computation of the matches in a new thread and storing the `ThreadId` in `_wait`.--- If the new query contains the last query then doesn't try to match the candidates that didn't match the last query, otherwise search among all the candidates.--- Might be possible to make the performance better by storing the indices of the filtered candidates for more than one previous query.-editStep :: SearchEnv a -> Searcher b -> IO (Searcher b)-editStep e@(SearchEnv f v b) s-  | makeQuery s == (s ^. prevQuery)      = pure s-  | otherwise                            = (\w -> set wait (Just w) s') <$> replaceSearch isBigger e s'-  where-    isBigger = fromMaybe False $ T.isInfixOf <$> (s ^. prevQuery) <*> (headMay . getEditContents $ s ^. query)-    s'       = set prevQuery (makeQuery s) s---- | The functions for generating a search event.  It is executed in a separate thread via `forkIO` in `replaceSearch`.-search :: forall a. SearchFunctions a -> Vector Text -> Maybe Text -> IORef (U.Vector Int) -> IO SearchEvent-search fs v t r = (\(l , tm) -> SearchEvent tm l t)  <$> atomicModifyIORef' r (searchWithMatcher fs v t)---- | This function dispatches the computation of matches to a new thread and returns the new threadId. It also tries to kill the thread in which a previous computation---   was going on (Not sure if it actually accomplishes that, my understanding of exceptions is not good enough).-replaceSearch :: Bool -- ^ If True then search among all matches by writing a vector of all the indices into `_allMatches`. If False use `_allMatches` as is.-                        -> SearchEnv a -> Searcher b -> IO ThreadId-replaceSearch ib (SearchEnv fs v b) s = finally (forkIO . catch wrtev $ \ (_ :: AsyncException) -> pure ()) (maybe (pure ()) killThread (s ^. wait))-  where-    wrtev = writeBChan b =<< search fs v (s ^. prevQuery) =<< mtchs-    mtchs = if ib then pure $ s ^. allMatches else atomicWriteIORef (s ^. allMatches) (U.enumFromN 0 $ length v) $> (s ^. allMatches)+searcherWidget :: (KnownNat n , KnownNat m) => SearchEnv n a (Widget Bool) -> Text -> SearcherSized m a -> Widget Bool+searcherWidget env p s = joinBorders . border $ vBox [searchWidgetAux True p (s ^. queryEditor) (withAttr (attrName "Stats") . txt  $ pack (show $ s ^. numMatches))+                                                     , hBorder , listWithHighlights env "➜ " (s ^. matcher) False (s ^. matches)]  defThemeAttrs :: [(AttrName, Attr)]-defThemeAttrs = [ (listSelectedAttr, withStyle (bg white) bold) , ("Prompt" , withStyle (white `on` blue) bold)-           , ("Highlight" , withStyle (fg blue) bold) ,  ("Stats" , fg blue) ,  (borderAttr , fg cyan)]+defThemeAttrs = [ (listSelectedAttr, withStyle (bg white) bold) , (attrName "Prompt" , withStyle (white `on` blue) bold)+                , (attrName "Highlight" , withStyle (fg blue) bold) ,  (attrName "Stats" , fg blue) ,  (borderAttr , fg cyan)]  defTheme ::AppTheme defTheme = AppTheme {_prompt = "Find: " , _themeAttrs = defThemeAttrs , _borderStyle = unicodeRounded}  -- | Default settings. Uses blue for various highlights and cyan for borders. All the hooks except keyHook which is `handleKeyEvent` are trivial.-defSettings :: AppSettings a b-defSettings = AppSettings defTheme (ReaderT (\e -> defHooks {keyHook = handleKeyEvent e}))+{-# INLINE defSettings#-}+defSettings :: KnownNat n => AppSettings n a+defSettings = AppSettings defTheme (ReaderT (\e -> defHooks {keyHook = handleKeyEvent e})) Proxy 4096+                          (\r -> r ^. ocassion == QueryDone)  -- | Tha app itself. `selected` and the related functions are probably more convenient for embedding into a larger program.-searchApp :: AppSettings a b -> SearchEnv a -> App (Searcher b) SearchEvent Bool-searchApp (AppSettings th hks) env@(SearchEnv _ v _) = App {appDraw = ad , appChooseCursor = showFirstCursor , appHandleEvent = he , appStartEvent = pure , appAttrMap = am}+searchApp ::KnownNat n => AppSettings n a -> SearchEnv n a (Widget Bool) -> App (Searcher a) (SearchEvent a) Bool+searchApp (AppSettings th hks _ _ _) env  = App {appDraw = ad , appChooseCursor = showFirstCursor , appHandleEvent = he , appStartEvent = as , appAttrMap = am}   where-    ad                                    = (:[]) . withBorderStyle (th ^. borderStyle) . searcherWidget (th ^. prompt) (show . length $ v)-    am                                    = const $ attrMap defAttr (th ^. themeAttrs)-    hk                                    = runReaderT hks env-    he s (VtyEvent (EvKey k m))           = keyHook hk k m s-    he s (VtyEvent (EvMouseDown i j b m)) = mouseDownHook   hk i j b m s-    he s (VtyEvent (EvMouseUp   i j b  )) = mouseUpHook     hk i j b   s-    he s (VtyEvent (EvPaste     b      )) = pasteHook       hk     b   s-    he s (VtyEvent  EvGainedFocus       ) = focusGainedHook hk         s-    he s (VtyEvent  EvLostFocus         ) = focusLostHook   hk         s-    he s (AppEvent e)                     = if e ^. term == s ^. prevQuery then handleSearch v s e else continue s-    he s _                                = continue s---- | The initial state of the searcher. The editor is empty, the first @512@ elements of the vector are disaplyed as matches.-initialSearcher :: a -> Vector Text -> IORef (U.Vector Int) -> Searcher a-initialSearcher e v r = Searcher { _query = editorText True (Just 1) "" , _prevQuery = Nothing , _wait = Nothing-                               , _matches = list False ((:[]) <$> take 512 v) 0, _allMatches = r , _numMatches = length v , _extension =  e}+    ad (Searcher s)                                  = (:[]) . withBorderStyle (th ^. borderStyle) . searcherWidget env (th ^. prompt) $ s+    as                                               = liftIO (sendQuery env "")+    am                                               = const $ attrMap defAttr (th ^. themeAttrs)+    hk                                               = runReaderT hks env+    he (VtyEvent (EvKey k m))                      = keyHook hk k m+    he (VtyEvent (EvMouseDown i j b m))            = mouseDownHook   hk i j b m+    he (VtyEvent (EvMouseUp   i j b  ))            = mouseUpHook     hk i j b+    he (VtyEvent (EvPaste     b      ))            = pasteHook       hk     b+    he (VtyEvent  EvGainedFocus       )            = focusGainedHook hk+    he (VtyEvent  EvLostFocus         )            = focusLostHook   hk+    he (AppEvent e@(SearchEvent e'))               = handleSearch e+    he _                                           = pure ()  -- | Run app with given settings and return the final Searcher state.-runApp :: b -> AppSettings a b -> SearchFunctions a -> Vector Text -> IO (Searcher b)-runApp e s f v = (\b -> theMain (searchApp s (SearchEnv f v b)) b . initialSearcher e v =<< newIORef (U.enumFromN 0 . length $ v)) =<< newBChan 8+runApp :: KnownNat n => AppSettings n a -> SearchFunctions a (Widget Bool) -> Chunks n -> IO (Searcher a)+runApp s f c =     (\b -> (\env -> startSearcher env *> finally (theMain (searchApp s env) b . Searcher . initialSearcher env $ b) (stopSearcher env))+               =<< searchEnv f (s ^. maximumMatches) (generateSearchEvent (s ^. eventStrategy) b) c) =<< newBChan 8  -- | Run app with a vector that contains lines read from a handle and return the final Searcher state.-runAppFromHandle :: b -> AppSettings a b -> SearchFunctions a  -> Handle -> IO (Searcher b)-runAppFromHandle e s f = runApp e s f . getCompact <=< compact . force <=< readVectorHandle+runAppFromHandle :: KnownNat n => AppSettings n a -> SearchFunctions a (Widget Bool) -> Handle -> IO (Searcher a)+runAppFromHandle s f = runApp s f . getCompact <=< compact . forceChunks <=< chunksFromHandle (s ^. chunkSize) +-- | Run app with a vector that contains lines read from a handle and return the final Searcher state.+runAppFromVector :: KnownNat n =>  AppSettings n a -> SearchFunctions a (Widget Bool) -> Vector Text -> IO (Searcher a)+runAppFromVector s f = runApp s f . getCompact <=< compact . forceChunks . makeChunks+ -- | Run app and return the text of the selection if there is one else Nothing.-selected :: AppSettings a () -> SearchFunctions a -> Vector Text -> IO (Maybe Text)-selected s f  = map (map (mconcat . snd) . listSelectedElement . (^. matches)) . runApp () s f . getCompact <=< compact . force+selected :: KnownNat n => AppSettings n a -> SearchFunctions a (Widget Bool) -> Chunks n -> IO (Maybe Text)+selected s f = (\c -> map (selectedElement c) . runApp s f $ c) . getCompact <=< compact . forceChunks  -- | Same as `selected` but reads the vector from the supplied handle.-selectedFromHandle :: AppSettings a () -> SearchFunctions a -> Handle -> IO (Maybe Text)-selectedFromHandle s f = selected s f <=< readVectorHandle+selectedFromHandle :: KnownNat n => AppSettings n a -> SearchFunctions a (Widget Bool) -> Handle -> IO (Maybe Text)+selectedFromHandle s f = selected s f <=< chunksFromHandle (s ^. chunkSize)  -- | Same as `selectedFromHandle` but allows for transforming the lines read and the final vector with supplied functions. See also `readVectorHandleWith`.-selectedFromHandleWith :: (Text -> Text) -> (Vector Text -> Vector Text) -> AppSettings a () -> SearchFunctions a -> Handle -> IO (Maybe Text)-selectedFromHandleWith w t s f = selected s f <=< readVectorHandleWith w t+selectedFromHandleWith :: KnownNat n => (Text -> Text) -> (Vector Text -> Vector Text) -> AppSettings n a -> SearchFunctions a (Widget Bool) -> Handle -> IO (Maybe Text)+selectedFromHandleWith w t s f = selected s f . makeChunks <=< readVectorHandleWith w t  -- | Another variation on `selectedFromHandle`. See `fileNamesSorted` for what happens to read vector.-selectedFromFileNamesSorted :: AppSettings a () -> SearchFunctions a -> Handle -> IO (Maybe Text)-selectedFromFileNamesSorted s f = selected s f <=< fileNamesSorted+selectedFromFileNamesSorted :: KnownNat n => AppSettings n a -> SearchFunctions a (Widget Bool) -> Handle -> IO (Maybe Text)+selectedFromFileNamesSorted s f = selected s f .  makeChunks <=< fileNamesSorted  -- | Version of `selected` for file search using a simple implementation of searching file trees from "Talash.Files". Better to use either other -- libraries like @unix-recursive@ or external programs like @fd@ for more complicated tasks.-selectedFromFiles ::  AppSettings a () -> SearchFunctions a -> [FindInDirs] -> IO (Maybe Text)-selectedFromFiles s f = selected s f . (flatten =<<) <=< findFilesInDirs+selectedFromFiles :: KnownNat n => AppSettings n a -> SearchFunctions a (Widget Bool) -> [FindInDirs] -> IO (Maybe Text)+selectedFromFiles s f = selected s f . forceChunks . makeChunks . (flatten =<<) <=< findFilesInDirs +selectedUsing :: KnownNat n => AppSettings n a -> SearchFunctions a (Widget Bool) -> (a -> Text) -> Vector a -> IO (Maybe a)+selectedUsing s f t v = map (map (unsafeIndex v) . (`elemIndex` w) =<<) . selected s f . makeChunks $ w+  where+    w = map t v+ -- | A version of `selected` that puts the selected text on the stdout.-runSearch :: AppSettings a () -> SearchFunctions a -> IO ()-runSearch s f = maybe (pure ()) putStrLn =<< selected s f =<< readVectorStdIn+runSearch :: AppSettings 64 a -> SearchFunctions a (Widget Bool) -> IO ()+runSearch s f = maybe (pure ()) putStrLn =<< selected s f =<< chunksFromStream =<< I.decodeUtf8 =<< I.lines I.stdin  -- | The backend for `run` run' :: [String] -> IO ()-run' []                 = runSearch defSettings searchFunctionsOL-run' ["fuzzy"]          = runSearch defSettings searchFunctionsFuzzy-run' ["orderless"]      = runSearch defSettings searchFunctionsOL+run' []                 = runSearch defSettings (orderlessFunctions IgnoreCase)+run' ["fuzzy"]          = runSearch defSettings (fuzzyFunctions IgnoreCase)+run' ["orderless"]      = runSearch defSettings (orderlessFunctions IgnoreCase) run' xs                 = (\t -> C.printColored putStr t usageString) =<< C.getTerm  usageString :: Colored Text

@@ -11,93 +11,30 @@ -- length. Otherwise this module provides a reduced version of the functions in "Talash.Brick".  -- This module hasn't been tested on large data and will likely be slow.-module Talash.Brick.Columns (-- * Types-                     Searcher (..) , SearchEvent (..) , SearchEnv (..) , SearchFunctions (..) ,  EventHooks (..) , AppTheme (..) , AppSettings (..)+module Talash.Brick.Columns (-- -- * Types+                      Searcher (..) , SearchEvent (..) , SearchEnv (..) ,  EventHooks (..) , AppTheme (..)+                    , AppSettings (..) , AppSettingsG (..) , SearchFunctions , CaseSensitivity (..)                      -- * The Brick App and Helpers-                    , searchApp , defSettings , searchFunctionsFuzzy , searchFunctionsOL , selected , selectedIndex , runApp+                    , searchApp , defSettings , selected , selectedIndex , runApp                      -- * Lenses                      -- ** Searcher-                    , query , prevQuery , allMatches , matches , numMatches , wait+                    , query , prevQuery , allMatches , matches , numMatches                      -- ** SearchEvent                     , matchedTop , totalMatches , term                      -- ** SearchEnv                     , searchFunctions , candidates , eventSource-                     -- ** SearchFunctions-                    , makeMatcher , lister , displayer                      -- ** AppTheme                     , prompt , themeAttrs , borderStyle                      -- ** SearchSettings                     , theme , hooks                      -- * Exposed Internals-                    , makeQuery , haltQuit , handleKeyEvent , handleSearch , editStep , replaceSearch , search , searcherWidget , initialSearcher-                    , searchWithMatcher , partsColumns , emptyIndices , runApp' , selected' , selectedIndex' ) where+                    , handleKeyEvent , handleSearch , searcherWidget , initialSearcher , partsColumns , runApp' , selected' , selectedIndex') where -import Control.Concurrent(forkIO , killThread, ThreadId)-import Control.Exception (finally , catch, AsyncException)-import Data.IORef (IORef , newIORef , atomicModifyIORef' , atomicWriteIORef) import qualified Data.Text as T-import Data.Text.AhoCorasick.Automaton (CaseSensitivity (..))-import qualified Data.Text.IO as T-import Data.Vector (Vector , (!), force , generate , take, singleton , convert, enumFromN, unfoldrM, indexed  , elemIndex)-import qualified Data.Vector.Unboxed as U-import qualified Data.Vector.Unboxed.Sized as S+import Data.Vector (elemIndex) import GHC.Compact (Compact , compact , getCompact)-import GHC.TypeNats-import Intro hiding (on ,replicate , take)-import System.Environment (getArgs)-import System.IO ( Handle , hIsEOF , isEOF, hClose, stdin) import Talash.Brick.Internal-import Talash.Core hiding (makeMatcher)--data SearchFunctions a = SearchFunctions { _makeMatcher :: Text -> Maybe (Matcher a)-                                         , _displayer :: forall n. KnownNat n => MatcherSized n a -> Text -> S.Vector n Int -> [[Text]]-                                         , _lister :: forall n. KnownNat n => MatcherSized n a -> Vector Text -> U.Vector Int -> (U.Vector Int , U.Vector (Indices n))}-makeLenses ''SearchFunctions--data Searcher a = Searcher { -- | The editor to get the query from.-                           _query :: Editor Text Bool-                           -- | The last query which is saved to check if we should only search among the matches for it or all the candidates.-                           , _prevQuery :: Maybe Text-                           -- | An IORef containing the indices of the filtered candidates. These are in an IORef to make it easier to deal with them in a different thread-                           --   than the UI of the app. Maybe it should be moved to `SearchEnv`-                           , _allMatches :: IORef (U.Vector Int)-                           -- | Each outer list reprsents a column. The inner list is the text for that column split up as an alternating sequences of match-                           --   substrings and the gap between them. The first substring is always a gap and can be empty, the rest should be no empty.-                           , _matches :: List Bool [[Text]]-                           -- | The (maximum possible) number of matches. This is the length of vector stored in `_allMatches` which also contains the indices of-                           --   which weren't matched in case enough matches were found before going through all the candidates.-                           , _numMatches :: Int-                           -- | ThreadId of the thread currently computing matches. Nothing if there is no such thread.-                           , _wait :: Maybe ThreadId-                           -- | Unused by default but can be used store extra state needed for any extension to the functionality. For example to have multiple-                           --   selections this can be set to a `Vector` that stores them.-                           , _extension :: a} deriving Functor-makeLenses ''Searcher--data SearchEvent = SearchEvent {-                     -- | The matches received.-                     _matchedTop :: Vector [[Text]] ,-                     -- | The (maximum possible) number of matches. See the note on `_numMatches`.-                     _totalMatches :: Int ,-                     -- | The term which was searched for.-                     _term :: Maybe Text}-makeLenses ''SearchEvent---- | The constant environment in which they search app runs.-data SearchEnv a = SearchEnv { _searchFunctions :: SearchFunctions a  -- ^ The functions used to find and display matches.-                             , _candidates :: Vector Text -- ^ The vector of candidates.-                             , _eventSource :: BChan SearchEvent -- ^ The BChan from which the app receives search events.-                             }-makeLenses ''SearchEnv---- | Event hooks are almost direct translations of the events from vty i.e. see `Event`.-data EventHooks a = EventHooks { keyHook :: Key -> [Modifier] -> a -> EventM Bool (Next a)-                               , pasteHook :: ByteString -> a -> EventM Bool (Next a)-                               , resizeHook :: Int -> Int -> a -> EventM Bool (Next a)-                               , mouseDownHook :: Int -> Int -> Button -> [Modifier] -> a -> EventM Bool (Next a)-                               , mouseUpHook   :: Int -> Int -> Maybe Button -> a -> EventM Bool (Next a)-                               , focusLostHook :: a -> EventM Bool (Next a)-                               , focusGainedHook :: a -> EventM Bool (Next a)}+import Talash.Intro hiding (on ,replicate , take)  data AppTheme = AppTheme { _prompt :: Text -- ^ The prompt to display next to the editor.                          , _columnAttrs :: [AttrName] -- ^ The attrNames to use for each column. Must have the same length or greater length than the number of columns.@@ -110,120 +47,45 @@                          } makeLenses ''AppTheme -data AppSettings a b = AppSettings { _theme :: AppTheme-                                 , _hooks :: ReaderT (SearchEnv a) EventHooks (Searcher b) -- ^ The event hooks which can make use of the search environment.-                                 }-makeLenses ''AppSettings--defHooks :: EventHooks a-defHooks = EventHooks (const . const continue) (const continue) (const . const continue) (const . const . const . const continue)-                                (const . const . const continue) continue continue--emptyIndices :: Int -> U.Vector  (Indices 0)-emptyIndices n = U.generate n ( , S.empty)---- | Get the current query from the editor of the searcher.-makeQuery :: Searcher a -> Maybe Text-makeQuery s = headMay . getEditContents $ s ^. query---- | Handling of keypresses. The default bindings are---  @Enter@ exits the app with the current selection.---  @Esc@ exits without any selection---  @Up@ , @Down@ , @PageUp@ and @PageDown@ move through the matches.--- All others keys are used for editing the query. See `handleEditorEvent` for details.-handleKeyEvent :: SearchEnv a ->  Key -> [Modifier] -> Searcher b -> EventM Bool (Next (Searcher b))-handleKeyEvent env k m s-  | k == KEnter                                && null m = halt s-  | k == KEsc                                  && null m = haltQuit s-  | elem k [KUp , KDown , KPageUp , KPageDown] && null m = continue =<< handleEventLensed s matches handleListEvent (EvKey  k m)-  | otherwise                                            = continue =<< liftIO . editStep env =<< handleEventLensed s query handleEditorEvent (EvKey k m)+type AppSettings n a = AppSettingsG n a Text AppTheme --- | Handle a search event by updating `_numMatches` , `_matches` and `_wait`.-handleSearch :: Vector Text -> Searcher a ->  SearchEvent -> EventM Bool (Next (Searcher a))-handleSearch v s e = continue . (numMatches .~ e ^. totalMatches) . (matches %~ listReplace (e ^. matchedTop) Nothing) . (wait .~ Nothing) $ s+data ColumnsIso a = ColumnsIso { _toColumns :: a -> [Text] , _fromColumns :: [Text] -> a}+makeLenses ''ColumnsIso  -- | The brick widget used to display the editor and the search result.-searcherWidget :: [AttrName] -> [Int] -> Text -> Text -> Searcher a -> Widget Bool-searcherWidget as ls p n s = joinBorders . border $    searchWidgetAux True p (s ^. query) (withAttr "Stats" . txt $ show (s ^. numMatches) <>  "/" <> n)-                                             <=> hBorder  <=> joinBorders (columnsListWithHighlights "➜ " id as ls False (s ^. matches))---- | Quit without any selection.-haltQuit :: Searcher a -> EventM n (Next (Searcher a))-haltQuit = halt . ((matches . listSelectedL) .~ Nothing)---- | Handle the editing of the query by starting the computation of the matches in a new thread and storing the `ThreadId` in `_wait`.--- If the new query contains the last query then doesn't try to match the candidates that didn't match the last query, otherwise search among all the candidates.--- Might be possible to make the performance better by storing the indices of the filtered candidates for more than one previous query.-editStep :: SearchEnv a -> Searcher b -> IO (Searcher b)-editStep env s-  | makeQuery s == (s ^. prevQuery)      = pure s-  | otherwise                            = (\w -> set wait (Just w) s') <$> replaceSearch isBigger env s'-  where-    isBigger = fromMaybe False $ T.isInfixOf <$> (s ^. prevQuery) <*> (headMay . getEditContents $ s ^. query)-    s'       = set prevQuery (makeQuery s) s---- | The functions for generating a search event.  It is executed in a separate thread via `forkIO` in `replaceSearch`.-search :: SearchFunctions a -> Vector Text -> Maybe Text -> IORef (U.Vector Int) -> IO SearchEvent-search fs v t r = (\(l , tm) -> SearchEvent tm l t)  <$> atomicModifyIORef' r (searchWithMatcher fs v t)---- | searchWithMatcher carries out one step of the search. Note that the search can stops before going through the whole vector of text. In that case the returned---   vector of indices should contain not only the indices matched candidates but also the indices of candidates that weren't tested for a match.-searchWithMatcher :: SearchFunctions a -> Vector Text -> Maybe Text -> U.Vector  Int -> (U.Vector Int , (Int , Vector [[Text]]))-searchWithMatcher fs v t s = maybe nc go ((fs ^. makeMatcher) =<< t)-      where-        nc  = (U.enumFromN 0 (length v) , (0 , force . map (\i -> map (:[]) . T.lines $ v ! (i ^. _1)) . convert . emptyIndices . min 512 . length $ v))-        go (Matcher  f') = (iv , (U.length iv , force . map (\i -> (fs ^. displayer) f' (v ! (i ^. _1)) (i ^. _2)) . convert $ mv))-          where-            (iv , mv) = (fs ^. lister) f' v s---- | This function dispatches the computation of matches to a new thread and returns the new threadId. It also tries to kill the thread in which a previous computation---   was going on (Not sure if it actually accomplishes that, my understanding of exceptions is not good enough).-replaceSearch :: Bool -> SearchEnv a -> Searcher b -> IO ThreadId-replaceSearch ib (SearchEnv fs v b) s = finally (forkIO . catch wrtev $ \ (_ :: AsyncException) -> pure ()) (maybe (pure ()) killThread (s ^. wait))-  where-    wrtev = writeBChan b =<< search fs v (s ^. prevQuery) =<< mtchs-    mtchs = if ib then pure $ s ^. allMatches else atomicWriteIORef (s ^. allMatches) (U.enumFromN 0 $ length v) $> (s ^. allMatches)+searcherWidget :: (KnownNat n , KnownNat m) => AppTheme -> SearchEnv n a Text -> SearcherSized m a -> Widget Bool+searcherWidget t env s = joinBorders . border $    searchWidgetAux True (t ^. prompt) (s ^. queryEditor) (withAttr (attrName "Stats") . txt $ (T.pack . show $ s ^. numMatches))+                                        <=> hBorder  <=> joinBorders (makeColumns env "➜ " (t ^. columnAttrs) (t ^. columnLimits) (s ^. matcher) False (s ^. matches))  defThemeAttrs :: [(AttrName, Attr)]-defThemeAttrs = [ (listSelectedAttr, withStyle (bg white) bold) , ("Prompt" , withStyle (white `on` blue) bold)-           , ("Highlight" , withStyle (fg blue) bold) ,  ("Stats" , fg blue) ,  (borderAttr , fg cyan)]+defThemeAttrs = [ (listSelectedAttr, withStyle (bg white) bold) , (attrName "Prompt" , withStyle (white `on` blue) bold)+           , (attrName "Highlight" , withStyle (fg blue) bold) ,  (attrName "Stats" , fg blue) ,  (borderAttr , fg cyan)]  defTheme ::AppTheme defTheme = AppTheme {_prompt = "Find: " , _columnAttrs = repeat mempty , _columnLimits = repeat 50 , _themeAttrs = defThemeAttrs                     , _borderStyle = unicodeRounded}  -- | Default settings. Uses blue for various highlights and cyan for borders. All the hooks except keyHook which is `handleKeyEvent` are trivial.-defSettings :: AppSettings a b-defSettings = AppSettings defTheme (ReaderT (\e -> defHooks {keyHook = handleKeyEvent e}))+{-# INLINE defSettings#-}+defSettings :: KnownNat n => AppSettings n a+defSettings = AppSettings defTheme (ReaderT (\e -> defHooks {keyHook = handleKeyEvent e})) Proxy 1024 (\r -> r ^. ocassion == QueryDone)  -- | Tha app itself.  `selected` and the related functions are probably more convenient for embedding into a larger program.-searchApp :: AppSettings a b -> SearchEnv a -> App (Searcher b) SearchEvent Bool-searchApp (AppSettings th hks) env@(SearchEnv fs v b) = App {appDraw = ad , appChooseCursor = showFirstCursor , appHandleEvent = he , appStartEvent = pure , appAttrMap = am}+searchApp :: KnownNat n => AppSettings n a -> SearchEnv n a Text -> App (Searcher a) (SearchEvent a) Bool+searchApp (AppSettings th hks _ _ _) env  = App {appDraw = ad , appChooseCursor = showFirstCursor , appHandleEvent = he , appStartEvent = as , appAttrMap = am}   where-    ad                = (:[]) . withBorderStyle (th ^. borderStyle) . searcherWidget (th ^. columnAttrs) (th ^. columnLimits) (th ^. prompt) (show . length $ v)-    am                                    = const $ attrMap defAttr (th ^. themeAttrs)-    hk                                    = runReaderT hks env-    he s (VtyEvent (EvKey k m))           = keyHook hk k m s-    he s (VtyEvent (EvMouseDown i j b m)) = mouseDownHook   hk i j b m s-    he s (VtyEvent (EvMouseUp   i j b  )) = mouseUpHook     hk i j b   s-    he s (VtyEvent (EvPaste     b      )) = pasteHook       hk     b   s-    he s (VtyEvent  EvGainedFocus       ) = focusGainedHook hk         s-    he s (VtyEvent  EvLostFocus         ) = focusLostHook   hk         s-    he s (AppEvent e)                     = if e ^. term == s ^. prevQuery then handleSearch v s e else continue s-    he s _                                = continue s---- | The initial state of the searcher.-initialSearcher :: a -> Vector Text -> IORef (U.Vector Int) -> Searcher a-initialSearcher e v r = Searcher { _query = editorText True (Just 1) "" , _prevQuery = Nothing , _wait = Nothing-                               , _matches = list False (map (:[]) . T.lines <$> take 512 v) 0, _allMatches = r , _numMatches = length v , _extension = e}---- | Search functions suitable for fuzzy matching. The candidate @c@ will match the query @s@ if @c@ contains all the characters in @s@ in order. In general there---   can be several ways of matching. This tries to find a match with minimum number of parts of. It does not find the minimum number of parts, if that requires---   reducing the extent of the partial match during search. E.g. matching @"as"@ against @"talash"@ the split will be @["tal","as","h"]@ and not---   @["t","a","la","s","h"]@. While matching @"talash best match testing hat"@ against @"tea"@ will not result in @["talash best match ","te","sting h","a","t"]@ since---   @"te"@ occurs only after we have match all three letters and we can't know if we will find the @"a"@ without going through the string.-searchFunctionsFuzzy :: SearchFunctions MatchPart-searchFunctionsFuzzy = SearchFunctions (fuzzyMatcher IgnoreCase) (\m t -> partsColumns . parts (S.fromSized <$> sizes m) t . S.fromSized) (searchSome (fuzzySettings 512))+    ad (Searcher s)                                  = (:[]) . withBorderStyle (th ^. borderStyle) . searcherWidget th env $ s+    as                                               = liftIO (sendQuery env "")+    am                                               = const $ attrMap defAttr (th ^. themeAttrs)+    hk                                               = runReaderT hks env+    he (VtyEvent (EvKey k m))                      = keyHook hk k m+    he (VtyEvent (EvMouseDown i j b m))            = mouseDownHook   hk i j b m+    he (VtyEvent (EvMouseUp   i j b  ))            = mouseUpHook     hk i j b+    he (VtyEvent (EvPaste     b      ))            = pasteHook       hk     b+    he (VtyEvent  EvGainedFocus       )            = focusGainedHook hk+    he (VtyEvent  EvLostFocus         )            = focusLostHook   hk+    he (AppEvent e)                                = handleSearch e+    he _                                           = pure ()  -- | This function reconstructs the columns from the parts returned by the search by finding the newlines. partsColumns :: [Text] -> [[Text]]@@ -235,32 +97,36 @@         s'      = tailDef [] s         hs      = maybe ([] , Nothing) (bimap (:[]) (T.stripPrefix "\n") . T.breakOn "\n") . headMay $ s --- | Search functions that match the words in i.e. space separated substring in any order. "talash best" will match "be as" with the split---   ["tal","as","h","be","st"] but "talash best" will not match "bet".-searchFunctionsOL :: SearchFunctions Int-searchFunctionsOL = SearchFunctions (orderlessMatcher IgnoreCase) (\m t -> partsColumns . partsOrderless (S.fromSized <$> sizes m) t . S.fromSized)-                                        (searchSome (orderlessSettings 512))+makeColumns :: (Ord n , Show n , KnownNat m , KnownNat l) => SearchEnv l a Text -> Text -> [AttrName] -> [Int]+                                                         -> MatcherSized m a -> Bool -> GenericList n MatchSetG (ScoredMatchSized m) -> Widget n+makeColumns env c as ls m = renderList (columnsWithHighlights c mp as ls)+  where+    mp s = partsColumns $ (env ^. searchFunctions . display) (const id) m ((env ^. candidates) ! chunkIndex s) (matchData s)  -- | The \'raw\' version of `runApp` taking a vector of text with columns separated by newlines.-runApp' :: b -> AppSettings a b -> SearchFunctions a -> Vector Text -> IO (Searcher b)-runApp' e s f v = (\b -> theMain (searchApp s (SearchEnv f v b)) b . initialSearcher e v =<< newIORef (U.enumFromN 0 . length $ v)) =<< newBChan 8+runApp' :: KnownNat n => AppSettings n a -> SearchFunctions a Text -> Chunks n -> IO (Searcher a)+runApp' s f c =     (\b -> (\env -> startSearcher env *> finally (theMain (searchApp s env) b . Searcher . initialSearcher env $ b) (stopSearcher env))+                 =<< searchEnv f (s ^. maximumMatches) (generateSearchEvent (s ^. eventStrategy) b) c) =<< newBChan 8 --- | Run app with given settings and return the final Searcher state.-runApp :: b -> AppSettings a b -> SearchFunctions a -> Vector [Text] -> IO (Searcher b)-runApp e s f = runApp' e s f . map T.unlines+-- -- | Run app with given settings and return the final Searcher state.+runApp :: KnownNat n => AppSettings n a  -> SearchFunctions a  Text -> Vector [Text] -> IO (Searcher a)+runApp s f = runApp' s f . makeChunks . map T.unlines  -- | The \'raw\' version of `selected` taking a vector of text with columns separated by newlines.-selected' :: AppSettings a () -> SearchFunctions a -> Vector Text -> IO (Maybe [Text])-selected' s f  = map (map (map mconcat . snd) . listSelectedElement . (^. matches)) . runApp' () s f . getCompact <=< compact . force+selected' :: KnownNat n => AppSettings n a -> SearchFunctions a Text -> Chunks n -> IO (Maybe [Text])+selected' s f = (\c -> map (map T.lines . selectedElement c) . runApp' s f $ c) . getCompact <=< compact . forceChunks  -- | Run app and return the the selection if there is one else Nothing.-selected :: AppSettings a () -> SearchFunctions a -> Vector [Text] -> IO (Maybe [Text])-selected s f  = selected' s f . map T.unlines+selected :: KnownNat n => AppSettings n a -> SearchFunctions a Text -> Vector [Text] -> IO (Maybe [Text])+selected s f  = selected' s f . makeChunks . map T.unlines +selectedIso :: KnownNat n => ColumnsIso a -> AppSettings n b -> SearchFunctions b Text -> Vector a -> IO (Maybe a)+selectedIso (ColumnsIso from to) s f = map (map to) . selected' s f . makeChunks . map (T.unlines . from)+ -- | The \'raw\' version of `selectedIndex` taking a vector of text with columns separated by newlines.-selectedIndex' :: AppSettings a () -> SearchFunctions a -> Vector Text -> IO (Maybe Int)-selectedIndex' s f v = ((`elemIndex` v) . T.unlines =<<) <$> selected' s f v+selectedIndex' :: KnownNat n => AppSettings n a -> SearchFunctions a Text -> Vector Text -> IO (Maybe Int)+selectedIndex' s f v = ((`elemIndex` v) . T.unlines =<<) <$> selected' s f (makeChunks v)  -- | Returns the index of selected candidate in the vector of candidates. Note: it uses `elemIndex` which is O\(N\).-selectedIndex :: AppSettings a () -> SearchFunctions a -> Vector [Text] -> IO (Maybe Int)+selectedIndex :: KnownNat n => AppSettings n a -> SearchFunctions a Text -> Vector [Text] -> IO (Maybe Int) selectedIndex s f = selectedIndex' s f . map T.unlines

@@ -1,25 +1,98 @@-module Talash.Brick.Internal (twoColumnText , columns , searchWidget , searchWidgetAux , headingAndBody , listWithHighlights , columnsListWithHighlights-                ,  theMain , module Export) where+{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE ExistentialQuantification #-} +module Talash.Brick.Internal (twoColumnText , columns , searchWidget , searchWidgetAux , headingAndBody , listWithHighlights , columnsWithHighlights+                             , MatchSetG (..) , Searcher (..) , SearchEvent (..) , SearchEnv (..) ,  EventHooks (..) , AppSettingsG (..)+                             , SearchEventSized (..) , SearcherSized (..)+                             , queryEditor , matches , matcher , numMatches , eventSource , theme , hooks , chunkSize , maximumMatches , eventStrategy+                             , matchedTop , totMatches , term , getQuery , defHooks , theMain , initialSearcher , generateSearchEvent+                             , handleKeyEvent , handleSearch , selectedElement , renderList , module Export) where+ import Brick as Export import Brick.BChan as Export (BChan , newBChan , writeBChan)-import Brick.Markup as Export (Markup , (@?) , markup, GetAttr) import Brick.Widgets.Border as Export (border, vBorder, hBorder, borderAttr) import Brick.Widgets.Border.Style as Export import Brick.Widgets.Center as Export (vCenter, center) import Brick.Widgets.Edit  as Export (editor , editorText, renderEditor, Editor, handleEditorEvent, getEditContents, applyEdit )-import Brick.Widgets.List as Export (List, list ,handleListEvent, handleListEventVi, listAttr, listSelectedAttr, listSelectedElement , listSelectedL-                                    ,listReplace , renderListWithIndex, renderList , listElements, GenericList (listElements, listSelected))-import Data.Text.Markup as Export (toText)+import Brick.Widgets.List as Export (Splittable (..) , List, list ,handleListEvent, handleListEventVi, listAttr, listSelectedAttr, listSelectedElement , listSelectedL+                                    , listReplace , listElements, GenericList (listElements, listSelected) , listMoveUp , listMoveDown , slice)+import qualified Brick.Widgets.List as L+import qualified Data.Set as DS+import qualified Data.Text as T+import qualified Data.Vector.Unboxed as U+import qualified Data.Vector.Unboxed.Sized as S import Graphics.Vty as Export (defAttr, cyan, white, blue, withStyle, bold, brightMagenta, black, magenta, brightBlue, Attr, defaultConfig, mkVty, green, standardIOConfig)-import Graphics.Vty.Config (Config(inputFd))-import Graphics.Vty.Input.Events as Export -import Intro-import Lens.Micro as Export (ASetter' , over, set, (^.) , _1 , _2 , _3 , (.~) , (?~) , (%~))+import qualified Graphics.Vty as V+import Graphics.Vty.Config (inputFd)+import Graphics.Vty.Input.Events as Export+import Lens.Micro (_head , (^?)) import Lens.Micro.TH as Export ( makeLenses ) import System.Posix.IO import System.Posix.Terminal+import Talash.Chunked as Export+import Talash.Intro +newtype MatchSetG a = MatchSetG (DS.Set a) deriving Foldable++instance Splittable MatchSetG where+  splitAt n (MatchSetG s) = (MatchSetG p , MatchSetG q)+    where+      (p,q) = DS.splitAt n s++data SearchEventSized n a = SearchEventSized  { _matcherEv :: {-# UNPACK #-} !(MatcherSized n a)+                                                -- | The (maximum possible) number of matches. See the note on `_numMatches`.+                                              , _totMatches :: {-# UNPACK #-} !Int+                                              -- | The term which was searched for.+                                              , _term :: {-# UNPACK #-} !Text+                                              , -- | The matches received.+                                                _matchedTop :: !(MatchSetSized n)}+makeLenses ''SearchEventSized++data SearchEvent a = forall n. KnownNat n => SearchEvent (SearchEventSized n a)++data SearcherSized n a = SearcherSized { -- | The editor to get the query from.+                                         _queryEditor :: Editor Text Bool+                                       , _matches :: GenericList Bool MatchSetG (ScoredMatchSized n)+                                       , _matcher :: MatcherSized n a+                                       , _numMatches :: Int+                                       , _eventSource :: BChan (SearchEvent a) -- ^ The BChan from which the app receives search events.+                                       }+makeLenses ''SearcherSized++data Searcher a = forall n. KnownNat n => Searcher {getSearcher :: SearcherSized n a}++{-# INLINE generateSearchEvent #-}+generateSearchEvent :: forall m a b c. KnownNat m => (SearchReport -> Bool) -> BChan (SearchEvent a) -> c -> SearchReport -> MatcherSized m a -> MatchSetSized m -> IO ()+generateSearchEvent p b _ = go+  where+    go r m = when (p r) . writeBChan b . SearchEvent . SearchEventSized m (r ^. nummatches) (r ^. searchedTerm)++-- | Event hooks are almost direct translations of the events from vty i.e. see `Event`.+data EventHooks a = EventHooks { keyHook :: Key -> [Modifier] -> EventM Bool a ()+                               , pasteHook :: ByteString -> EventM Bool a ()+                               , resizeHook :: Int -> Int -> EventM Bool a ()+                               , mouseDownHook :: Int -> Int -> Button -> [Modifier] -> EventM Bool a ()+                               , mouseUpHook   :: Int -> Int -> Maybe Button -> EventM Bool a ()+                               , focusLostHook :: EventM Bool a ()+                               , focusGainedHook :: EventM Bool a ()}++data AppSettingsG (n :: Nat) a b t   =   AppSettings { _theme :: t+                                                     , _hooks :: ReaderT (SearchEnv n a b) EventHooks (Searcher a) -- ^ The event hooks which can make use of the search environment.+                                                     , _chunkSize :: Proxy n+                                                     , _maximumMatches :: Int+                                                     , _eventStrategy :: SearchReport -> Bool}+makeLenses ''AppSettingsG++defHooks :: EventHooks a+defHooks = EventHooks (const . const (pure ())) (const (pure ())) (const . const (pure ())) (const . const . const . const (pure ()))+                                (const . const . const (pure ())) (pure ()) (pure ())++getQuery :: SearcherSized n a -> Text+getQuery s = fromMaybe "" . listToMaybe . getEditContents $ s ^. queryEditor+ twoColumnText :: Int -> Text -> Text -> Widget n twoColumnText n t1 t2 =  joinBorders . vLimit 1 $ go n t1 <+> go 100 t2   where@@ -29,24 +102,103 @@ columns f as ls = vLimit 1 . hBox . zipWith3 (\a l t -> hLimitPercent l $ (padRight (Pad 2) . withAttr a . f $ t) <+> fill ' ') as ls  searchWidget :: (Ord n , Show n) => Bool -> Text -> Editor Text n -> Widget n-searchWidget b p e = withAttr "Prompt" (padLeftRight 2 . txt $ p) <+> padLeftRight 2 (renderEditor (hBox . map txt) b e)+searchWidget b p e = hBox [withAttr (attrName "Prompt") (padLeftRight 2 . txt $ p) , padLeftRight 2 (renderEditor (hBox . map txt) b e)]  searchWidgetAux :: (Ord n , Show n) => Bool -> Text -> Editor Text n -> Widget n -> Widget n-searchWidgetAux b p e w = withAttr "Prompt" (padLeftRight 2 . txt $ p) <+> padLeftRight 2 (renderEditor (hBox . map txt) b e) <+> w+searchWidgetAux b p e w = hBox [withAttr (attrName "Prompt") (padLeftRight 2 . txt $ p) , padLeftRight 2 (renderEditor (hBox . map txt) b e) , w] -highlightAlternate :: Foldable f => (a -> Widget n) -> f a -> Widget n-highlightAlternate f = fst . foldl' (\(!w , !b) !n  -> (w <+> if b then withAttr "Highlight" (f n) else f n , not b)) (emptyWidget , False)+highlightAlternate :: (a -> Widget n) -> [a] -> Widget n+highlightAlternate f = hBox . zipWith (\b e -> if b then withAttr (attrName "Highlight") (f e) else f e) (cycle [False , True])  headingAndBody :: Text -> Text -> Widget n-headingAndBody h b = withAttr "Heading" (txt h) <=> txtWrap b+headingAndBody h b = withAttr (attrName "Heading") (txt h) <=> txtWrap b -listWithHighlights :: (Foldable f , Ord n , Show n) => Text -> (a -> f Text) -> Bool -> List n a -> Widget n-listWithHighlights c f = renderList (\s e -> vLimit 1 . (txt (if s then c else "  ") <+>) . (<+> fill ' ') . highlightAlternate txt . f $! e)+listWithHighlights :: (Ord n , Show n , KnownNat m , KnownNat l) => SearchEnv l a (Widget n) -> Text+                                                        -> MatcherSized m a -> Bool -> GenericList n MatchSetG (ScoredMatchSized m) -> Widget n+listWithHighlights env c m = renderList (\s e -> hBox [txtLine (if s then c else "  ") , hBox . go $! e])+  where+    go (ScoredMatchSized _ i v) = (env ^. searchFunctions . display) (\b e -> if b then withAttr (attrName "Highlight") (txtLine e) else txtLine e) m ((env ^. candidates) ! i) v -columnsListWithHighlights :: (Foldable f , Ord n , Show n) => Text -> (a -> [f Text]) -> [AttrName] -> [Int] -> Bool -> List n a -> Widget n-columnsListWithHighlights c f as ls = renderList (\s e -> (txt (if s then c else "  ") <+>) . columns (highlightAlternate txt) as ls . f $! e)+columnsWithHighlights :: Text -> (a -> [[Text]]) -> [AttrName] -> [Int] -> Bool -> a -> Widget n+columnsWithHighlights c f as ls s e = (txt (if s then c else "  ") <+>) . columns (highlightAlternate txt) as ls . f $! e  theMain :: Ord n => App b e n -> BChan e -> b -> IO b theMain a b s = (\v -> customMain v (pure v) (Just b) a s) =<< mkVty =<<(\c -> (\fd -> c {inputFd = Just fd}) <$> termFd) =<< standardIOConfig   where     termFd = (\f -> openFd f ReadOnly Nothing (OpenFileFlags False False False False False)) =<< getControllingTerminalName++drawListElements :: (Ord n, Show n, Foldable t, Splittable t) => (Int -> Bool -> a -> Widget n) -> Bool -> GenericList n t a  -> Widget n+drawListElements drawElem foc l =+    Widget Greedy Greedy $ do+        c <- getContext+        let es = slice start (numPerHeight * 2) (l^. L.listElementsL)+            idx = fromMaybe 0 (l^. L.listSelectedL)+            start = max 0 $ idx - numPerHeight + 1+            numPerHeight = 1 + (c^.availHeightL - 1) `div` (l^. L.listItemHeightL)+            off = start * (l^. L.listItemHeightL)+            drawElement j e =+                let isSelected = Just j == l^.listSelectedL+                    elemWidget = drawElem j isSelected e+                    selItemAttr = withDefAttr listSelectedAttr+                    makeVisible = if isSelected+                                  then visible . selItemAttr+                                  else id+                in makeVisible elemWidget+        render $ viewport (l^. L.listNameL) Vertical $+                 translateBy (Location (0, off)) $ vBox . zipWith drawElement [start ..] . toList $ es++selectedElementInternal :: (Foldable t, Splittable t) => GenericList n t a -> Maybe (Int, a)+selectedElementInternal l = do+    sel <- l^.listSelectedL+    let (_, xs) = L.splitAt sel (l ^. L.listElementsL)+    (sel,) <$> toList xs ^? _head++{-# INLINE renderListWithIndex #-}+renderListWithIndex :: (Ord n, Show n, Foldable t, Splittable t) => (Int -> Bool -> a -> Widget n) -> Bool -> GenericList n t a -> Widget n+renderListWithIndex drawElem foc = withDefAttr listAttr . drawListElements drawElem foc++renderList :: (Foldable t, Splittable t, Ord n, Show n) => (Bool -> e -> Widget n) -> Bool -> GenericList n t e -> Widget n+renderList drawElem = renderListWithIndex $ const drawElem++handleQuery :: KnownNat n => SearchEnv n a c -> Key -> [Modifier] -> Searcher b -> EventM Bool (Searcher b) ()+handleQuery env k m (Searcher s) = put . Searcher =<< editStep =<< (nestEventM' s . zoom queryEditor . handleEditorEvent . VtyEvent $ EvKey k m)+  where+    editStep ns = sendStep (getQuery ns) $> ns+    sendStep nq = unless (nq == getQuery s) $ liftIO (sendQuery env nq)++-- | Handling of keypresses. The default bindings are+--  @Enter@ exits the app with the current selection.+--  @Esc@ exits without any selection+--  @Up@ , @Down@ , @PageUp@ and @PageDown@ move through the matches.+-- All others keys are used for editing the query. See `handleEditorEvent` for details.+{-# INLINE handleKeyEvent #-}+handleKeyEvent :: (KnownNat n) => SearchEnv n a c -> Key -> [Modifier] -> EventM Bool (Searcher b) ()+handleKeyEvent env k m+  | k == KEnter                                  , null m = halt+  | k == KEsc                                    , null m = modify (\(Searcher s) -> Searcher . ((matches . listSelectedL) .~ Nothing) $ s) >> halt+  | k == KChar '\t'                              , null m = modify (\(Searcher s) -> Searcher . over matches listMoveDown $ s)+  | k == KBackTab                                , null m = modify (\(Searcher s) -> Searcher . over matches listMoveUp $ s)+  | k `elem` [KUp , KDown , KPageUp , KPageDown] , null m = (\(Searcher s) -> put . Searcher =<< (nestEventM' s . zoom matches . handleListEvent $ EvKey k m)) =<< get+  | otherwise                                             = handleQuery env k m =<< get++-- | The initial state of the searcher. The editor is empty.+initialSearcher :: SearchEnv n a c -> BChan (SearchEvent a) -> SearcherSized 0 a+initialSearcher env = SearcherSized (editorText True (Just 1) "") (list False (MatchSetG DS.empty) 0) emptyMatcher 0++{-# INLINE  handleSearchSized #-}+handleSearchSized :: (KnownNat n , KnownNat m) => SearcherSized n a -> SearchEventSized m a -> SearcherSized m a+handleSearchSized s e = SearcherSized (s ^. queryEditor) (list False (MatchSetG (e ^. matchedTop)) 0)+                                      (e ^. matcherEv) (e ^. totMatches) (s ^. eventSource)++{-# INLINE  handleSearch #-}+handleSearch :: SearchEvent a -> EventM Bool (Searcher a) ()+handleSearch (SearchEvent e) = modify (\(Searcher s) -> if (e ^. term == getQuery s) then Searcher (handleSearchSized s e) else Searcher s)++selectedElement :: KnownNat n => Chunks n -> Searcher a -> Maybe Text+selectedElement c (Searcher s) = (map ((c !) . chunkIndex . snd) . selectedElementInternal . (^. matches)) s++txtLine :: Text -> Widget n+txtLine s =+    Widget Fixed Fixed $ do+      c <- getContext+      return $ (imageL .~ (V.text' (c^.attrL) s)) emptyResult

@@ -0,0 +1,202 @@+-- |+{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE RankNTypes #-}+{-# LANGUAGE ExistentialQuantification #-}+{-# LANGUAGE TypeFamilies #-}++module Talash.Chunked (module Talash.Chunked , module Export) where++import Control.Concurrent (forkIO)+import Control.Concurrent.MVar+import Data.Bit+import qualified Data.Set as DS+import qualified Data.Text as T+import Data.Text.AhoCorasick.Automaton as Export (CaseSensitivity(..))+import qualified Data.Vector as V+import Data.Vector.Algorithms.Intro (sort)+import qualified Data.Vector.Mutable as MV+import qualified Data.Vector.Sized as SV+import qualified Data.Vector.Unboxed as U+import qualified Data.Vector.Unboxed.Mutable as M+import qualified Data.Vector.Unboxed.Mutable.Sized as MS+import qualified Data.Vector.Unboxed.Sized as S+import Lens.Micro.TH (makeLenses)+import qualified System.IO.Streams as I+import Talash.Core as Export hiding (match , makeMatcher)+import Talash.Intro hiding (splitAt)+import Talash.ScoredMatch as Export++newtype Chunks (n:: Nat) = Chunks { chunks ::  V.Vector (SV.Vector n Text)} deriving (Eq , Ord , Show)+type MatchSetSized n = DS.Set (ScoredMatchSized n)++data Ocassion = ChunkSearched | QueryDone | NewQuery | SearchDone deriving (Eq , Ord , Show)++data SearchStateSized (n :: Nat) a = SearchStateSized { _currentQuery :: {-# UNPACK #-} !Text+                                                      , _prevQuery :: {-# UNPACK #-} !Text+                                                      , _chunkNumber :: {-# UNPACK #-} !Int+                                                      , _totalMatches :: {-# UNPACK #-} !Int+                                                      , _newMatches ::  !Bool+                                                      , _done :: !Bool+                                                      , _matchSet :: !(MatchSetSized n)}+makeLenses ''SearchStateSized++data SearchFunctions a b = SearchFunctions { _makeMatcher :: Text -> Matcher a+                                           , _match :: forall n. KnownNat n => MatcherSized n a -> Text -> Maybe (MatchFull n)+                           -- | Given the matcher @m@, the matched string @t@ and the indices of matches in @t@ divide @t@ in alternating strings that are a matches+                           --   and the gap between these matches. The first of these is always a gap and can be empty. The rest should be non empty.+                                           , _display :: forall n. KnownNat n => (Bool -> Text -> b) -> MatcherSized n a -> Text -> S.Vector n Int -> [b] }+makeLenses ''SearchFunctions++data SearchReport = SearchReport { _ocassion :: Ocassion , _hasNewMatches :: Bool , _nummatches :: Int , _searchedTerm :: Text}+makeLenses ''SearchReport++-- | The constant environment in which the search runs.+data SearchEnv n a b = SearchEnv { _searchFunctions :: SearchFunctions a b  -- ^ The functions used to find and display matches.+                                 , _send :: forall n m. (KnownNat n , KnownNat m) => Chunks n -> SearchReport -> MatcherSized m a -> MatchSetSized m -> IO ()+                                 , _maxMatches :: Int+                                 , _candidates :: Chunks n+                                 , _query :: MVar (Maybe Text)+                                 , _allMatches :: M.IOVector (S.Vector n Bit) }+makeLenses ''SearchEnv++{-# INLINABLE (!) #-}+(!) :: KnownNat n => Chunks n -> ChunkIndex -> Text+(!) (Chunks v) (ChunkIndex i j) = V.unsafeIndex (SV.fromSized $ V.unsafeIndex v i) j++{-# INLINE getChunk #-}+getChunk :: Int -> Chunks n -> SV.Vector n Text+getChunk i (Chunks f) = V.unsafeIndex f i++{-# INLINE matchChunk #-}+matchChunk :: forall n m a. (KnownNat n , KnownNat m) => (MatcherSized n a -> Text -> Maybe (MatchFull n)) -> MatcherSized n a -> Int -> SV.Vector m Text+  -> S.Vector m Bit -> (S.Vector m Bit , MatchSetSized n)+matchChunk fun m ci v i = runST $ matchChunkM fun m ci v i++{-# INLINEABLE matchChunkM #-}+matchChunkM :: forall n m a s. (KnownNat n , KnownNat m) => (MatcherSized n a -> Text -> Maybe (MatchFull n)) -> MatcherSized n a -> Int -> SV.Vector m Text+  -> S.Vector m Bit -> ST s (S.Vector m Bit , MatchSetSized n)+matchChunkM fun m = go+  where+    go ci v i = doMatching =<< MS.replicate (Bit False)+      where+        nzero = natVal (Proxy :: Proxy n) == 0+        doMatching mbv = freezeAndDone =<< U.ifoldM' collectAndWrite DS.empty (S.fromSized i)+          where+            umbv = MS.fromSized mbv+            freezeAndDone mset = ( , mset) <$> S.unsafeFreeze mbv+            collectAndWrite x _ (Bit False) = pure x+            collectAndWrite x j (Bit True)+              | Nothing   <- res   = pure x+              | Just mtch <- res   = unsafeFlipBit umbv j $> DS.insert (conv mtch) x+              where+                res+                  | nzero      = if SV.unsafeIndex v j == "" then Nothing else fun m . SV.unsafeIndex v $ j+                  | otherwise  = fun m . SV.unsafeIndex v $ j+                conv (MatchFull k w) = ScoredMatchSized (Down k) (ChunkIndex ci j) w++{-# INLINABLE resetMatches #-}+resetMatches :: forall n m a b. KnownNat n => SearchEnv n a b -> SearchStateSized m a -> IO ()+resetMatches env state+  | T.isInfixOf (state ^. prevQuery) (state ^. currentQuery) = pure ()+  | otherwise                                                = M.set (env ^. allMatches) (S.replicate 1)++{-# INLINABLE  searchNextChunk #-}+searchNextChunk :: (KnownNat n , KnownNat m) => SearchEnv n a b -> MatcherSized m a -> SearchStateSized m a -> IO (SearchStateSized m a)+searchNextChunk env matcher state = nextstate . getMatches =<< M.read (env ^. allMatches) i+  where+    i          = state ^. chunkNumber+    getMatches = matchChunk (env ^. searchFunctions . match) matcher i (getChunk i (env ^. candidates))+    nextstate (js , mtchs) = M.write (env ^. allMatches) i js $> (over chunkNumber (+ 1) . updateAndSend . mergedMatches (state ^. matchSet) $ mtchs)+      where+        mergedMatches curr new = if not (DS.null new) && (DS.size curr < env ^. maxMatches || DS.lookupMax curr > DS.lookupMin new)+                                                         then Just . DS.take (env ^. maxMatches) . DS.union curr $ new else Nothing+        updateAndSend = over totalMatches (+ DS.size mtchs) . maybe (set newMatches False state) (\mset -> set newMatches True (set matchSet mset state))++matcherLoop :: (KnownNat n , KnownNat m) => SearchEnv n a b -> Text -> Text -> MatcherSized m a -> IO (Maybe Text)+matcherLoop env qry prev matcher = resetMatches env initstate *> loop initstate+  where+    initstate = SearchStateSized qry prev 0 0 False False DS.empty+    loop state = step =<< tryTakeMVar (env ^. query)+      where+        step x+          | Just Nothing <- x      = doSend SearchDone $> Nothing+          | inrange , Nothing <- x = doSend ChunkSearched *> (loop =<< searchNextChunk env matcher state)+          | Just (Just t) <- x     = doSend NewQuery $> Just t+          | otherwise              = doSend QueryDone *> takeMVar (env ^. query)+          where+            report b = SearchReport b (state ^. newMatches) (state ^. totalMatches) qry+            doSend b = (env ^. send) (env ^. candidates) (report b) matcher (state ^. matchSet)+            inrange = state ^. chunkNumber < (V.length . chunks $ env ^. candidates)++searchEnv :: KnownNat n => SearchFunctions a b -> Int -> (forall n m. (KnownNat n , KnownNat m) => Chunks n -> SearchReport -> MatcherSized m a -> MatchSetSized m -> IO ())+  -> Chunks n -> IO (SearchEnv n a b)+searchEnv funs n sender chks = SearchEnv funs sender n chks <$> newEmptyMVar <*> M.replicate (V.length . chunks $ chks) (S.replicate 1)++searchLoop :: KnownNat n => SearchEnv n a b -> IO ()+searchLoop env = maybe (pure ()) (loop "") =<< takeMVar (env ^. query)+  where+    loop prev qry+      | (Matcher m) <- (env ^. searchFunctions . makeMatcher) qry = maybe (pure ()) (loop qry) =<< matcherLoop env qry prev m++fuzzyFunctions :: CaseSensitivity -> SearchFunctions MatchPart b+fuzzyFunctions c = SearchFunctions (fuzzyMatcher c) fuzzyMatchSized fuzzyMatchPartsAs++orderlessFunctions :: CaseSensitivity -> SearchFunctions Int b+orderlessFunctions c = SearchFunctions (orderlessMatcher c) orderlessMatchSized orderlessMatchPartsAs++{-# INLINABLE makeChunks #-}+makeChunks :: forall n. KnownNat n => V.Vector Text -> Chunks n+makeChunks v = Chunks $ V.generate numchunks (SV.force . fromJust . SV.toSized . chunk)+  where+    n = fromInteger $ natVal (Proxy :: Proxy n)+    (numchunks , remainder) = bimap (+ 1) (+ 1) . divMod (length v - 1) $ n+    chunk i+      | i + 1 < numchunks  = V.slice (i*n) n v+      | otherwise          = V.slice (i*n) remainder v <> V.replicate (n - remainder) ""++{-# INLINE makeChunksP #-}+makeChunksP :: KnownNat n => Proxy n -> V.Vector Text -> Chunks n+makeChunksP _ = makeChunks++{-# INLINEABLE setToVectorST #-}+setToVectorST :: (a -> b) -> DS.Set a -> ST s (V.Vector b)+setToVectorST f s = go =<< MV.unsafeNew (DS.size s)+  where+    go mv = foldM_ (\i e -> MV.unsafeWrite mv i (f e) $> i + 1) 0 s *> V.unsafeFreeze mv++startSearcher :: KnownNat n => SearchEnv n a b -> IO ()+startSearcher = void . forkIO . searchLoop++sendQuery :: KnownNat n => SearchEnv n a b -> Text -> IO ()+sendQuery env = putMVar (env ^. query) . Just++stopSearcher :: KnownNat n => SearchEnv n a b -> IO ()+stopSearcher env = putMVar (env ^. query) Nothing++concatChunks :: KnownNat n => Int -> Chunks n -> V.Vector Text+concatChunks i (Chunks c) =  V.concatMap SV.fromSized . V.take i $ c++forceChunks :: KnownNat n => Chunks n -> Chunks n+forceChunks (Chunks v) = Chunks . V.force $ v++chunksFromStream :: forall n. KnownNat n => I.InputStream Text -> IO (Chunks n)+chunksFromStream i = Chunks <$> (I.toVector =<< I.mapMaybe (\v -> map SV.force . SV.toSized $ v V.++ V.replicate (n - length v) "") =<< I.chunkVector n i)+  where+    n = fromInteger $ natVal (Proxy :: Proxy n)++{-# INLINE chunksFromStreamP #-}+chunksFromStreamP :: forall n. KnownNat n => Proxy n -> I.InputStream Text -> IO (Chunks n)+chunksFromStreamP _ = chunksFromStream++{-# INLINABLE chunksFromHandle #-}+chunksFromHandle :: KnownNat n => Proxy n -> Handle -> IO (Chunks n)+chunksFromHandle p = chunksFromStreamP p <=< I.decodeUtf8 <=< I.lines <=< I.handleToInputStream++readVectorHandleWith :: (Text -> Text) -- ^ The function to transform the candidates.+  -> (V.Vector Text -> V.Vector Text) -- ^ The function to apply to the constructed vector before compacting.+  -> Handle -- ^ The handle to read from+  -> IO (V.Vector Text)+readVectorHandleWith f t = map t . I.toVector <=< I.map f <=< I.decodeUtf8 <=< I.lines <=< I.handleToInputStream++fileNamesSorted :: Handle -> IO (V.Vector Text)+fileNamesSorted = readVectorHandleWith (T.takeWhileEnd (/= '/')) (V.uniq . V.modify sort)

@@ -1,5 +1,6 @@ {-# LANGUAGE RankNTypes #-} {-# LANGUAGE ExistentialQuantification #-}+{-# OPTIONS_GHC -Wno-duplicate-exports #-} -- | This modules provides the function `searchSome` for searching the candidates provided by `Vector` `Text`. The information about the location of matches -- is stored in a length-tagged unboxed vector `S.Vector`. Such vectors have an `Unbox` instances which allows us to store the collection of such mathces in an -- unboxed `U.Vector`. This significantly reduces the memory usage and pressure on garbage collector. As a result the matchers used by this function are tagged@@ -9,27 +10,23 @@ module Talash.Core ( -- * Types                      MatcherSized (..) , Matcher (..) , MatchState (..) , MatchPart (..) , MatchFull (..) , SearchSettings (..) , Indices                      -- * Matchers and matching-                     , makeMatcher+                     , makeMatcher , emptyMatcher                      -- ** Fuzzy style-                     , fuzzyMatcherSized , fuzzyMatcher , fuzzyMatchSized , fuzzyMatch+                     , fuzzyMatcherSized , fuzzyMatcher , fuzzyMatchSized , fuzzyMatch , fuzzyMatchParts , fuzzyMatchPartsAs                      -- ** Orderless Style-                     , orderlessMatcherSized , orderlessMatcher , orderlessMatchSized , orderlessMatch+                     , orderlessMatcherSized , orderlessMatcher , orderlessMatchSized , orderlessMatch , orderlessMatchParts , orderlessMatchPartsAs                      -- * Search-                     , fuzzySettings , orderlessSettings  ,  searchSome , parts , partsOrderless , minify) where+                     , fuzzySettings , orderlessSettings , parts , partsAs , partsOrderless , partsOrderlessAs , minify) where -import Control.Monad.ST (ST, runST) import qualified Data.Text as T import Data.Text.AhoCorasick.Automaton-import Data.Text.Utf16-import qualified Data.Vector as V+import Data.Text.Utf8 hiding (indices) import qualified Data.Vector.Algorithms.Intro as V import qualified Data.Vector.Unboxed as U import qualified Data.Vector.Unboxed.Mutable as M import qualified Data.Vector.Unboxed.Sized as S import GHC.TypeNats-import Prelude (fromIntegral)-import Intro-import Lens.Micro (_1 , _2 , (^.))+import Talash.Intro hiding (someNatVal)  -- | The MatcherSized type consists of a state machine for matching a fixed number of needles. The number of matches needed is encoded in the Nat parameterzing --   the type. Here the purpose is to improve the memory consumption by utlizing the `Unbox` instance for sized tagged unboxed vectors from@@ -99,13 +96,12 @@  {-# INLINEABLE matchStepFuzzy #-} matchStepFuzzy :: KnownNat n => Either Int (S.Vector n Int) -> MatchState n () -> Match MatchPart -> Next (MatchState n ())-matchStepFuzzy l s@(MatchState !f !m _) (Match !i (MatchPart !b !e))-  | e - b == either id S.length l - 1                             = Done $ updateMatch (codeUnitIndex i) l s b e ()-  | f + 1 == b                                                    = Step $ updateMatch (codeUnitIndex i) l s b e ()-  | f >= b && e > f && monotonic                                  = Step $ updateMatch (codeUnitIndex i) l s b e ()-  | otherwise                                                     = Step   s+matchStepFuzzy l s@(MatchState !f !m _) (Match (CodeUnitIndex !i) (MatchPart !b !e))+  | e - b == either id S.length l - 1                                                                           = Done $ updateMatch i l s b e ()+  | (b == 0 && f == (-1)) || (f + 1 == b && S.unsafeIndex m f + e < i + b) || (f >= b && e > f && monotonic)    = Step $ updateMatch i l s b e ()+  | otherwise                                                                                                   = Step   s   where-    monotonic = S.unsafeIndex m f <= codeUnitIndex i - either (const $ e-f) (U.sum . U.slice f (e-f) . S.fromSized) l+    monotonic = S.unsafeIndex m f + either (const $ e-f) (U.sum . U.slice f (e-f) . S.fromSized) l <= i  {-# INLINEABLE matchStepOrderless #-} matchStepOrderless :: KnownNat n => Either Int (S.Vector n Int) -> MatchState n (Int , Int) -> Match Int -> Next (MatchState n (Int , Int))@@ -119,24 +115,18 @@ kConsecutive :: Int ->  Text -> [Text] kConsecutive k t = map (T.take k) . take (1 + T.length t - k) . T.tails $ t -{-# INLINE run #-}-run :: CaseSensitivity -> a -> (a -> Match v -> Next a) -> AcMachine v -> Text -> a-run IgnoreCase     = runLower-run CaseSensitive  = runText- -- | A general function to construct a Matcher. Returns Nothing if the string is empty or if the number of needles turns out to be non-positive makeMatcher :: forall a. CaseSensitivity -> (Text -> Int) -- ^ The function to determine the number of needles from the query string.                                                           -- The proxy argument is instantiated at the resulting value.                     -> (forall n. KnownNat n => Proxy n -> CaseSensitivity -> Text -> MatcherSized n a) -- ^ The functions for constructing the matcher                     -> Text -- ^ The query string-                    -> Maybe (Matcher a) -- ^ Nothing if the string is empty or if the number of needles turns out to be non-positive+                    -> Matcher a -- ^ Nothing if the string is empty or if the number of needles turns out to be non-positive makeMatcher c lenf matf t-  | T.null t || lenf t <= 0                                    = Nothing-  | SomeNat p <- someNatVal . fromIntegral. lenf $ t    = Just . Matcher . matf p c $ t+  | SomeNat p <- someNatVal . fromIntegral. lenf $ t    = Matcher . matf p c $ t  {-# INLINE withSensitivity #-} withSensitivity :: CaseSensitivity -> Text -> Text-withSensitivity IgnoreCase    = lowerUtf16+withSensitivity IgnoreCase    = lowerUtf8 withSensitivity CaseSensitive = id  -- | Constructs the matcher for fuzzy matching. The needles are all possible contigous subtrings of the string being matched. The Nat @n@ must be instantiated at the@@ -145,39 +135,49 @@ --  the optimal way for this kind of matching but in practice it seems fast enough. fuzzyMatcherSized :: KnownNat n => p n -> CaseSensitivity -> Text -> MatcherSized n MatchPart fuzzyMatcherSized _ c t = MatcherSized {caseSensitivity = c , machina = build . concatMap go $ [T.length t , T.length t - 1 .. 1]-                             , sizes = if S.sum sz == S.length sz then Left (S.length sz) else Right sz }+                                       , sizes = if S.sum sz == S.length sz then Left (S.length sz) else Right sz }   where-    sz      = fromMaybe (S.replicate 1) . S.fromList . map (length . unpackUtf16 . withSensitivity c . T.singleton)  . T.unpack  $ t-    go !k   = zipWith (\t' l -> (unpackUtf16 . withSensitivity c $ t' , MatchPart l (l + k -1))) (kConsecutive k t) [0 ..]+    sz      = fromMaybe (S.replicate 1) . S.fromList . map (length . unpackUtf8 . withSensitivity c . T.singleton)  . T.unpack  $ t+    go !k   = zipWith (\t' l -> (withSensitivity c t' , MatchPart l (l + k -1))) (kConsecutive k t) [0 ..]  -- | Unsized version of fuzzyMatcherSized-fuzzyMatcher :: CaseSensitivity -> Text -> Maybe (Matcher MatchPart)+fuzzyMatcher :: CaseSensitivity -> Text -> Matcher MatchPart fuzzyMatcher c  = makeMatcher c T.length fuzzyMatcherSized +{-# INLINE emptyMatcher #-}+emptyMatcher :: MatcherSized 0 a+emptyMatcher = MatcherSized IgnoreCase (build []) (Left 0)+ -- | Constructs the matcher for orderless matching, the needles are the words from the query string and the proxy argument should be instantiated at the --  number of words. orderlessMatcherSized :: KnownNat n => p n -> CaseSensitivity -> Text -> MatcherSized n Int-orderlessMatcherSized _ c t = MatcherSized {caseSensitivity = c , machina = build . zip (unpackUtf16 <$> wrds) $ [0 ..]-                               , sizes = Right . fromMaybe (S.replicate 1) . S.fromList . map (codeUnitIndex . lengthUtf16) $ wrds }+orderlessMatcherSized _ c t = MatcherSized {caseSensitivity = c , machina = build . zip wrds $ [0 ..]+                               , sizes = Right . fromMaybe (S.replicate 1) . S.fromList . map (codeUnitIndex . lengthUtf8) $ wrds }   where     wrds = withSensitivity c <$> T.words t  -- | Unsized version of orderlessMatcherSized-orderlessMatcher :: CaseSensitivity -> Text -> Maybe (Matcher Int)+orderlessMatcher :: CaseSensitivity -> Text -> Matcher Int orderlessMatcher c = makeMatcher c (length . T.words) orderlessMatcherSized  {-# INLINEABLE fuzzyMatchSized#-} fuzzyMatchSized :: KnownNat n => MatcherSized n MatchPart -> Text -> Maybe (MatchFull n)-fuzzyMatchSized (MatcherSized c m l) = full . run c (MatchState (-1) (S.replicate 0) ()) (matchStepFuzzy l) m+fuzzyMatchSized (MatcherSized c m l) = full . runWithCase c (MatchState (-1) (S.replicate 0) ()) (matchStepFuzzy l) m   where-    full (MatchState !e !u _) = if e + 1 == S.length u then Just $ MatchFull (matchScore l u) u else Nothing+    full s@(MatchState !e !u _) = if e + 1 == S.length u then Just $ MatchFull (matchScore l u) u else Nothing  fuzzyMatch :: Matcher MatchPart -> Text -> Maybe [Text] fuzzyMatch (Matcher m) t = parts (S.fromSized <$> sizes m) t . S.fromSized . indices <$> fuzzyMatchSized m t +fuzzyMatchParts :: KnownNat n => MatcherSized n MatchPart -> Text -> S.Vector n Int -> [Text]+fuzzyMatchParts m t = parts (S.fromSized <$> sizes m) t . S.fromSized++fuzzyMatchPartsAs :: KnownNat n => (Bool -> Text -> a) -> MatcherSized n MatchPart -> Text -> S.Vector n Int -> [a]+fuzzyMatchPartsAs f m t = partsAs f (S.fromSized <$> sizes m) t . S.fromSized+ {-# INLINEABLE orderlessMatchSized#-} orderlessMatchSized :: KnownNat n => MatcherSized n Int -> Text -> Maybe (MatchFull n)-orderlessMatchSized (MatcherSized c m l) = full . run c (MatchState 0 (S.replicate 0) (0,0)) (matchStepOrderless l) m+orderlessMatchSized (MatcherSized c m l) = full . runWithCase c (MatchState 0 (S.replicate 0) (0,0)) (matchStepOrderless l) m   where     ln = either id S.length l     full u = if endLocation u == ln then Just $ MatchFull 0 (partialMatch u) else Nothing@@ -185,22 +185,45 @@ orderlessMatch :: Matcher Int -> Text -> Maybe [Text] orderlessMatch (Matcher m) t = partsOrderless (S.fromSized <$> sizes m) t . S.fromSized . indices <$> orderlessMatchSized m t +orderlessMatchParts :: KnownNat n => MatcherSized n Int -> Text -> S.Vector n Int -> [Text]+orderlessMatchParts m t = partsOrderless (S.fromSized <$> sizes m) t . S.fromSized++orderlessMatchPartsAs :: KnownNat n => (Bool -> Text -> a) -> MatcherSized n Int -> Text -> S.Vector n Int -> [a]+orderlessMatchPartsAs f m t = partsOrderlessAs f (S.fromSized <$> sizes m) t . S.fromSized+ -- | The parts of a string resulting from a match using the fuzzy matcher. parts :: Either Int (U.Vector Int) -- ^ The information about the lengths of different needles.   -> Text -- ^ The candidate string that has been matched   -> U.Vector Int -- ^ The vector recording the positions of the needle in the matched string.   -> [Text] -- ^ The candidate string split up according to  the match-parts v t = done . foldl' cut ([] , lengthUtf16 t) . minify v+parts v t u+  | U.null u  = [t]+  |otherwise  =  done . foldl' cut ([] , lengthUtf8 t) . minify v $ u   where-    done (ms , cp) = unsafeSliceUtf16 0 cp t : ms-    cut  (!ms , !cp) !cc  = (unsafeSliceUtf16 cc (cp - cc) t : ms , cc )+    done (ms , cp) = unsafeSliceUtf8 0 cp t : ms+    cut  (!ms , !cp) !cc  = (unsafeSliceUtf8 cc (cp - cc) t : ms , cc ) +partsAs :: (Bool -> Text -> a) -> Either Int (U.Vector Int) -> Text -> U.Vector Int -> [a]+partsAs f = go+  where+    go v t u+      | U.null u  = [f False t]+      |otherwise  =  done . foldl' cut ([] , lengthUtf8 t , False) . minify v $ u+      where+        done (ms , cp, b) = f b (unsafeSliceUtf8 0 cp t) : ms+        cut  (!ms , !cp , !b) !cc  = (f b (unsafeSliceUtf8 cc (cp - cc) t) : ms , cc , not b)+ -- | The parts of a string resulting from a match using the orderless matcher. See parts for an explanation of arguments. partsOrderless :: Either Int (U.Vector Int) -> Text -> U.Vector Int -> [Text] partsOrderless v t u = parts (map (`U.backpermute` fst up) v) t (snd up)   where     up = U.unzip . U.modify (V.sortBy (comparing snd)) . U.imap (,) $ u +partsOrderlessAs :: (Bool -> Text -> a) -> Either Int (U.Vector Int) -> Text -> U.Vector Int -> [a]+partsOrderlessAs f v t u = partsAs f (map (`U.backpermute` fst up) v) t (snd up)+  where+    up = U.unzip . U.modify (V.sortBy (comparing snd)) . U.imap (,) $ u+ {-# INLINE eIndexU #-} eIndexU :: Int -> Either a (U.Vector Int) -> Int eIndexU i = either (const 1) (`U.unsafeIndex` i)@@ -213,6 +236,7 @@   where     a = U.unsafeHead s     go (!l , s) !i !c = if c - l <= eIndexU (i+1) v then (c , s) else (c , c - eIndexU (i+1) v : l : s )+ -- | The default ordering used in this module to sort matches within a given bucket. Prefers the matche for which the last part is closest to the end. To tie -- break prefers the shorter matched string. defOrdering :: Text -> S.Vector n Int -> Text -> S.Vector n Int -> Ordering@@ -234,50 +258,3 @@ --   @["tal","as","h","be","st"]@ but @"talash best"@ will not match @"bet"@. orderlessSettings :: KnownNat n => Int -> SearchSettings (MatcherSized n Int) n orderlessSettings n = SearchSettings {match = orderlessMatchSized , fullscore = const 0, maxFullMatches = n , orderAs = defOrdering}---- | Given a matcher, search for matches in a vector of text. This function only searches for matches among the strings at indices which are in 3rd argument.-searchSome :: forall a n. KnownNat n => SearchSettings a n -- ^ The configuration for finding matches-  -> a -- ^ The matcher-  -> V.Vector Text -- ^ The vector of candidates-  -> U.Vector Int -- ^ The subset of indices of candidates to search from-  -> (U.Vector Int , U.Vector (Indices n)) -- ^ The new set of filtered indices in the vector and the vector containing the indices for each match found.-searchSome config !t v i = runST $ uncurry (searchSomeST config t v i)-                                   =<< ((,) <$> M.unsafeNew (U.length i)-                                            <*> V.replicateM (fullscore config t + 1) (M.unsafeNew (min (U.length i) $ maxFullMatches config)))---- This functions is somewhat ridiculous and probably over optimized. Its only purpose is to be used in searchSome. searchSome can more simply be written as--- a mapMaybe followed by a sort but this doesn't allow for a early termination of matching once we have found enough matches. A streaming solution will probably--- be simpler for generating the candidates but will still need to be read into a vector and sorted so for now this works and is fast enough.-searchSomeST :: forall s a n. KnownNat n => SearchSettings a n -- ^-  -> a -> V.Vector Text -> U.Vector Int -> M.STVector s Int -- ^ The mutable vector into which we write the new filtered indices-  -> V.Vector (M.STVector s (Indices n)) -- ^ The vector @mv@ containing the buckets i.e. mutable vectors one for each possible score gathering the matches-  ->  ST s (U.Vector Int , U.Vector (Indices n)) -- ^ The final vector of filtered indices and the vector of-searchSomeST config !t v i mi mv = end =<< U.foldM' go (0, U.replicate (fullscore config t + 1) 0) i-  where-    -- If we don't have enough matches with the highest score, @cc@ goes through other score in the decreasing order filling up the bucket of highest order.-    -- Stopping when either the bucket is full or else we have run through all the scores. Before filling each bucket is sorted according the ordering supplied  -    -- by the configuration. Once the filling is done this bucket is frozen see `sortTake` and returned along with the frozen vector of filtered indcies see `end`.-    end (l , u)  = (,) <$> (U.unsafeFreeze . M.unsafeTake l $ mi) <*> sortTake u-    sortTake u = (\l -> U.unsafeFreeze . M.unsafeTake l $ msv) =<< (doSort (-1) (U.unsafeLast u) *> U.ifoldM' cc (U.unsafeLast u) (U.reverse . U.unsafeInit $ u))-    msv = V.unsafeLast mv-    cc r ix n-      | r >= maxFullMatches config     = pure r-      | r + n <= maxFullMatches config = doSort ix n *> doFill r (fullscore config t - 1 - ix) n $> r + n-      | otherwise                      = doSort ix n *> doFill r (fullscore config t - 1 - ix) (maxFullMatches config - r) $> maxFullMatches config-    doFill r ix n = traverse_ (\k -> M.unsafeWrite msv (r+k) =<< M.unsafeRead (V.unsafeIndex mv ix) k) [0 .. n-1]-    doSort   ix   = V.sortByBounds cmfn (V.unsafeIndex mv (fullscore config t - 1 - ix)) 0-    cmfn (!i1,!s1) (!i2,!s2) =  orderAs config (V.unsafeIndex v i1) s1 (V.unsafeIndex v i2) s2-    bstMch = match config t . V.unsafeIndex v-    bign   = (>= maxFullMatches config)-    -- The idx is the number of total number of matches that have been written up to now. nf is the vector carrying the same information for each bucket.-    -- elm is current index to check for a match. So we check if v ! elem is a match, if it is we write the match into the appropriate bucket and elem into-    -- the vector of filtered indices  and increment idx and the appropriate index of nf. If we have already reached the needed number of matches of full score-    -- we instead just skip matching and write idx into the vector of filtered indices.-    go (!idx , !nf) !elm-      | bign (U.last nf)                                                  = M.unsafeWrite mi idx elm $> (idx + 1 , nf)-      | Just !mch <- bstMch elm , bign (U.unsafeIndex nf (scored mch))    = M.unsafeWrite mi idx elm $> (idx + 1 , nf)-      | Just (MatchFull !s !ixs) <- bstMch elm                            = M.unsafeWrite mi idx elm *> wrt s ixs $> inc s-      | otherwise                                                         = pure (idx , nf)-      where-        wrt s ixs = M.unsafeWrite (V.unsafeIndex mv s) (U.unsafeIndex nf s) (elm , ixs)-        inc s = (idx + 1 , U.modify (\mu -> M.unsafeModify mu (+1) s) nf)

@@ -13,10 +13,11 @@ import qualified Data.Text as T import qualified Data.Text.Encoding as T import qualified Data.Vector as V-import Intro+import qualified Data.Vector.Algorithms.Intro as V import System.Posix.Directory.ByteString import System.Posix.Env.ByteString import System.Posix.Files.ByteString+import Talash.Intro  -- Configruation for the search when recursivley constructing the file tree. data Conf = Conf {@@ -29,16 +30,15 @@ -- is just the part of the filename after the last '.' i.e this module doesn't handle multiple extensions. data FindConf = Find !(S.HashSet ByteString) | Ignore !(S.HashSet ByteString) deriving Show - data FindInDirs = FindInDirs {                     -- | The configuration of finding or excluding the extensions for this set of directories.                     confLocal :: FindConf ,                     -- | The list of directories to which this configuration should apply.                     dirsLocal :: [ByteString]} -data FileTree a = Dir { rootDir :: a -- ^ The root directory-                      , dirFiles :: (V.Vector a) -- ^ The files in the root directory that are not subdirectories-                      , subDirs :: (V.Vector (FileTree a))} -- ^ The vector of trees formed by subdirectories+data FileTree a = Dir { rootDir  :: a -- ^ The root directory+                      , dirFiles :: V.Vector a -- ^ The files in the root directory that are not subdirectories+                      , subDirs  :: V.Vector (FileTree a)} -- ^ The vector of trees formed by subdirectories                         deriving (Eq , Show)  -- | Default configuration, include every file and search directory.@@ -49,20 +49,18 @@ --   the Right elements are subdirectories that pass the `filterPath` test. {-# INLINEABLE dirContentsWith #-} dirContentsWith :: Conf -> ByteString -> IO (V.Vector (Either ByteString ByteString))-dirContentsWith c d = bracket (openDirStream d) closeDirStream (V.unfoldrM (\s -> map (\d -> if d == Left "" then Nothing else Just (d , s)) . go $ s))+dirContentsWith c d = bracket (openDirStream d) closeDirStream (\s -> V.unfoldrM (map (map ( , s)) . go) s)   where     go s = nm =<< readDirStream s       where         nm f-          | f == ""                                         = pure (Left "")+          | f == ""                                         = pure Nothing           | otherwise                                       = hr =<< getSymbolicLinkStatus f           where-            hr fs-              | isDirectory fs                              = hd-              | otherwise                                   = ifM (includeFile c fs f) (pure . Left $ f) (go s)-            hd-              | filterPath c f && f /= "." && f /= ".."     = ifM (fileAccess f True False False) (pure . Right $ f) (go s)-              | otherwise                                   = go s+            hr fs = det (isDirectory fs && filterPath c f && f /= "." && f /= "..") =<< includeFile c fs f+            det True  _    = pure . Just . Right $ f+            det False True = pure . Just . Left  $ f+            det _     _    = go s  -- | Constructs the file tree with the given the second argument at the root according to the given configuration. {-# INLINEABLE fileTreeWith #-}@@ -70,6 +68,7 @@ fileTreeWith c d = bracket getWorkingDirectory changeWorkingDirectory (const $ changeWorkingDirectory d *> (go =<< dirContentsWith c "."))   where     go v = (\(a , b) -> Dir (T.decodeUtf8 d) a <$!> V.mapM (fileTreeWith c) b) . V.partitionWith (first T.decodeUtf8) $ v+    cex (_ :: SomeException) = pure $ Dir (T.decodeUtf8 d) mempty mempty  -- | Collapses the directories with only subdirectory and no other files. {-# INLINEABLE minify #-}@@ -111,7 +110,6 @@       | Find   es <- c     = defConf {includeFile = \ !s !n -> pure $ isRegularFile s && S.member (ext n) es}       | Ignore es <- c     = defConf {includeFile = \ !s !n -> pure $ isRegularFile s && not (S.member (ext n) es)} - -- | Like `findWithExts` but applied to mutliple lists of directories each with their own configuration of extensions. {-# INLINABLE findFilesInDirs #-} findFilesInDirs :: [FindInDirs] -> IO (V.Vector (FileTree Text))@@ -119,6 +117,8 @@  -- | Find all the executables in PATH executables :: IO (V.Vector Text)-executables = foldr (\a t -> t <> map (V.map (T.takeWhileEnd (/= '/')) . flatten) (fileTreeWith cl a)) (pure V.empty) . B.split ':' =<< getEnvDefault "PATH" ""+executables = map (V.uniq . V.modify V.sort) . foldr merge (pure V.empty) . B.split ':' =<< getEnvDefault "PATH" ""   where-    cl = defConf { filterPath = const False , includeFile = \ s p ->  map ((isRegularFile s || isSymbolicLink s) &&) . fileAccess p False False $ True}+    cl = defConf { filterPath = const False , includeFile = \ s _ ->  pure $    (isRegularFile s || isSymbolicLink s)+                                                                             && (ownerExecuteMode == intersectFileModes (fileMode s) ownerExecuteMode)}+    merge a t = t <> map (V.map (T.takeWhileEnd (/= '/')) . flatten) (fileTreeWith cl a)

@@ -1,94 +0,0 @@-{-# LANGUAGE TemplateHaskell #-}-{-# LANGUAGE RankNTypes #-}-{-# LANGUAGE ExistentialQuantification #-}--module Talash.Internal ( -- * Search-                     SearchFunctions(..) , makeMatcher , lister , displayer ,  searchFunctionsFuzzy , searchFunctionsOL , searchWithMatcher-                     -- * Help for reading vectors-                   , readVectorStdIn , fileNamesSorted , readVectorHandle , readVectorHandleWith, emptyIndices-                     -- * Exports-                   , module Export ) where--import Control.Exception as Export (finally , catch, bracket , AsyncException)-import qualified Data.Text as T-import Data.Text.AhoCorasick.Automaton (CaseSensitivity (..))-import qualified Data.Text.IO as T-import Data.Vector (Vector , (!), force , generate , take, singleton , convert, enumFromN, unfoldr, unfoldrM , uniq , modify, concat)-import Data.Vector.Algorithms.Intro (sort)-import qualified Data.Vector.Unboxed as U-import qualified Data.Vector.Unboxed.Sized as S-import GHC.Compact (Compact , compact , getCompact)-import GHC.TypeNats-import Intro hiding (sort, take , modify)-import Lens.Micro as Export (ASetter' , over, set, (^.) , _1 , _2 , _3 , (.~) , (?~) , (%~))-import Lens.Micro.TH as Export ( makeLenses )-import System.IO as Export ( Handle , hIsEOF , isEOF, hClose, stdin)-import Talash.Core hiding (makeMatcher)--data SearchFunctions a = SearchFunctions {-                           -- | Construct the matcher given the string to match.-                           _makeMatcher :: Text -> Maybe (Matcher a) ,-                           -- | Obtain the result for searching.-                           _lister :: forall n. KnownNat n => MatcherSized n a --  The n will be determined by the SomeMatcher constructed above-                                                                -> Vector Text --  The vector holding the candidates-                                                                -> U.Vector Int -- An unboxed vector of indices. Only these indices will be matched against the matcher-                                                                -> (U.Vector Int , U.Vector (Indices n)) ,-                           -- | Given the matcher @m@, the matched string @t@ and the indices of matches in @t@ divide @t@ in alternating strings that are a matches-                           --   and the gap between these matches. The first of these is always a gap and can be empty. The rest should be non empty.-                           _displayer :: forall n. KnownNat n => MatcherSized n a -> Text -> S.Vector n Int -> [Text] }-makeLenses ''SearchFunctions--emptyIndices :: Int -> U.Vector  (Indices 0)-emptyIndices n = U.generate n ( , S.empty)---- | searchWithMatcher carries out one step of the search. Note that the search can stops before going through the whole vector of text. In that case the returned---   vector of indices should contain not only the indices matched candidates but also the indices of candidates that weren't tested for a match.-searchWithMatcher :: SearchFunctions a -- ^ The configuration to use to carry out the search.-  -> Vector Text -- ^ The vector @v@ of candidates.-  -> Maybe Text -- ^ The query string-  -> U.Vector  Int -- ^ The subset of indices of @v@ to search against. If input changes from @talas@ to @talash@ we only search among candidates that matched @talas@.-  -> (U.Vector Int , (Int , Vector [Text])) -- ^ The indices of the matched candidates (see the note above) and the matched candidates broken up according to the match.-searchWithMatcher fs v t s = maybe nc go ((fs ^. makeMatcher) =<< t)-      where-        nc  = (U.enumFromN 0 (length v) , (0 , force . map (\i -> [v ! (i ^. _1)]) . convert . emptyIndices . min 512 . length $ v))-        go (Matcher  f') = (iv , (U.length iv , force . map (\i -> (fs ^. displayer) f' (v ! (i ^. _1)) (i ^. _2)) . convert $ mv))-          where-            (iv , mv) = (fs ^. lister) f' v s---- | Read a vector of newline separated candidates from the stdin.-readVectorStdIn :: IO (Vector Text)-readVectorStdIn  = finally (unfoldrM (const . ifM isEOF (pure Nothing) . map (\ !l -> Just (l  , ())) $ T.getLine) ()) (hClose stdin)---- | Read a vector of newline separated candidates from a handle.-readVectorHandle :: Handle -> IO (Vector Text)-readVectorHandle h = finally (unfoldrM (const . ifM (hIsEOF h) (pure Nothing) . map (\ !l -> Just (l  , ())) $ T.hGetLine h) ()) (hClose h)---- | A generalized version of readVectorHandle allowing for the transformation of candidates and the resulting vector. See fileNamesSorted for an example of use.-readVectorHandleWith :: (Text -> Text) -- ^ The function to transform the candidates.-  -> (Vector Text -> Vector Text) -- ^ The function to apply to the constructed vector before compacting.-  -> Handle -- ^ The handle to read from-  -> IO (Vector Text)-readVectorHandleWith f t h = finally (t <$> unfoldrM (const . ifM (hIsEOF h) (pure Nothing) . map (\ !l -> Just (f $! l  , ())) $ T.hGetLine h) ())-                                     (hClose h)---- | Read a vector of filenames from the handle, get the basename by removing the path of the directory. Finally sort and deduplicate the resulting filenames.---   Useful to get the list of executables from PATH for example.-fileNamesSorted :: Handle -> IO (Vector Text)-fileNamesSorted = readVectorHandleWith (T.takeWhileEnd (/= '/')) (uniq . modify sort)---- | Search functions suitable for fuzzy matching. The candidate @c@ will match the query @s@ if @c@ contains all the characters in @s@ in order. In general there---   can be several ways of matching. This tries to find a match with the minimum number of parts. It does not find the minimum number of parts, if that requires---   reducing the extent of the partial match during search. E.g. matching @"as"@ against @"talash"@ the split will be @["tal","as","h"]@ and not---   @["t","a","la","s","h"]@. While matching @"talash best match testing hat"@ against @"tea"@ will not result in @["talash best match ","te","sting h","a","t"]@ since---   @"te"@ occurs only after we have match all three letters and we can't know if we will find the @"a"@ without going through the string.-searchFunctionsFuzzy :: SearchFunctions MatchPart-searchFunctionsFuzzy = SearchFunctions (fuzzyMatcher IgnoreCase) (searchSome (fuzzySettings 512)) (\m t -> parts (S.fromSized <$> sizes m) t . S.fromSized)---- | Search functions that match the words in i.e. space separated substring in any order. @"talash best"@ will match @"be as"@ with the split---   @["tal","as","h","be","st"]@ but "talash best" will not match @"bet"@.-searchFunctionsOL :: SearchFunctions Int-searchFunctionsOL = SearchFunctions (orderlessMatcher IgnoreCase) (searchSome (orderlessSettings 512)) (\m t -> partsOrderless (S.fromSized <$> sizes m) t . S.fromSized)---- testSearch :: IO ()--- testSearch = (\v -> traverse_ print . take 64 . snd . snd . searchWithMatcher searchFunctionsFuzzy v (Just "figrun") . U.enumFromN  0 . length $ v) . getCompact---               =<< readVectorStdIn

@@ -0,0 +1,33 @@+-- |++module Talash.Intro (map , module Export) where++import Control.Exception as Export+import Control.Monad as Export+import Control.Monad.Extra as Export+import Control.Monad.Reader as Export+import Control.Monad.ST as Export (ST, runST)+import Data.Bifunctor as Export+import Data.ByteString as Export (ByteString)+import Data.Either as Export+import Data.Foldable as Export+import Data.Functor as Export+import Data.List as Export (unfoldr)+import Data.Maybe as Export+import Data.Ord as Export+import Data.Proxy as Export+import Data.Text as Export (Text , pack , unpack)+import Data.Text.Encoding as Export+import Data.Text.IO as Export (putStr , putStrLn)+import Data.Vector as Export (Vector)+import GHC.TypeLits as Export hiding (TypeError)+import Lens.Micro as Export (ASetter' , over, set, (^.) , _1 , _2 , _3 , (.~) , (?~) , (%~) , to)+import Prelude as Export hiding ((>>) , map , putStr , putStrLn)+import Safe as Export+import System.Environment as Export+import System.IO as Export hiding (putStr , putStrLn)+import Text.Read as Export hiding (lift , list , get)++{-# INLINE map #-}+map :: Functor f => (a -> b) -> f a -> f b+map = fmap

@@ -5,103 +5,78 @@ --   `askSearcher`. One motivation for this is be able to use this library as search backend for some searches in Emacs (though the implementation may have to wait --  for a massive improvement in my elisp skills). module Talash.Piped ( -- * Types and Lenses-                      SearchResult (..) , query , allMatches , matches , IOPipes (..)-                    , SearchFunctions (..) , makeMatcher , lister , displayer , searchFunctionsOL , searchFunctionsFuzzy-                      -- * Searcher-                    , searchLoop , runSearch , runSearchStdIn  ,  runSearchStdInDef , runSearchStdInColor , showMatch , showMatchColor-                      -- * Seeker+                      PipedSearcher (..) , query , allMatches , CaseSensitivity (..)+                    --   -- * Searcher+                    , searchLoop , runSearch , runSearchStdIn  ,  runSearchStdInDef , showMatchColor+                    --   -- * Seeker                     , askSearcher-                      -- * Default program+                    --   -- * Default program                     , run , run'-                      -- * Exposed Internals-                    , response , event , withIOPipes , send , recieve-                    , searchWithMatcher , readVectorStdIn , readVectorHandle , readVectorHandleWith , emptyIndices) where+                    --   -- * Exposed Internals+                    , withNamedPipes , send , recieve)+where  import qualified Data.ByteString.Char8 as B import Data.Monoid.Colorful import qualified Data.Text as T+import qualified Data.Text.IO as T import qualified Data.Vector as V import qualified Data.Vector.Unboxed as U import GHC.Compact-import Intro import System.Directory import System.Environment (getArgs) import System.Exit import System.IO hiding (print , putStrLn , putStr) import System.Posix.Files import System.Posix.Process-import Talash.Core hiding (makeMatcher)-import Talash.Internal--data SearchResult = SearchResult { _query :: Maybe Text -- ^ The query that was searched for.-                                 , _allMatches :: U.Vector Int -- ^ The vector contaning the filtered indices of the candidates using the query.-                                 , _matches :: V.Vector [Text] -- ^ The matches obtained using the query.-                                 } deriving (Show , Eq)-makeLenses ''SearchResult+import Talash.Chunked hiding (makeMatcher , send)+import Talash.Intro+import Lens.Micro.TH (makeLenses) -data IOPipes = IOPipes { input :: Handle -- ^ The handle to the named piped on which the server receives input to search for.-                       , output :: Handle -- ^ The handle to the named piped on which the searcher outputs the search results.-                       }+data PipedSearcher = PipedSearcher { _inputHandle :: Handle+                                   , _outputHandle :: Handle+                                   , _maximumMatches :: Int+                                   , _printStrategy :: SearchReport -> Bool+                                   , _printer :: Handle -> [Text] -> IO ()}+makeLenses ''PipedSearcher -response :: SearchFunctions a -- ^ The functions determining how to much.-              -> V.Vector Text -- ^ The vector of candidates.-              -> Text -- ^ The text to match-              -> SearchResult -- ^ The last result result. This is used to determine which candidates to search among.-              -> SearchResult-response f v t s-  | maybe False (`T.isInfixOf` t) (s ^. query)  = go . searchWithMatcher f v (Just t) $ s ^. allMatches-  | otherwise                                   = go . searchWithMatcher f v (Just t) $ U.enumFromN 0 (V.length v)+printMatches :: forall n m a. (KnownNat n , KnownNat m) => SearchFunctions a Text -> PipedSearcher -> Chunks n+                                                                -> SearchReport -> MatcherSized m a -> MatchSetSized m -> IO ()+printMatches funcs searcher store r m s = when ((searcher ^. printStrategy) r) (T.hPutStrLn out (T.pack . show $ r ^. nummatches) *> traverse_ doPrint s *> hFlush out)   where-    go (a , (_ , m)) = SearchResult (Just t) a m+    out = searcher ^. outputHandle+    doPrint (ScoredMatchSized _ c v) =  (searcher ^. printer) out . (funcs ^. display) (const id) m (store ! c) $ v --- | One search event consisiting of the searcher reading a bytestring from the input named pipe. If the bytestring is empty the searcher exists. If not it---   outputs the search results to the output handle and also returns them.------   The first line of the output of results is the query. The second is an decimal integer @n@ which is the number of results to follow. There are @n@ more lines each---  contaning a result presented according the function supplied.-event :: SearchFunctions a -> (Handle -> [Text] -> IO ()) -- ^ The functions that determines how a results is presented. Must not introduce newlines.-          -> IOPipes -- ^ The handles to the named pipes-          -> V.Vector Text -- ^ The candidates-          -> SearchResult -- ^ The last search result-          -> IO (Maybe SearchResult) -- ^ The final result. The Nothing is for the case if the input was empty signalling that the searcher should exit.-event f g (IOPipes i o) v s = (\t -> if T.null t then pure Nothing else go t) . T.strip . decodeStringLenient =<< B.hGetLine i-  where-    go t     = (\s' -> pream s' *> V.mapM_ (g o) (s' ^. matches) *> hFlush o $> Just s') . response f v t $ s-    pream s' = B.hPutStrLn o (encodeString . fromMaybe "" $ s' ^. query) *> B.hPutStrLn o (show . V.length $ s' ^. matches)+pipedEnv :: KnownNat n => SearchFunctions a Text -> PipedSearcher -> Chunks n -> IO (SearchEnv n a Text)+pipedEnv funcs searcher = searchEnv funcs (searcher ^. maximumMatches) (printMatches funcs searcher) --- | Starts with the dummy `initialSearchResult` and handles `event` in a loop until the searcher receives an empty input and exits.-searchLoop :: SearchFunctions a -> (Handle -> [Text] -> IO ())  -> V.Vector Text -> IO ()-searchLoop f g v = withIOPipes (\p -> go p . Just . initialSearchResult $ v)+search :: KnownNat n => IO () -> Handle -> SearchEnv n a b -> IO ()+search fin inp env = finally (startSearcher env *> (loop =<< T.hGetLine inp)) fin   where-    go p = maybe (pure ()) (go p <=<  event f g p v)---- | The dummy `SearchResult` use as the initial value. Contains an empty query, all the indices and no matches.-initialSearchResult :: V.Vector Text -> SearchResult-initialSearchResult v = SearchResult Nothing (U.enumFromN 0 (V.length v)) V.empty---- | Outputs the parts of a matching candidate to handle as space separated double quoted strings alternating between a match and a gap. The first text is--- always a gap and can be empty the rest should be non-empty-showMatch :: Handle -> [Text] -> IO ()-showMatch o = B.hPutStrLn o . foldl' (\b n -> b <> " \"" <> encodeString n <> "\" ") ""+    loop ""    = stopSearcher env+    loop query = sendQuery env query *> (loop =<< T.hGetLine inp)  -- | Outputs a matching candidate for the terminal with the matches highlighted in blue. Uses the `Colored` `Text` monoid from `colorful-monoids` for coloring. showMatchColor :: Handle -> [Text] -> IO ()-showMatchColor o t = (hPrintColored (\h -> B.hPutStr h . encodeString) o Term8 . fst . foldl' go (Value "" , False) $ t) *> B.hPutStrLn o ""+showMatchColor o t = (hPrintColored (\h -> B.hPutStr h . encodeUtf8) o Term8 . fst . foldl' go (Value "" , False) $ t) *> B.hPutStrLn o ""   where     go (c , False) n = (c <> Value n , True)-    go (c , True ) n = (c <> Fg Blue (Value n) , False)+    go (c , True ) n = (c <> Style Bold (Fg Blue (Value n)) , False) +defSearcher :: Handle -> Handle -> PipedSearcher+defSearcher ih oh = PipedSearcher ih oh 4096 (\r -> r ^. ocassion == QueryDone) showMatchColor+ -- | Run an IO action that needs two handles to named pipes by creating two named pipes, opening the handles to them performing the action --   and then cleaning up by closing the handles and deleting the named pipes created. The names of the pipes are printed on the stdout and are of the --   form @\/tmp\/talash-input-pipe@ or @\/tmp\/talash-input-pipe\<n\>@ where n is an integer for the input-pipe and @\/tmp\/talash-output-pipe@ or --   @\/tmp\/talash-output-pipe\<n\>@ for the output pipe. The integer @n@ will be the same for both.-withIOPipes :: (IOPipes -> IO a) -> IO a-withIOPipes f = doAct =<< openP =<< ifM ((||) <$> fileExist i <*> fileExist o) (go 1) ((,) <$> mkp i <*> mkp o)+withNamedPipes :: (IO () -> Handle -> Handle -> IO a) -> IO a+withNamedPipes f = doAct =<< openP =<< ifM ((||) <$> fileExist i <*> fileExist o) (go 1) ((,) <$> mkp i <*> mkp o)   where     i = "/tmp/talash-input-pipe"     o = "/tmp/talash-output-pipe"-    doAct (fi , fo , p@(IOPipes ip op)) = finally (f p) (hClose ip *> hClose op *> removeFile fi *> removeFile fo)-    openP (ip , op) = (\h g -> (ip , op , IOPipes h g)) <$> openFile ip ReadWriteMode <*> openFile op ReadWriteMode+    doAct (fi , fo , ih , oh) = f (hClose ih *> hClose oh *> removeFile fi *> removeFile fo) ih oh+    openP (ip , op) = (\ih oh -> (ip , op , ih , oh)) <$> openFile ip ReadWriteMode <*> openFile op ReadWriteMode     mkp p = createNamedPipe p stdFileMode *> print p  $> p     go n = ifM ((||) <$> fileExist i' <*> fileExist o') (go $ n + 1) ((,) <$> mkp i' <*> mkp o')       where@@ -109,29 +84,25 @@         o' = o <> show n  -- | Run search create a new session for the searcher to run in, forks a process in which the `searchLoop` is run in the background and exits.-runSearch :: SearchFunctions a -> (Handle -> [Text] -> IO ()) -> V.Vector Text -> IO ()-runSearch f g v = createSession *> forkProcess (searchLoop f g v) *> exitImmediately ExitSuccess+runSearch :: KnownNat n => IO () -> SearchFunctions a Text -> PipedSearcher -> Chunks n -> IO ()+runSearch fin funcs searcher c = createSession *> forkProcess (search fin (searcher ^. inputHandle) =<< pipedEnv funcs searcher c) *> exitImmediately ExitSuccess  -- | Version of `runSearch` in which the vector of candidates is built by reading lines from stdin.-runSearchStdIn :: SearchFunctions a -> (Handle -> [Text] -> IO ()) -> IO ()-runSearchStdIn f g = runSearch f g . getCompact =<< compact . V.force =<< readVectorStdIn+runSearchStdIn :: KnownNat n => Proxy n -> IO () -> SearchFunctions a Text -> PipedSearcher -> IO ()+runSearchStdIn p fin funcs searcher = runSearch fin funcs searcher . getCompact =<< compact . forceChunks =<< chunksFromHandle p stdin  -- | Version of `runSearchStdIn` which uses `showMatch` to put the output on the handle.-runSearchStdInDef :: SearchFunctions a -> IO ()-runSearchStdInDef f = runSearchStdIn f showMatch---- | Version of `runSearchStdIn` for viewing the matches on a terminal which uses `showMatchColor` to put the output on the handle.-runSearchStdInColor :: SearchFunctions a -> IO ()-runSearchStdInColor f = runSearchStdIn f showMatchColor+runSearchStdInDef :: SearchFunctions a Text -> IO ()+runSearchStdInDef funcs = withNamedPipes (\fin ih -> runSearchStdIn (Proxy :: Proxy 32) fin funcs . defSearcher ih) -- runSearchStdIn f showMatch  -- Send a query to the searcher by writing the text in the second argument to the named-pipe with path given by the first argument. -- Does not check if the file is a named pipe. send :: String -> Text -> IO ()-send i q = ifM (fileExist i) (withFile i WriteMode (`B.hPutStrLn` encodeString q)) (putStrLn . convertString $ "the named pipe" <> i <> " does not exist")+send i q = ifM (fileExist i) (withFile i WriteMode (`B.hPutStrLn` encodeUtf8 q)) (putStrLn $ "the named pipe" <> T.pack i <> " does not exist")  -- Read the results from the searcher from the named pipe with the path given as the argument. Does not check if the file exists or is a named pipe. recieve :: String -> IO ()-recieve o = withFile o ReadMode (\h -> B.hGetLine h *> (go h . readMaybe . B.unpack =<< B.hGetLine h))+recieve o = withFile o ReadMode (\h -> (go h . readMaybe . B.unpack =<< B.hGetLine h))   where     go h = maybe (putStrLn "Couldn't read the number of results.") (\n -> replicateM_ n (B.putStrLn =<< B.hGetLine h)) @@ -144,12 +115,12 @@  -- | run' is the backend of `run` which is just `run\' =<< getArgs` run' :: [String] -> IO ()-run' ["load"]               = runSearchStdInColor searchFunctionsOL-run' ["load" , "fuzzy"]     = runSearchStdInColor searchFunctionsFuzzy-run' ["load" , "orderless"] = runSearchStdInColor searchFunctionsOL-run' ["find" , x]           = askSearcher "/tmp/talash-input-pipe"  "/tmp/talash-output-pipe" . convertString $ x-run' ["find" , n , x]       = askSearcher ("/tmp/talash-input-pipe" <> n)  ("/tmp/talash-output-pipe" <> n) . convertString $ x-run' ["find" , i , o , x]   = askSearcher i o . convertString $ x+run' ["load"]               = runSearchStdInDef (orderlessFunctions IgnoreCase)+run' ["load" , "fuzzy"]     = runSearchStdInDef (fuzzyFunctions IgnoreCase)+run' ["load" , "orderless"] = runSearchStdInDef (orderlessFunctions IgnoreCase)+run' ["find" , x]           = askSearcher "/tmp/talash-input-pipe"  "/tmp/talash-output-pipe" . T.pack $ x+run' ["find" , n , x]       = askSearcher ("/tmp/talash-input-pipe" <> n)  ("/tmp/talash-output-pipe" <> n) . T.pack $ x+run' ["find" , i , o , x]   = askSearcher i o . T.pack $ x run' ["exit"]               = askSearcher "/tmp/talash-input-pipe"  "/tmp/talash-output-pipe" "" run' ["exit" , n]           = askSearcher ("/tmp/talash-input-pipe" <> n)  ("/tmp/talash-output-pipe" <> n) "" run' ["exit" , i , o]       = askSearcher i o ""

@@ -0,0 +1,39 @@+-- |+{-# LANGUAGE  GeneralizedNewtypeDeriving #-}+{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE RankNTypes #-}+{-# LANGUAGE ExistentialQuantification #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE  MultiParamTypeClasses #-}+++module Talash.ScoredMatch (ChunkIndex (..) , ScoredMatchSized (..) , emptyMatch) where++import Talash.Intro+import Data.Vector.Unboxed.Deriving+import GHC.TypeNats+import qualified Data.Vector.Unboxed.Sized as S++data ChunkIndex = ChunkIndex {number :: {-# UNPACK #-} !Int , index :: {-# UNPACK #-} !Int} deriving (Eq , Ord , Show)++derivingUnbox "ChunkIndex"+    [t| ChunkIndex -> (Int , Int) |]+    [|\(ChunkIndex i j) -> (i,j)|]+    [|\(i,j) -> ChunkIndex i j|]++data ScoredMatchSized (n::Nat) = ScoredMatchSized { score :: {-# UNPACK #-} !(Down Int), chunkIndex :: {-# UNPACK #-} !ChunkIndex+                                                  , matchData :: {-# UNPACK #-} !(S.Vector n Int)} deriving (Show)++derivingUnbox "ScoredMatchSized"+    [t| forall (n::Nat). KnownNat n => ScoredMatchSized n -> (Int , Int , Int , S.Vector n Int) |]+    [| \(ScoredMatchSized (Down s) (ChunkIndex i j) m) -> (s, i , j , m) |]+    [| \(s, i , j , m) -> ScoredMatchSized (Down s) (ChunkIndex i j) m |]++instance Eq (ScoredMatchSized n) where+  (ScoredMatchSized s i _) == (ScoredMatchSized t j _) = s == t && i == j++instance Ord (ScoredMatchSized n) where+  compare (ScoredMatchSized s i _) (ScoredMatchSized t j _) = compare (s,i) (t,j)++emptyMatch :: Int -> Int -> ScoredMatchSized 0+emptyMatch i j = ScoredMatchSized 0 (ChunkIndex i j) S.empty

@@ -0,0 +1,80 @@+-- |++module Talash.SimpleSearcher where++import Control.Concurrent (forkIO, threadDelay)+import Control.Concurrent.MVar+import qualified Data.ByteString.Char8 as B+import Data.Monoid.Colorful+import qualified Data.Text as T+import Data.Text.AhoCorasick.Automaton (CaseSensitivity(..))+import qualified Data.Vector as V+import GHC.TypeLits+import Lens.Micro+import qualified System.IO.Streams as I+import Talash.Chunked+import Talash.Core hiding (match , makeMatcher)+import Talash.Files+import Talash.Intro hiding (splitAt)+import Talash.ScoredMatch+import GHC.Compact (Compact , compact , getCompact)++data SimpleSearcher = SimpleSearcher {terms :: [Text] , sleepTime :: Int , matchesToPrint :: Int}++-- | Outputs a matching candidate for the terminal with the matches highlighted in blue. Uses the `Colored` `Text` monoid from `colorful-monoids` for coloring.+showMatchColor :: Handle -> [Text] -> IO ()+showMatchColor o t = (hPrintColored (\h -> B.hPutStr h . encodeUtf8) o Term8 . fst . foldl' go (Value "" , False) $ t) *> B.hPutStrLn o ""+  where+    go (c , False) n = (c <> Value n , True)+    go (c , True ) n = (c <> Style Bold (Fg Blue (Value n)) , False)++printMatches :: forall n m a. (KnownNat n , KnownNat m) => SearchFunctions a Text -> Chunks n -> SearchReport -> MatcherSized m a -> MatchSetSized m -> IO ()+printMatches funcs store r m s = when (o == QueryDone || o == NewQuery) (putStrLn $ (T.pack . show $ n) <> " Matches for this round.\n")+  where+    o = r ^. ocassion+    n = r ^. nummatches++printMatchesMvar :: forall n m a. (KnownNat n , KnownNat m) => SearchFunctions a Text -> MVar () -> Chunks n -> SearchReport -> MatcherSized m a -> MatchSetSized m -> IO ()+printMatchesMvar funcs v store r m s = when (r ^. ocassion == QueryDone) (putMVar v () *> putStrLn ((T.pack . show $ r ^. nummatches) <> " matches for this round.")+                                                  *> traverse_ (\(ScoredMatchSized _ c v) -> showMatchColor stdout . (funcs ^. display) (const id) m (store ! c) $ v) s)++simpleFuzzyEnv :: KnownNat n => Int -> Proxy n -> V.Vector Text -> IO (SearchEnv n MatchPart Text)+simpleFuzzyEnv n _ = searchEnv (fuzzyFunctions IgnoreCase) n (printMatches (fuzzyFunctions IgnoreCase)) . makeChunks++simpleFuzzyEnvM :: KnownNat n => MVar () -> Int -> Proxy n -> V.Vector Text -> IO (SearchEnv n MatchPart Text)+simpleFuzzyEnvM m n _ = searchEnv (fuzzyFunctions IgnoreCase) n (printMatchesMvar (fuzzyFunctions IgnoreCase) m) . makeChunks++simpleFuzzyEnvMI :: KnownNat n => MVar () -> Int -> Proxy n -> Chunks n -> IO (SearchEnv n MatchPart Text)+simpleFuzzyEnvMI m n _ = searchEnv (fuzzyFunctions IgnoreCase) n (printMatchesMvar (fuzzyFunctions IgnoreCase) m)++runSimpleSearcherWithEnv :: KnownNat n => SimpleSearcher -> SearchEnv n MatchPart Text -> IO ()+runSimpleSearcherWithEnv s env = forkIO (searchLoop env) *> traverse_ (doSearch . Just) (terms s) *> doSearch Nothing+  where+    doSearch term = putMVar (env ^. query) term *> threadDelay (sleepTime s)++runSimpleSearcher :: KnownNat n => Proxy n -> SimpleSearcher -> V.Vector Text -> IO ()+runSimpleSearcher p s v = runSimpleSearcherWithEnv s =<< simpleFuzzyEnv (matchesToPrint s) p v++runSimpleSearcherWithEnvM :: KnownNat n => SimpleSearcher -> MVar () -> SearchEnv n MatchPart Text -> IO ()+runSimpleSearcherWithEnvM s v env = forkIO (searchLoop env) *> traverse_ doSearch (terms s) *> putMVar (env ^. query) Nothing+  where+    doSearch term = unless (term == "") $ putMVar (env ^. query) (Just term) *> takeMVar v++runSimpleSearcherM :: KnownNat n => Proxy n -> SimpleSearcher -> V.Vector Text -> IO ()+runSimpleSearcherM p s v = (\mvar -> runSimpleSearcherWithEnvM s mvar =<< simpleFuzzyEnvM mvar (matchesToPrint s) p v) =<< newEmptyMVar++runSimpleSearcherMI :: KnownNat n => Proxy n -> SimpleSearcher -> Chunks n -> IO ()+runSimpleSearcherMI p s v = (\mvar -> runSimpleSearcherWithEnvM s mvar =<< simpleFuzzyEnvMI mvar (matchesToPrint s) p v) =<< newEmptyMVar++testVector :: IO (V.Vector Text)+testVector = I.toVector =<< I.decodeUtf8 =<< I.lines I.stdin++simpleSearcherTest :: IO ()+simpleSearcherTest = runSimpleSearcherMI (Proxy :: Proxy 64)+                                         (SimpleSearcher [ "m" , "ma" , "mal" , "malda" , "maldac" , "maldace" , "maldacen" , "maldacena" , "maldacenaf" , "maldacenafi" , "maldacenafiv" , "maldacenafive"+                                                         , "maldacenafiv"+                                                         , "w" , "wi" , "wit" , "witt" , "witte" , "witten" , "f" , "fr" , "fra" , "fran" , "franc" , "franco"+                                                         , "c" , "cl" , "clo" , "clos" , "closs" , "closse" , "closset" , "s" , "se" , "sen"+                                                        ] 25000 256)+                                         . forceChunks =<< chunksFromStream =<< I.decodeUtf8 =<< I.lines I.stdin+-- simpleSearcherTest = runSimpleSearcher (Proxy :: Proxy 32) (SimpleSearcher ["suse", "linux" , "binary" , "close" , "Witten" , "Maldacena" , "Franco" , "Closset"] 100000 1024) =<< testVector

@@ -1,6 +1,8 @@ cabal-version:      2.4 name:               talash-version:            0.1.1.1+version:            0.3.0+Homepage:           https://github.com/aikrahguzar/talash+Bug-reports:        https://github.com/aikrahguzar/talash/issues  -- A short (one-line) description of the package. synopsis: Line oriented fast enough text search@@ -20,13 +22,7 @@              .              The is also a demo executable for both the brick app and piped version that gets the candidates for the @stdin@. Use @talash help@ for usage information.              .-             Some care has been taken to make the searcher performant. On my laptop searching using the tui app to search all files in my @\/usr\/local@ with-             @60K@ items, the search results appear almost instantly. Searching among about @340K@ files in @\/usr\/share@ there is some but bearable lag-             between the keypresses and the search results. While searching between @1264K@ files, that @fd@ finds from @\/@ there is a lag of a second or so-             before the results appear. The three scenarios consume about @50 MiB@ , @130 MiB@ and @500 MiB@ of memory respectively which is almost entirely due-             to the @Vector Text@ storing the candidates.-             .-             The nice string matching interface provided by [alfred-margaret](https:\/\/hackage.haskell.org\/package\/alfred-margaret) is responsible for a+             Some care has been taken to make the searcher performant. The nice string matching interface provided by [alfred-margaret](https:\/\/hackage.haskell.org\/package\/alfred-margaret) is responsible for a              big part of the performance. While [vector-sized](https:\/\/hackage.haskell.org\/package\/vector-sized) is responsible for most of memory              efficieny. Performance can potentially be further improved by using all the cores but it is good enough for my typical use cases of searching among              a few thousand or at most a few tens of thousands of candidates. As a result parallel matching is unlikely to be implemented.@@ -45,7 +41,7 @@ author: Rahguzar  -- An email address to which users can send suggestions, bug reports, and patches.-maintainer: aikrahguzar@gmail.com+maintainer: rahguzar@zohomail.eu  -- A copyright notice. -- copyright:@@ -56,31 +52,40 @@     exposed-modules:                     Talash.Brick                     Talash.Brick.Columns+                    Talash.Chunked                     Talash.Core                     Talash.Files+                    Talash.SimpleSearcher                     Talash.Piped      -- Modules included in this library but not exported.-    other-modules: Talash.Internal Talash.Brick.Internal+    other-modules: Talash.Brick.Internal Talash.ScoredMatch Talash.Intro     default-extensions: DeriveGeneric OverloadedStrings NoImplicitPrelude BangPatterns TupleSections ScopedTypeVariables DeriveFunctor DataKinds KindSignatures-    other-extensions: TemplateHaskell ExistentialQuantification RankNTypes+    other-extensions: TemplateHaskell ExistentialQuantification RankNTypes GeneralizedNewtypeDeriving     build-depends:base                    >=  4.10.1 && < 5,-                  alfred-margaret         ^>= 1.1.1.0,-                  brick                   >=  0.60 && < 0.70,-                  bytestring              >=  0.10.8 && < 0.11,+                  alfred-margaret         ^>= 2.0,+                  bitvec,+                  brick                   >=  1.0 && < 1.2,+                  bytestring              >=  0.10.8 && < 0.12,                   colorful-monoids        >=  0.2.1 && < 0.3,+                  containers,+                  directory,+                  extra,                   ghc-compact             >=  0.1.0 && < 0.3,-                  directory               >=  1.3.6 && < 1.4,-                  intro                   >=  0.4.0 && < 0.10,+                  io-streams,                   microlens               >=  0.4.0 && < 0.5,                   microlens-th            >=  0.4.0 && < 0.5,-                  text                    >=  1.2.3 && < 1.3,+                  mtl,+                  primitive,+                  safe,+                  text                    ^>= 2.0,                   unix                    >=  2.7.2 && < 2.8,                   unordered-containers    >=  0.2.9 && < 0.3,                   vector                  ^>= 0.12.1,                   vector-algorithms       ^>= 0.8.0.3,                   vector-sized            >=  1.4.0 && < 1.5,-                  vty                     ^>= 5.33+                  vector-th-unbox,+                  vty                     >= 5.36      ghc-options:     hs-source-dirs:   src@@ -93,7 +98,6 @@     -- other-modules:     build-depends:         base                    >= 4.10.1 && < 5,-        intro                   >= 0.4.0  && < 0.10,         talash      ghc-options: -threaded -rtsopts