{-# LANGUAGE TemplateHaskell #-} -- | A simple brick app to search among the candidates from a vector of text and get the selection. By default the app doesn't do anything except -- 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 (..) -- * The Brick App and Helpers , searchApp , defSettings , searchFunctionsFuzzy , searchFunctionsOL , runApp , runAppFromHandle , selected , selectedFromHandle , selectedFromHandleWith , selectedFromFileNamesSorted , selectedFromFiles , runSearch -- * Default program , run , run' -- * Lenses -- ** Searcher , query , prevQuery , allMatches , matches , numMatches , wait -- ** 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 , readVectorStdIn , readVectorHandle , readVectorHandleWith , emptyIndices) 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 GHC.Compact (Compact , compact , getCompact) import Intro hiding (sort, on,replicate , take , modify) import System.Environment (getArgs) 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)} 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 -- `listSelectedAttr` , `borderAttr` , \"Prompt\" , \"Highlight\" and \"Stats\" , _borderStyle :: BorderStyle -- ^ The border style to use. By default `unicodeRounded` } 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 -- | 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) 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)] 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})) -- | 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} 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} -- | 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 -- | 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 -- | 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 -- | 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 -- | 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 -- | 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 -- | 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 -- | 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 -- | The backend for `run` run' :: [String] -> IO () run' [] = runSearch defSettings searchFunctionsOL run' ["fuzzy"] = runSearch defSettings searchFunctionsFuzzy run' ["orderless"] = runSearch defSettings searchFunctionsOL run' xs = (\t -> C.printColored putStr t usageString) =<< C.getTerm usageString :: Colored Text usageString = "talash tui is a set of command for a tui searcher/selector interface. It reads the input from the stdin to generate candidates to search for," <> " one from each line and outputs the selected candidate (if there is one) on the stdout.\n" <> C.Fg C.Blue "talash tui" <> ": Run the tui with the default orderless style of searching.\n" <> C.Fg C.Blue "talash tui fuzzy" <> ": Run the tui with fuzzy style for searching.\n" <> C.Fg C.Blue "talash tui orderless" <> ": Run the tui with the default orderless style of searching.\n" -- | Defualt program for the brick app that reads candidates from stdin and prints the selected text to the stdout. Can be called from the executable with -- @talash tui@ which uses the orderless style. The search style can be set explicitly by calling @talash tui fuzzy@ or @talash tui orderless@ run :: IO () run = run' =<< getArgs