{-# 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.
                             Searcher a -> Editor Text Bool
_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.
                           , Searcher a -> Maybe Text
_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`
                           , Searcher a -> IORef (Vector Int)
_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.
                           , Searcher a -> List Bool [Text]
_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.
                           , Searcher a -> Int
_numMatches :: Int
                           -- | ThreadId of the thread currently computing matches. Nothing if there is no such thread.
                           , Searcher a -> Maybe ThreadId
_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.
                           , Searcher a -> a
_extension :: a} deriving (a -> Searcher b -> Searcher a
(a -> b) -> Searcher a -> Searcher b
(forall a b. (a -> b) -> Searcher a -> Searcher b)
-> (forall a b. a -> Searcher b -> Searcher a) -> Functor Searcher
forall a b. a -> Searcher b -> Searcher a
forall a b. (a -> b) -> Searcher a -> Searcher b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> Searcher b -> Searcher a
$c<$ :: forall a b. a -> Searcher b -> Searcher a
fmap :: (a -> b) -> Searcher a -> Searcher b
$cfmap :: forall a b. (a -> b) -> Searcher a -> Searcher b
Functor)
makeLenses ''Searcher

data SearchEvent = SearchEvent {
                     -- | The matches received.
                     SearchEvent -> Vector [Text]
_matchedTop :: Vector [Text] ,
                     -- | The (maximum possible) number of matches. See the note on `_numMatches`.
                     SearchEvent -> Int
_totalMatches :: Int ,
                     -- | The term which was searched for.
                     SearchEvent -> Maybe Text
_term :: Maybe Text}
makeLenses ''SearchEvent

-- | The constant environment in which the search app runs.
data SearchEnv a = SearchEnv { SearchEnv a -> SearchFunctions a
_searchFunctions :: SearchFunctions a  -- ^ The functions used to find and display matches.
                             , SearchEnv a -> Vector Text
_candidates :: Vector Text -- ^ The vector of candidates.
                             , SearchEnv a -> BChan SearchEvent
_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 { EventHooks a -> Key -> [Modifier] -> a -> EventM Bool (Next a)
keyHook :: Key -> [Modifier] -> a -> EventM Bool (Next a)
                               , EventHooks a -> ByteString -> a -> EventM Bool (Next a)
pasteHook :: ByteString -> a -> EventM Bool (Next a)
                               , EventHooks a -> Int -> Int -> a -> EventM Bool (Next a)
resizeHook :: Int -> Int -> a -> EventM Bool (Next a)
                               , EventHooks a
-> Int -> Int -> Button -> [Modifier] -> a -> EventM Bool (Next a)
mouseDownHook :: Int -> Int -> Button -> [Modifier] -> a -> EventM Bool (Next a)
                               , EventHooks a
-> Int -> Int -> Maybe Button -> a -> EventM Bool (Next a)
mouseUpHook   :: Int -> Int -> Maybe Button -> a -> EventM Bool (Next a)
                               , EventHooks a -> a -> EventM Bool (Next a)
focusLostHook :: a -> EventM Bool (Next a)
                               , EventHooks a -> a -> EventM Bool (Next a)
focusGainedHook :: a -> EventM Bool (Next a)}

data AppTheme = AppTheme { AppTheme -> Text
_prompt :: Text -- ^ The prompt to display next to the editor.
                         , AppTheme -> [(AttrName, Attr)]
_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\"
                         , AppTheme -> BorderStyle
_borderStyle :: BorderStyle -- ^ The border style to use. By default `unicodeRounded`
                         }
makeLenses ''AppTheme

data AppSettings a b = AppSettings { AppSettings a b -> AppTheme
_theme :: AppTheme
                                 , AppSettings a b -> ReaderT (SearchEnv a) EventHooks (Searcher b)
_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 a
defHooks = (Key -> [Modifier] -> a -> EventM Bool (Next a))
-> (ByteString -> a -> EventM Bool (Next a))
-> (Int -> Int -> a -> EventM Bool (Next a))
-> (Int
    -> Int -> Button -> [Modifier] -> a -> EventM Bool (Next a))
-> (Int -> Int -> Maybe Button -> a -> EventM Bool (Next a))
-> (a -> EventM Bool (Next a))
-> (a -> EventM Bool (Next a))
-> EventHooks a
forall a.
(Key -> [Modifier] -> a -> EventM Bool (Next a))
-> (ByteString -> a -> EventM Bool (Next a))
-> (Int -> Int -> a -> EventM Bool (Next a))
-> (Int
    -> Int -> Button -> [Modifier] -> a -> EventM Bool (Next a))
-> (Int -> Int -> Maybe Button -> a -> EventM Bool (Next a))
-> (a -> EventM Bool (Next a))
-> (a -> EventM Bool (Next a))
-> EventHooks a
EventHooks ((a -> EventM Bool (Next a))
-> [Modifier] -> a -> EventM Bool (Next a)
forall a b. a -> b -> a
const ((a -> EventM Bool (Next a))
 -> [Modifier] -> a -> EventM Bool (Next a))
-> (Key -> a -> EventM Bool (Next a))
-> Key
-> [Modifier]
-> a
-> EventM Bool (Next a)
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (a -> EventM Bool (Next a)) -> Key -> a -> EventM Bool (Next a)
forall a b. a -> b -> a
const a -> EventM Bool (Next a)
forall s n. s -> EventM n (Next s)
continue) ((a -> EventM Bool (Next a))
-> ByteString -> a -> EventM Bool (Next a)
forall a b. a -> b -> a
const a -> EventM Bool (Next a)
forall s n. s -> EventM n (Next s)
continue) ((a -> EventM Bool (Next a)) -> Int -> a -> EventM Bool (Next a)
forall a b. a -> b -> a
const ((a -> EventM Bool (Next a)) -> Int -> a -> EventM Bool (Next a))
-> (Int -> a -> EventM Bool (Next a))
-> Int
-> Int
-> a
-> EventM Bool (Next a)
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (a -> EventM Bool (Next a)) -> Int -> a -> EventM Bool (Next a)
forall a b. a -> b -> a
const a -> EventM Bool (Next a)
forall s n. s -> EventM n (Next s)
continue) ((Button -> [Modifier] -> a -> EventM Bool (Next a))
-> Int -> Button -> [Modifier] -> a -> EventM Bool (Next a)
forall a b. a -> b -> a
const ((Button -> [Modifier] -> a -> EventM Bool (Next a))
 -> Int -> Button -> [Modifier] -> a -> EventM Bool (Next a))
-> (Int -> Button -> [Modifier] -> a -> EventM Bool (Next a))
-> Int
-> Int
-> Button
-> [Modifier]
-> a
-> EventM Bool (Next a)
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. ([Modifier] -> a -> EventM Bool (Next a))
-> Button -> [Modifier] -> a -> EventM Bool (Next a)
forall a b. a -> b -> a
const (([Modifier] -> a -> EventM Bool (Next a))
 -> Button -> [Modifier] -> a -> EventM Bool (Next a))
-> (Int -> [Modifier] -> a -> EventM Bool (Next a))
-> Int
-> Button
-> [Modifier]
-> a
-> EventM Bool (Next a)
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (a -> EventM Bool (Next a))
-> [Modifier] -> a -> EventM Bool (Next a)
forall a b. a -> b -> a
const ((a -> EventM Bool (Next a))
 -> [Modifier] -> a -> EventM Bool (Next a))
-> (Int -> a -> EventM Bool (Next a))
-> Int
-> [Modifier]
-> a
-> EventM Bool (Next a)
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (a -> EventM Bool (Next a)) -> Int -> a -> EventM Bool (Next a)
forall a b. a -> b -> a
const a -> EventM Bool (Next a)
forall s n. s -> EventM n (Next s)
continue)
                                ((Maybe Button -> a -> EventM Bool (Next a))
-> Int -> Maybe Button -> a -> EventM Bool (Next a)
forall a b. a -> b -> a
const ((Maybe Button -> a -> EventM Bool (Next a))
 -> Int -> Maybe Button -> a -> EventM Bool (Next a))
-> (Int -> Maybe Button -> a -> EventM Bool (Next a))
-> Int
-> Int
-> Maybe Button
-> a
-> EventM Bool (Next a)
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (a -> EventM Bool (Next a))
-> Maybe Button -> a -> EventM Bool (Next a)
forall a b. a -> b -> a
const ((a -> EventM Bool (Next a))
 -> Maybe Button -> a -> EventM Bool (Next a))
-> (Int -> a -> EventM Bool (Next a))
-> Int
-> Maybe Button
-> a
-> EventM Bool (Next a)
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (a -> EventM Bool (Next a)) -> Int -> a -> EventM Bool (Next a)
forall a b. a -> b -> a
const a -> EventM Bool (Next a)
forall s n. s -> EventM n (Next s)
continue) a -> EventM Bool (Next a)
forall s n. s -> EventM n (Next s)
continue a -> EventM Bool (Next a)
forall s n. s -> EventM n (Next s)
continue
-- This is a comment
-- | Get the current query from the editor of the searcher.
makeQuery :: Searcher a -> Maybe Text
makeQuery :: Searcher a -> Maybe Text
makeQuery Searcher a
s = [Text] -> Maybe Text
forall a. [a] -> Maybe a
headMay ([Text] -> Maybe Text)
-> (Editor Text Bool -> [Text]) -> Editor Text Bool -> Maybe Text
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Editor Text Bool -> [Text]
forall t n. Monoid t => Editor t n -> [t]
getEditContents (Editor Text Bool -> Maybe Text) -> Editor Text Bool -> Maybe Text
forall a b. (a -> b) -> a -> b
$ Searcher a
s Searcher a
-> Getting (Editor Text Bool) (Searcher a) (Editor Text Bool)
-> Editor Text Bool
forall s a. s -> Getting a s a -> a
^. Getting (Editor Text Bool) (Searcher a) (Editor Text Bool)
forall a. Lens' (Searcher a) (Editor Text Bool)
query

-- | Quit without any selection.
haltQuit :: Searcher a -> EventM n (Next (Searcher a))
haltQuit :: Searcher a -> EventM n (Next (Searcher a))
haltQuit = Searcher a -> EventM n (Next (Searcher a))
forall s n. s -> EventM n (Next s)
halt (Searcher a -> EventM n (Next (Searcher a)))
-> (Searcher a -> Searcher a)
-> Searcher a
-> EventM n (Next (Searcher a))
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (((List Bool [Text] -> Identity (List Bool [Text]))
-> Searcher a -> Identity (Searcher a)
forall a. Lens' (Searcher a) (List Bool [Text])
matches ((List Bool [Text] -> Identity (List Bool [Text]))
 -> Searcher a -> Identity (Searcher a))
-> ((Maybe Int -> Identity (Maybe Int))
    -> List Bool [Text] -> Identity (List Bool [Text]))
-> (Maybe Int -> Identity (Maybe Int))
-> Searcher a
-> Identity (Searcher a)
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (Maybe Int -> Identity (Maybe Int))
-> List Bool [Text] -> Identity (List Bool [Text])
forall n (t :: * -> *) e. Lens' (GenericList n t e) (Maybe Int)
listSelectedL) ((Maybe Int -> Identity (Maybe Int))
 -> Searcher a -> Identity (Searcher a))
-> Maybe Int -> Searcher a -> Searcher a
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Maybe Int
forall a. Maybe a
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 :: SearchEnv a
-> Key
-> [Modifier]
-> Searcher b
-> EventM Bool (Next (Searcher b))
handleKeyEvent e :: SearchEnv a
e@(SearchEnv SearchFunctions a
fs Vector Text
v BChan SearchEvent
b) Key
k [Modifier]
m Searcher b
s
  | Key
k Key -> Key -> Bool
forall a. Eq a => a -> a -> Bool
== Key
KEnter                                  , [Modifier] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Modifier]
m = Searcher b -> EventM Bool (Next (Searcher b))
forall s n. s -> EventM n (Next s)
halt Searcher b
s
  | Key
k Key -> Key -> Bool
forall a. Eq a => a -> a -> Bool
== Key
KEsc                                    , [Modifier] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Modifier]
m = Searcher b -> EventM Bool (Next (Searcher b))
forall a n. Searcher a -> EventM n (Next (Searcher a))
haltQuit Searcher b
s
  | Key
k Key -> [Key] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Key
KUp , Key
KDown , Key
KPageUp , Key
KPageDown] , [Modifier] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Modifier]
m = Searcher b -> EventM Bool (Next (Searcher b))
forall s n. s -> EventM n (Next s)
continue (Searcher b -> EventM Bool (Next (Searcher b)))
-> EventM Bool (Searcher b) -> EventM Bool (Next (Searcher b))
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Searcher b
-> Lens' (Searcher b) (List Bool [Text])
-> (Event -> List Bool [Text] -> EventM Bool (List Bool [Text]))
-> Event
-> EventM Bool (Searcher b)
forall a b e n.
a -> Lens' a b -> (e -> b -> EventM n b) -> e -> EventM n a
handleEventLensed Searcher b
s forall a. Lens' (Searcher a) (List Bool [Text])
Lens' (Searcher b) (List Bool [Text])
matches Event -> List Bool [Text] -> EventM Bool (List Bool [Text])
forall (t :: * -> *) n e.
(Foldable t, Splittable t, Ord n) =>
Event -> GenericList n t e -> EventM n (GenericList n t e)
handleListEvent (Key -> [Modifier] -> Event
EvKey Key
k [Modifier]
m)
  | Bool
otherwise                                             = Searcher b -> EventM Bool (Next (Searcher b))
forall s n. s -> EventM n (Next s)
continue (Searcher b -> EventM Bool (Next (Searcher b)))
-> EventM Bool (Searcher b) -> EventM Bool (Next (Searcher b))
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< IO (Searcher b) -> EventM Bool (Searcher b)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Searcher b) -> EventM Bool (Searcher b))
-> (Searcher b -> IO (Searcher b))
-> Searcher b
-> EventM Bool (Searcher b)
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. SearchEnv a -> Searcher b -> IO (Searcher b)
forall a b. SearchEnv a -> Searcher b -> IO (Searcher b)
editStep SearchEnv a
e (Searcher b -> EventM Bool (Searcher b))
-> EventM Bool (Searcher b) -> EventM Bool (Searcher b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Searcher b
-> Lens' (Searcher b) (Editor Text Bool)
-> (Event -> Editor Text Bool -> EventM Bool (Editor Text Bool))
-> Event
-> EventM Bool (Searcher b)
forall a b e n.
a -> Lens' a b -> (e -> b -> EventM n b) -> e -> EventM n a
handleEventLensed Searcher b
s forall a. Lens' (Searcher a) (Editor Text Bool)
Lens' (Searcher b) (Editor Text Bool)
query Event -> Editor Text Bool -> EventM Bool (Editor Text Bool)
forall t n.
(DecodeUtf8 t, Eq t, Monoid t) =>
Event -> Editor t n -> EventM n (Editor t n)
handleEditorEvent (Key -> [Modifier] -> Event
EvKey Key
k [Modifier]
m)

-- | Handle a search event by updating `_numMatches` , `_matches` and `_wait`.
handleSearch :: Vector Text -> Searcher a -> SearchEvent -> EventM Bool (Next (Searcher a))
handleSearch :: Vector Text
-> Searcher a -> SearchEvent -> EventM Bool (Next (Searcher a))
handleSearch Vector Text
v Searcher a
s SearchEvent
e = Searcher a -> EventM Bool (Next (Searcher a))
forall s n. s -> EventM n (Next s)
continue (Searcher a -> EventM Bool (Next (Searcher a)))
-> (Searcher a -> Searcher a)
-> Searcher a
-> EventM Bool (Next (Searcher a))
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. ((Int -> Identity Int) -> Searcher a -> Identity (Searcher a)
forall a. Lens' (Searcher a) Int
numMatches ((Int -> Identity Int) -> Searcher a -> Identity (Searcher a))
-> Int -> Searcher a -> Searcher a
forall s t a b. ASetter s t a b -> b -> s -> t
.~ SearchEvent
e SearchEvent -> Getting Int SearchEvent Int -> Int
forall s a. s -> Getting a s a -> a
^. Getting Int SearchEvent Int
Lens' SearchEvent Int
totalMatches) (Searcher a -> Searcher a)
-> (Searcher a -> Searcher a) -> Searcher a -> Searcher a
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. ((List Bool [Text] -> Identity (List Bool [Text]))
-> Searcher a -> Identity (Searcher a)
forall a. Lens' (Searcher a) (List Bool [Text])
matches ((List Bool [Text] -> Identity (List Bool [Text]))
 -> Searcher a -> Identity (Searcher a))
-> (List Bool [Text] -> List Bool [Text])
-> Searcher a
-> Searcher a
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ Vector [Text] -> Maybe Int -> List Bool [Text] -> List Bool [Text]
forall (t :: * -> *) e n.
(Foldable t, Splittable t) =>
t e -> Maybe Int -> GenericList n t e -> GenericList n t e
listReplace (SearchEvent
e SearchEvent
-> Getting (Vector [Text]) SearchEvent (Vector [Text])
-> Vector [Text]
forall s a. s -> Getting a s a -> a
^. Getting (Vector [Text]) SearchEvent (Vector [Text])
Lens' SearchEvent (Vector [Text])
matchedTop) Maybe Int
forall a. Maybe a
Nothing) (Searcher a -> Searcher a)
-> (Searcher a -> Searcher a) -> Searcher a -> Searcher a
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. ((Maybe ThreadId -> Identity (Maybe ThreadId))
-> Searcher a -> Identity (Searcher a)
forall a. Lens' (Searcher a) (Maybe ThreadId)
wait ((Maybe ThreadId -> Identity (Maybe ThreadId))
 -> Searcher a -> Identity (Searcher a))
-> Maybe ThreadId -> Searcher a -> Searcher a
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Maybe ThreadId
forall a. Maybe a
Nothing) (Searcher a -> EventM Bool (Next (Searcher a)))
-> Searcher a -> EventM Bool (Next (Searcher a))
forall a b. (a -> b) -> a -> b
$ Searcher a
s

-- | The brick widget used to display the editor and the search result.
searcherWidget :: Text -> Text -> Searcher a -> Widget Bool
searcherWidget :: Text -> Text -> Searcher a -> Widget Bool
searcherWidget Text
p Text
n Searcher a
s = Widget Bool -> Widget Bool
forall n. Widget n -> Widget n
joinBorders (Widget Bool -> Widget Bool)
-> (Widget Bool -> Widget Bool) -> Widget Bool -> Widget Bool
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Widget Bool -> Widget Bool
forall n. Widget n -> Widget n
border (Widget Bool -> Widget Bool) -> Widget Bool -> Widget Bool
forall a b. (a -> b) -> a -> b
$    Bool -> Text -> Editor Text Bool -> Widget Bool -> Widget Bool
forall n.
(Ord n, Show n) =>
Bool -> Text -> Editor Text n -> Widget n -> Widget n
searchWidgetAux Bool
True Text
p (Searcher a
s Searcher a
-> Getting (Editor Text Bool) (Searcher a) (Editor Text Bool)
-> Editor Text Bool
forall s a. s -> Getting a s a -> a
^. Getting (Editor Text Bool) (Searcher a) (Editor Text Bool)
forall a. Lens' (Searcher a) (Editor Text Bool)
query) (AttrName -> Widget Bool -> Widget Bool
forall n. AttrName -> Widget n -> Widget n
withAttr AttrName
"Stats" (Widget Bool -> Widget Bool)
-> (Text -> Widget Bool) -> Text -> Widget Bool
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Text -> Widget Bool
forall n. Text -> Widget n
txt (Text -> Widget Bool) -> Text -> Widget Bool
forall a b. (a -> b) -> a -> b
$ Int -> Text
forall a s. (Show a, ConvertString String s) => a -> s
show (Searcher a
s Searcher a -> Getting Int (Searcher a) Int -> Int
forall s a. s -> Getting a s a -> a
^. Getting Int (Searcher a) Int
forall a. Lens' (Searcher a) Int
numMatches) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>  Text
"/" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
n)
                                             Widget Bool -> Widget Bool -> Widget Bool
forall n. Widget n -> Widget n -> Widget n
<=> Widget Bool
forall n. Widget n
hBorder  Widget Bool -> Widget Bool -> Widget Bool
forall n. Widget n -> Widget n -> Widget n
<=> Widget Bool -> Widget Bool
forall n. Widget n -> Widget n
joinBorders (Text
-> ([Text] -> [Text]) -> Bool -> List Bool [Text] -> Widget Bool
forall (f :: * -> *) n a.
(Foldable f, Ord n, Show n) =>
Text -> (a -> f Text) -> Bool -> List n a -> Widget n
listWithHighlights Text
"➜ " [Text] -> [Text]
forall k (cat :: k -> k -> *) (a :: k). Category cat => cat a a
id Bool
False (Searcher a
s Searcher a
-> Getting (List Bool [Text]) (Searcher a) (List Bool [Text])
-> List Bool [Text]
forall s a. s -> Getting a s a -> a
^. Getting (List Bool [Text]) (Searcher a) (List Bool [Text])
forall a. Lens' (Searcher a) (List Bool [Text])
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 :: SearchEnv a -> Searcher b -> IO (Searcher b)
editStep e :: SearchEnv a
e@(SearchEnv SearchFunctions a
f Vector Text
v BChan SearchEvent
b) Searcher b
s
  | Searcher b -> Maybe Text
forall a. Searcher a -> Maybe Text
makeQuery Searcher b
s Maybe Text -> Maybe Text -> Bool
forall a. Eq a => a -> a -> Bool
== (Searcher b
s Searcher b
-> Getting (Maybe Text) (Searcher b) (Maybe Text) -> Maybe Text
forall s a. s -> Getting a s a -> a
^. Getting (Maybe Text) (Searcher b) (Maybe Text)
forall a. Lens' (Searcher a) (Maybe Text)
prevQuery)      = Searcher b -> IO (Searcher b)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Searcher b
s
  | Bool
otherwise                            = (\ThreadId
w -> ASetter (Searcher b) (Searcher b) (Maybe ThreadId) (Maybe ThreadId)
-> Maybe ThreadId -> Searcher b -> Searcher b
forall s t a b. ASetter s t a b -> b -> s -> t
set ASetter (Searcher b) (Searcher b) (Maybe ThreadId) (Maybe ThreadId)
forall a. Lens' (Searcher a) (Maybe ThreadId)
wait (ThreadId -> Maybe ThreadId
forall a. a -> Maybe a
Just ThreadId
w) Searcher b
s') (ThreadId -> Searcher b) -> IO ThreadId -> IO (Searcher b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Bool -> SearchEnv a -> Searcher b -> IO ThreadId
forall a b. Bool -> SearchEnv a -> Searcher b -> IO ThreadId
replaceSearch Bool
isBigger SearchEnv a
e Searcher b
s'
  where
    isBigger :: Bool
isBigger = Bool -> Maybe Bool -> Bool
forall a. a -> Maybe a -> a
fromMaybe Bool
False (Maybe Bool -> Bool) -> Maybe Bool -> Bool
forall a b. (a -> b) -> a -> b
$ Text -> Text -> Bool
T.isInfixOf (Text -> Text -> Bool) -> Maybe Text -> Maybe (Text -> Bool)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Searcher b
s Searcher b
-> Getting (Maybe Text) (Searcher b) (Maybe Text) -> Maybe Text
forall s a. s -> Getting a s a -> a
^. Getting (Maybe Text) (Searcher b) (Maybe Text)
forall a. Lens' (Searcher a) (Maybe Text)
prevQuery) Maybe (Text -> Bool) -> Maybe Text -> Maybe Bool
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ([Text] -> Maybe Text
forall a. [a] -> Maybe a
headMay ([Text] -> Maybe Text)
-> (Editor Text Bool -> [Text]) -> Editor Text Bool -> Maybe Text
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Editor Text Bool -> [Text]
forall t n. Monoid t => Editor t n -> [t]
getEditContents (Editor Text Bool -> Maybe Text) -> Editor Text Bool -> Maybe Text
forall a b. (a -> b) -> a -> b
$ Searcher b
s Searcher b
-> Getting (Editor Text Bool) (Searcher b) (Editor Text Bool)
-> Editor Text Bool
forall s a. s -> Getting a s a -> a
^. Getting (Editor Text Bool) (Searcher b) (Editor Text Bool)
forall a. Lens' (Searcher a) (Editor Text Bool)
query)
    s' :: Searcher b
s'       = ASetter (Searcher b) (Searcher b) (Maybe Text) (Maybe Text)
-> Maybe Text -> Searcher b -> Searcher b
forall s t a b. ASetter s t a b -> b -> s -> t
set ASetter (Searcher b) (Searcher b) (Maybe Text) (Maybe Text)
forall a. Lens' (Searcher a) (Maybe Text)
prevQuery (Searcher b -> Maybe Text
forall a. Searcher a -> Maybe Text
makeQuery Searcher b
s) Searcher b
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 :: SearchFunctions a
-> Vector Text
-> Maybe Text
-> IORef (Vector Int)
-> IO SearchEvent
search SearchFunctions a
fs Vector Text
v Maybe Text
t IORef (Vector Int)
r = (\(Int
l , Vector [Text]
tm) -> Vector [Text] -> Int -> Maybe Text -> SearchEvent
SearchEvent Vector [Text]
tm Int
l Maybe Text
t)  ((Int, Vector [Text]) -> SearchEvent)
-> IO (Int, Vector [Text]) -> IO SearchEvent
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IORef (Vector Int)
-> (Vector Int -> (Vector Int, (Int, Vector [Text])))
-> IO (Int, Vector [Text])
forall a b. IORef a -> (a -> (a, b)) -> IO b
atomicModifyIORef' IORef (Vector Int)
r (SearchFunctions a
-> Vector Text
-> Maybe Text
-> Vector Int
-> (Vector Int, (Int, Vector [Text]))
forall a.
SearchFunctions a
-> Vector Text
-> Maybe Text
-> Vector Int
-> (Vector Int, (Int, Vector [Text]))
searchWithMatcher SearchFunctions a
fs Vector Text
v Maybe Text
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 :: Bool -> SearchEnv a -> Searcher b -> IO ThreadId
replaceSearch Bool
ib (SearchEnv SearchFunctions a
fs Vector Text
v BChan SearchEvent
b) Searcher b
s = IO ThreadId -> IO () -> IO ThreadId
forall a b. IO a -> IO b -> IO a
finally (IO () -> IO ThreadId
forkIO (IO () -> IO ThreadId)
-> ((AsyncException -> IO ()) -> IO ())
-> (AsyncException -> IO ())
-> IO ThreadId
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. IO () -> (AsyncException -> IO ()) -> IO ()
forall e a. Exception e => IO a -> (e -> IO a) -> IO a
catch IO ()
wrtev ((AsyncException -> IO ()) -> IO ThreadId)
-> (AsyncException -> IO ()) -> IO ThreadId
forall a b. (a -> b) -> a -> b
$ \ (AsyncException
_ :: AsyncException) -> () -> IO ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()) (IO () -> (ThreadId -> IO ()) -> Maybe ThreadId -> IO ()
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (() -> IO ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()) ThreadId -> IO ()
killThread (Searcher b
s Searcher b
-> Getting (Maybe ThreadId) (Searcher b) (Maybe ThreadId)
-> Maybe ThreadId
forall s a. s -> Getting a s a -> a
^. Getting (Maybe ThreadId) (Searcher b) (Maybe ThreadId)
forall a. Lens' (Searcher a) (Maybe ThreadId)
wait))
  where
    wrtev :: IO ()
wrtev = BChan SearchEvent -> SearchEvent -> IO ()
forall a. BChan a -> a -> IO ()
writeBChan BChan SearchEvent
b (SearchEvent -> IO ()) -> IO SearchEvent -> IO ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< SearchFunctions a
-> Vector Text
-> Maybe Text
-> IORef (Vector Int)
-> IO SearchEvent
forall a.
SearchFunctions a
-> Vector Text
-> Maybe Text
-> IORef (Vector Int)
-> IO SearchEvent
search SearchFunctions a
fs Vector Text
v (Searcher b
s Searcher b
-> Getting (Maybe Text) (Searcher b) (Maybe Text) -> Maybe Text
forall s a. s -> Getting a s a -> a
^. Getting (Maybe Text) (Searcher b) (Maybe Text)
forall a. Lens' (Searcher a) (Maybe Text)
prevQuery) (IORef (Vector Int) -> IO SearchEvent)
-> IO (IORef (Vector Int)) -> IO SearchEvent
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< IO (IORef (Vector Int))
mtchs
    mtchs :: IO (IORef (Vector Int))
mtchs = if Bool
ib then IORef (Vector Int) -> IO (IORef (Vector Int))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (IORef (Vector Int) -> IO (IORef (Vector Int)))
-> IORef (Vector Int) -> IO (IORef (Vector Int))
forall a b. (a -> b) -> a -> b
$ Searcher b
s Searcher b
-> Getting (IORef (Vector Int)) (Searcher b) (IORef (Vector Int))
-> IORef (Vector Int)
forall s a. s -> Getting a s a -> a
^. Getting (IORef (Vector Int)) (Searcher b) (IORef (Vector Int))
forall a. Lens' (Searcher a) (IORef (Vector Int))
allMatches else IORef (Vector Int) -> Vector Int -> IO ()
forall a. IORef a -> a -> IO ()
atomicWriteIORef (Searcher b
s Searcher b
-> Getting (IORef (Vector Int)) (Searcher b) (IORef (Vector Int))
-> IORef (Vector Int)
forall s a. s -> Getting a s a -> a
^. Getting (IORef (Vector Int)) (Searcher b) (IORef (Vector Int))
forall a. Lens' (Searcher a) (IORef (Vector Int))
allMatches) (Int -> Int -> Vector Int
forall a. (Unbox a, Num a) => a -> Int -> Vector a
U.enumFromN Int
0 (Int -> Vector Int) -> Int -> Vector Int
forall a b. (a -> b) -> a -> b
$ Vector Text -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length Vector Text
v) IO () -> IORef (Vector Int) -> IO (IORef (Vector Int))
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> (Searcher b
s Searcher b
-> Getting (IORef (Vector Int)) (Searcher b) (IORef (Vector Int))
-> IORef (Vector Int)
forall s a. s -> Getting a s a -> a
^. Getting (IORef (Vector Int)) (Searcher b) (IORef (Vector Int))
forall a. Lens' (Searcher a) (IORef (Vector Int))
allMatches)

defThemeAttrs :: [(AttrName, Attr)]
defThemeAttrs :: [(AttrName, Attr)]
defThemeAttrs = [ (AttrName
listSelectedAttr, Attr -> Style -> Attr
withStyle (Color -> Attr
bg Color
white) Style
bold) , (AttrName
"Prompt" , Attr -> Style -> Attr
withStyle (Color
white Color -> Color -> Attr
`on` Color
blue) Style
bold)
           , (AttrName
"Highlight" , Attr -> Style -> Attr
withStyle (Color -> Attr
fg Color
blue) Style
bold) ,  (AttrName
"Stats" , Color -> Attr
fg Color
blue) ,  (AttrName
borderAttr , Color -> Attr
fg Color
cyan)]

defTheme ::AppTheme
defTheme :: AppTheme
defTheme = AppTheme :: Text -> [(AttrName, Attr)] -> BorderStyle -> AppTheme
AppTheme {_prompt :: Text
_prompt = Text
"Find: " , _themeAttrs :: [(AttrName, Attr)]
_themeAttrs = [(AttrName, Attr)]
defThemeAttrs , _borderStyle :: BorderStyle
_borderStyle = 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 a b
defSettings = AppTheme
-> ReaderT (SearchEnv a) EventHooks (Searcher b) -> AppSettings a b
forall a b.
AppTheme
-> ReaderT (SearchEnv a) EventHooks (Searcher b) -> AppSettings a b
AppSettings AppTheme
defTheme ((SearchEnv a -> EventHooks (Searcher b))
-> ReaderT (SearchEnv a) EventHooks (Searcher b)
forall r (m :: * -> *) a. (r -> m a) -> ReaderT r m a
ReaderT (\SearchEnv a
e -> EventHooks (Searcher b)
forall a. EventHooks a
defHooks {keyHook :: Key -> [Modifier] -> Searcher b -> EventM Bool (Next (Searcher b))
keyHook = SearchEnv a
-> Key
-> [Modifier]
-> Searcher b
-> EventM Bool (Next (Searcher b))
forall a b.
SearchEnv a
-> Key
-> [Modifier]
-> Searcher b
-> EventM Bool (Next (Searcher b))
handleKeyEvent SearchEnv a
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 a b -> SearchEnv a -> App (Searcher b) SearchEvent Bool
searchApp (AppSettings AppTheme
th ReaderT (SearchEnv a) EventHooks (Searcher b)
hks) env :: SearchEnv a
env@(SearchEnv SearchFunctions a
_ Vector Text
v BChan SearchEvent
_) = App :: forall s e n.
(s -> [Widget n])
-> (s -> [CursorLocation n] -> Maybe (CursorLocation n))
-> (s -> BrickEvent n e -> EventM n (Next s))
-> (s -> EventM n s)
-> (s -> AttrMap)
-> App s e n
App {appDraw :: Searcher b -> [Widget Bool]
appDraw = Searcher b -> [Widget Bool]
forall a. Searcher a -> [Widget Bool]
ad , appChooseCursor :: Searcher b -> [CursorLocation Bool] -> Maybe (CursorLocation Bool)
appChooseCursor = Searcher b -> [CursorLocation Bool] -> Maybe (CursorLocation Bool)
forall s n. s -> [CursorLocation n] -> Maybe (CursorLocation n)
showFirstCursor , appHandleEvent :: Searcher b
-> BrickEvent Bool SearchEvent -> EventM Bool (Next (Searcher b))
appHandleEvent = Searcher b
-> BrickEvent Bool SearchEvent -> EventM Bool (Next (Searcher b))
forall n.
Searcher b
-> BrickEvent n SearchEvent -> EventM Bool (Next (Searcher b))
he , appStartEvent :: Searcher b -> EventM Bool (Searcher b)
appStartEvent = Searcher b -> EventM Bool (Searcher b)
forall (f :: * -> *) a. Applicative f => a -> f a
pure , appAttrMap :: Searcher b -> AttrMap
appAttrMap = Searcher b -> AttrMap
forall b. b -> AttrMap
am}
  where
    ad :: Searcher a -> [Widget Bool]
ad                                    = (Widget Bool -> [Widget Bool] -> [Widget Bool]
forall a. a -> [a] -> [a]
:[]) (Widget Bool -> [Widget Bool])
-> (Searcher a -> Widget Bool) -> Searcher a -> [Widget Bool]
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. BorderStyle -> Widget Bool -> Widget Bool
forall n. BorderStyle -> Widget n -> Widget n
withBorderStyle (AppTheme
th AppTheme -> Getting BorderStyle AppTheme BorderStyle -> BorderStyle
forall s a. s -> Getting a s a -> a
^. Getting BorderStyle AppTheme BorderStyle
Lens' AppTheme BorderStyle
borderStyle) (Widget Bool -> Widget Bool)
-> (Searcher a -> Widget Bool) -> Searcher a -> Widget Bool
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Text -> Text -> Searcher a -> Widget Bool
forall a. Text -> Text -> Searcher a -> Widget Bool
searcherWidget (AppTheme
th AppTheme -> Getting Text AppTheme Text -> Text
forall s a. s -> Getting a s a -> a
^. Getting Text AppTheme Text
Lens' AppTheme Text
prompt) (Int -> Text
forall a s. (Show a, ConvertString String s) => a -> s
show (Int -> Text) -> (Vector Text -> Int) -> Vector Text -> Text
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Vector Text -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (Vector Text -> Text) -> Vector Text -> Text
forall a b. (a -> b) -> a -> b
$ Vector Text
v)
    am :: b -> AttrMap
am                                    = AttrMap -> b -> AttrMap
forall a b. a -> b -> a
const (AttrMap -> b -> AttrMap) -> AttrMap -> b -> AttrMap
forall a b. (a -> b) -> a -> b
$ Attr -> [(AttrName, Attr)] -> AttrMap
attrMap Attr
defAttr (AppTheme
th AppTheme
-> Getting [(AttrName, Attr)] AppTheme [(AttrName, Attr)]
-> [(AttrName, Attr)]
forall s a. s -> Getting a s a -> a
^. Getting [(AttrName, Attr)] AppTheme [(AttrName, Attr)]
Lens' AppTheme [(AttrName, Attr)]
themeAttrs)
    hk :: EventHooks (Searcher b)
hk                                    = ReaderT (SearchEnv a) EventHooks (Searcher b)
-> SearchEnv a -> EventHooks (Searcher b)
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT ReaderT (SearchEnv a) EventHooks (Searcher b)
hks SearchEnv a
env
    he :: Searcher b
-> BrickEvent n SearchEvent -> EventM Bool (Next (Searcher b))
he Searcher b
s (VtyEvent (EvKey Key
k [Modifier]
m))           = EventHooks (Searcher b)
-> Key
-> [Modifier]
-> Searcher b
-> EventM Bool (Next (Searcher b))
forall a.
EventHooks a -> Key -> [Modifier] -> a -> EventM Bool (Next a)
keyHook EventHooks (Searcher b)
hk Key
k [Modifier]
m Searcher b
s
    he Searcher b
s (VtyEvent (EvMouseDown Int
i Int
j Button
b [Modifier]
m)) = EventHooks (Searcher b)
-> Int
-> Int
-> Button
-> [Modifier]
-> Searcher b
-> EventM Bool (Next (Searcher b))
forall a.
EventHooks a
-> Int -> Int -> Button -> [Modifier] -> a -> EventM Bool (Next a)
mouseDownHook   EventHooks (Searcher b)
hk Int
i Int
j Button
b [Modifier]
m Searcher b
s
    he Searcher b
s (VtyEvent (EvMouseUp   Int
i Int
j Maybe Button
b  )) = EventHooks (Searcher b)
-> Int
-> Int
-> Maybe Button
-> Searcher b
-> EventM Bool (Next (Searcher b))
forall a.
EventHooks a
-> Int -> Int -> Maybe Button -> a -> EventM Bool (Next a)
mouseUpHook     EventHooks (Searcher b)
hk Int
i Int
j Maybe Button
b   Searcher b
s
    he Searcher b
s (VtyEvent (EvPaste     ByteString
b      )) = EventHooks (Searcher b)
-> ByteString -> Searcher b -> EventM Bool (Next (Searcher b))
forall a. EventHooks a -> ByteString -> a -> EventM Bool (Next a)
pasteHook       EventHooks (Searcher b)
hk     ByteString
b   Searcher b
s
    he Searcher b
s (VtyEvent  Event
EvGainedFocus       ) = EventHooks (Searcher b)
-> Searcher b -> EventM Bool (Next (Searcher b))
forall a. EventHooks a -> a -> EventM Bool (Next a)
focusGainedHook EventHooks (Searcher b)
hk         Searcher b
s
    he Searcher b
s (VtyEvent  Event
EvLostFocus         ) = EventHooks (Searcher b)
-> Searcher b -> EventM Bool (Next (Searcher b))
forall a. EventHooks a -> a -> EventM Bool (Next a)
focusLostHook   EventHooks (Searcher b)
hk         Searcher b
s
    he Searcher b
s (AppEvent SearchEvent
e)                     = if SearchEvent
e SearchEvent
-> Getting (Maybe Text) SearchEvent (Maybe Text) -> Maybe Text
forall s a. s -> Getting a s a -> a
^. Getting (Maybe Text) SearchEvent (Maybe Text)
Lens' SearchEvent (Maybe Text)
term Maybe Text -> Maybe Text -> Bool
forall a. Eq a => a -> a -> Bool
== Searcher b
s Searcher b
-> Getting (Maybe Text) (Searcher b) (Maybe Text) -> Maybe Text
forall s a. s -> Getting a s a -> a
^. Getting (Maybe Text) (Searcher b) (Maybe Text)
forall a. Lens' (Searcher a) (Maybe Text)
prevQuery then Vector Text
-> Searcher b -> SearchEvent -> EventM Bool (Next (Searcher b))
forall a.
Vector Text
-> Searcher a -> SearchEvent -> EventM Bool (Next (Searcher a))
handleSearch Vector Text
v Searcher b
s SearchEvent
e else Searcher b -> EventM Bool (Next (Searcher b))
forall s n. s -> EventM n (Next s)
continue Searcher b
s
    he Searcher b
s BrickEvent n SearchEvent
_                                = Searcher b -> EventM Bool (Next (Searcher b))
forall s n. s -> EventM n (Next s)
continue Searcher b
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 :: a -> Vector Text -> IORef (Vector Int) -> Searcher a
initialSearcher a
e Vector Text
v IORef (Vector Int)
r = Searcher :: forall a.
Editor Text Bool
-> Maybe Text
-> IORef (Vector Int)
-> List Bool [Text]
-> Int
-> Maybe ThreadId
-> a
-> Searcher a
Searcher { _query :: Editor Text Bool
_query = Bool -> Maybe Int -> Text -> Editor Text Bool
forall n. n -> Maybe Int -> Text -> Editor Text n
editorText Bool
True (Int -> Maybe Int
forall a. a -> Maybe a
Just Int
1) Text
"" , _prevQuery :: Maybe Text
_prevQuery = Maybe Text
forall a. Maybe a
Nothing , _wait :: Maybe ThreadId
_wait = Maybe ThreadId
forall a. Maybe a
Nothing
                               , _matches :: List Bool [Text]
_matches = Bool -> Vector [Text] -> Int -> List Bool [Text]
forall (t :: * -> *) n e.
Foldable t =>
n -> t e -> Int -> GenericList n t e
list Bool
False ((Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
:[]) (Text -> [Text]) -> Vector Text -> Vector [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> Vector Text -> Vector Text
forall a. Int -> Vector a -> Vector a
take Int
512 Vector Text
v) Int
0, _allMatches :: IORef (Vector Int)
_allMatches = IORef (Vector Int)
r , _numMatches :: Int
_numMatches = Vector Text -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length Vector Text
v , _extension :: a
_extension =  a
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 :: b
-> AppSettings a b
-> SearchFunctions a
-> Vector Text
-> IO (Searcher b)
runApp b
e AppSettings a b
s SearchFunctions a
f Vector Text
v = (\BChan SearchEvent
b -> App (Searcher b) SearchEvent Bool
-> BChan SearchEvent -> Searcher b -> IO (Searcher b)
forall n b e. Ord n => App b e n -> BChan e -> b -> IO b
theMain (AppSettings a b -> SearchEnv a -> App (Searcher b) SearchEvent Bool
forall a b.
AppSettings a b -> SearchEnv a -> App (Searcher b) SearchEvent Bool
searchApp AppSettings a b
s (SearchFunctions a
-> Vector Text -> BChan SearchEvent -> SearchEnv a
forall a.
SearchFunctions a
-> Vector Text -> BChan SearchEvent -> SearchEnv a
SearchEnv SearchFunctions a
f Vector Text
v BChan SearchEvent
b)) BChan SearchEvent
b (Searcher b -> IO (Searcher b))
-> (IORef (Vector Int) -> Searcher b)
-> IORef (Vector Int)
-> IO (Searcher b)
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. b -> Vector Text -> IORef (Vector Int) -> Searcher b
forall a. a -> Vector Text -> IORef (Vector Int) -> Searcher a
initialSearcher b
e Vector Text
v (IORef (Vector Int) -> IO (Searcher b))
-> IO (IORef (Vector Int)) -> IO (Searcher b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Vector Int -> IO (IORef (Vector Int))
forall a. a -> IO (IORef a)
newIORef (Int -> Int -> Vector Int
forall a. (Unbox a, Num a) => a -> Int -> Vector a
U.enumFromN Int
0 (Int -> Vector Int)
-> (Vector Text -> Int) -> Vector Text -> Vector Int
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Vector Text -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (Vector Text -> Vector Int) -> Vector Text -> Vector Int
forall a b. (a -> b) -> a -> b
$ Vector Text
v)) (BChan SearchEvent -> IO (Searcher b))
-> IO (BChan SearchEvent) -> IO (Searcher b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Int -> IO (BChan SearchEvent)
forall a. Int -> IO (BChan a)
newBChan Int
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 :: b
-> AppSettings a b
-> SearchFunctions a
-> Handle
-> IO (Searcher b)
runAppFromHandle b
e AppSettings a b
s SearchFunctions a
f = b
-> AppSettings a b
-> SearchFunctions a
-> Vector Text
-> IO (Searcher b)
forall b a.
b
-> AppSettings a b
-> SearchFunctions a
-> Vector Text
-> IO (Searcher b)
runApp b
e AppSettings a b
s SearchFunctions a
f (Vector Text -> IO (Searcher b))
-> (Compact (Vector Text) -> Vector Text)
-> Compact (Vector Text)
-> IO (Searcher b)
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Compact (Vector Text) -> Vector Text
forall a. Compact a -> a
getCompact (Compact (Vector Text) -> IO (Searcher b))
-> (Handle -> IO (Compact (Vector Text)))
-> Handle
-> IO (Searcher b)
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< Vector Text -> IO (Compact (Vector Text))
forall a. a -> IO (Compact a)
compact (Vector Text -> IO (Compact (Vector Text)))
-> (Vector Text -> Vector Text)
-> Vector Text
-> IO (Compact (Vector Text))
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Vector Text -> Vector Text
forall a. Vector a -> Vector a
force (Vector Text -> IO (Compact (Vector Text)))
-> (Handle -> IO (Vector Text))
-> Handle
-> IO (Compact (Vector Text))
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< Handle -> IO (Vector Text)
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 :: AppSettings a ()
-> SearchFunctions a -> Vector Text -> IO (Maybe Text)
selected AppSettings a ()
s SearchFunctions a
f  = (Searcher () -> Maybe Text) -> IO (Searcher ()) -> IO (Maybe Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
map (((Int, [Text]) -> Text) -> Maybe (Int, [Text]) -> Maybe Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
map ([Text] -> Text
forall a. Monoid a => [a] -> a
mconcat ([Text] -> Text)
-> ((Int, [Text]) -> [Text]) -> (Int, [Text]) -> Text
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (Int, [Text]) -> [Text]
forall a b. (a, b) -> b
snd) (Maybe (Int, [Text]) -> Maybe Text)
-> (Searcher () -> Maybe (Int, [Text]))
-> Searcher ()
-> Maybe Text
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. List Bool [Text] -> Maybe (Int, [Text])
forall (t :: * -> *) n e.
(Splittable t, Foldable t) =>
GenericList n t e -> Maybe (Int, e)
listSelectedElement (List Bool [Text] -> Maybe (Int, [Text]))
-> (Searcher () -> List Bool [Text])
-> Searcher ()
-> Maybe (Int, [Text])
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (Searcher ()
-> Getting (List Bool [Text]) (Searcher ()) (List Bool [Text])
-> List Bool [Text]
forall s a. s -> Getting a s a -> a
^. Getting (List Bool [Text]) (Searcher ()) (List Bool [Text])
forall a. Lens' (Searcher a) (List Bool [Text])
matches)) (IO (Searcher ()) -> IO (Maybe Text))
-> (Compact (Vector Text) -> IO (Searcher ()))
-> Compact (Vector Text)
-> IO (Maybe Text)
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. ()
-> AppSettings a ()
-> SearchFunctions a
-> Vector Text
-> IO (Searcher ())
forall b a.
b
-> AppSettings a b
-> SearchFunctions a
-> Vector Text
-> IO (Searcher b)
runApp () AppSettings a ()
s SearchFunctions a
f (Vector Text -> IO (Searcher ()))
-> (Compact (Vector Text) -> Vector Text)
-> Compact (Vector Text)
-> IO (Searcher ())
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Compact (Vector Text) -> Vector Text
forall a. Compact a -> a
getCompact (Compact (Vector Text) -> IO (Maybe Text))
-> (Vector Text -> IO (Compact (Vector Text)))
-> Vector Text
-> IO (Maybe Text)
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< Vector Text -> IO (Compact (Vector Text))
forall a. a -> IO (Compact a)
compact (Vector Text -> IO (Compact (Vector Text)))
-> (Vector Text -> Vector Text)
-> Vector Text
-> IO (Compact (Vector Text))
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Vector Text -> Vector Text
forall a. Vector a -> Vector a
force

-- | Same as `selected` but reads the vector from the supplied handle.
selectedFromHandle :: AppSettings a () -> SearchFunctions a -> Handle -> IO (Maybe Text)
selectedFromHandle :: AppSettings a () -> SearchFunctions a -> Handle -> IO (Maybe Text)
selectedFromHandle AppSettings a ()
s SearchFunctions a
f = AppSettings a ()
-> SearchFunctions a -> Vector Text -> IO (Maybe Text)
forall a.
AppSettings a ()
-> SearchFunctions a -> Vector Text -> IO (Maybe Text)
selected AppSettings a ()
s SearchFunctions a
f (Vector Text -> IO (Maybe Text))
-> (Handle -> IO (Vector Text)) -> Handle -> IO (Maybe Text)
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< Handle -> IO (Vector Text)
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 :: (Text -> Text)
-> (Vector Text -> Vector Text)
-> AppSettings a ()
-> SearchFunctions a
-> Handle
-> IO (Maybe Text)
selectedFromHandleWith Text -> Text
w Vector Text -> Vector Text
t AppSettings a ()
s SearchFunctions a
f = AppSettings a ()
-> SearchFunctions a -> Vector Text -> IO (Maybe Text)
forall a.
AppSettings a ()
-> SearchFunctions a -> Vector Text -> IO (Maybe Text)
selected AppSettings a ()
s SearchFunctions a
f (Vector Text -> IO (Maybe Text))
-> (Handle -> IO (Vector Text)) -> Handle -> IO (Maybe Text)
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< (Text -> Text)
-> (Vector Text -> Vector Text) -> Handle -> IO (Vector Text)
readVectorHandleWith Text -> Text
w Vector Text -> Vector Text
t

-- | Another variation on `selectedFromHandle`. See `fileNamesSorted` for what happens to read vector.
selectedFromFileNamesSorted :: AppSettings a () -> SearchFunctions a -> Handle -> IO (Maybe Text)
selectedFromFileNamesSorted :: AppSettings a () -> SearchFunctions a -> Handle -> IO (Maybe Text)
selectedFromFileNamesSorted AppSettings a ()
s SearchFunctions a
f = AppSettings a ()
-> SearchFunctions a -> Vector Text -> IO (Maybe Text)
forall a.
AppSettings a ()
-> SearchFunctions a -> Vector Text -> IO (Maybe Text)
selected AppSettings a ()
s SearchFunctions a
f (Vector Text -> IO (Maybe Text))
-> (Handle -> IO (Vector Text)) -> Handle -> IO (Maybe Text)
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< Handle -> IO (Vector Text)
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 :: AppSettings a ()
-> SearchFunctions a -> [FindInDirs] -> IO (Maybe Text)
selectedFromFiles AppSettings a ()
s SearchFunctions a
f = AppSettings a ()
-> SearchFunctions a -> Vector Text -> IO (Maybe Text)
forall a.
AppSettings a ()
-> SearchFunctions a -> Vector Text -> IO (Maybe Text)
selected AppSettings a ()
s SearchFunctions a
f (Vector Text -> IO (Maybe Text))
-> (Vector (FileTree Text) -> Vector Text)
-> Vector (FileTree Text)
-> IO (Maybe Text)
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (FileTree Text -> Vector Text
flatten (FileTree Text -> Vector Text)
-> Vector (FileTree Text) -> Vector Text
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<<) (Vector (FileTree Text) -> IO (Maybe Text))
-> ([FindInDirs] -> IO (Vector (FileTree Text)))
-> [FindInDirs]
-> IO (Maybe Text)
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< [FindInDirs] -> IO (Vector (FileTree Text))
findFilesInDirs

-- | A version of `selected` that puts the selected text on the stdout.
runSearch :: AppSettings a () -> SearchFunctions a -> IO ()
runSearch :: AppSettings a () -> SearchFunctions a -> IO ()
runSearch AppSettings a ()
s SearchFunctions a
f = IO () -> (Text -> IO ()) -> Maybe Text -> IO ()
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (() -> IO ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()) Text -> IO ()
forall (m :: * -> *). MonadIO m => Text -> m ()
putStrLn (Maybe Text -> IO ()) -> IO (Maybe Text) -> IO ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< AppSettings a ()
-> SearchFunctions a -> Vector Text -> IO (Maybe Text)
forall a.
AppSettings a ()
-> SearchFunctions a -> Vector Text -> IO (Maybe Text)
selected AppSettings a ()
s SearchFunctions a
f (Vector Text -> IO (Maybe Text))
-> IO (Vector Text) -> IO (Maybe Text)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< IO (Vector Text)
readVectorStdIn

-- | The backend for `run`
run' :: [String] -> IO ()
run' :: [String] -> IO ()
run' []                 = AppSettings Int () -> SearchFunctions Int -> IO ()
forall a. AppSettings a () -> SearchFunctions a -> IO ()
runSearch AppSettings Int ()
forall a b. AppSettings a b
defSettings SearchFunctions Int
searchFunctionsOL
run' [String
"fuzzy"]          = AppSettings MatchPart () -> SearchFunctions MatchPart -> IO ()
forall a. AppSettings a () -> SearchFunctions a -> IO ()
runSearch AppSettings MatchPart ()
forall a b. AppSettings a b
defSettings SearchFunctions MatchPart
searchFunctionsFuzzy
run' [String
"orderless"]      = AppSettings Int () -> SearchFunctions Int -> IO ()
forall a. AppSettings a () -> SearchFunctions a -> IO ()
runSearch AppSettings Int ()
forall a b. AppSettings a b
defSettings SearchFunctions Int
searchFunctionsOL
run' [String]
xs                 = (\Term
t -> (Text -> IO ()) -> Term -> Colored Text -> IO ()
forall a. (a -> IO ()) -> Term -> Colored a -> IO ()
C.printColored Text -> IO ()
forall (m :: * -> *). MonadIO m => Text -> m ()
putStr Term
t Colored Text
usageString) (Term -> IO ()) -> IO Term -> IO ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< IO Term
C.getTerm

usageString :: Colored Text
usageString :: Colored Text
usageString =    Colored Text
"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,"
              Colored Text -> Colored Text -> Colored Text
forall a. Semigroup a => a -> a -> a
<> Colored Text
" one from each line and outputs the selected candidate (if there is one) on the stdout.\n"
              Colored Text -> Colored Text -> Colored Text
forall a. Semigroup a => a -> a -> a
<> Color -> Colored Text -> Colored Text
forall a. Color -> Colored a -> Colored a
C.Fg Color
C.Blue Colored Text
"talash tui" Colored Text -> Colored Text -> Colored Text
forall a. Semigroup a => a -> a -> a
<> Colored Text
": Run the tui with the default orderless style of searching.\n"
              Colored Text -> Colored Text -> Colored Text
forall a. Semigroup a => a -> a -> a
<> Color -> Colored Text -> Colored Text
forall a. Color -> Colored a -> Colored a
C.Fg Color
C.Blue Colored Text
"talash tui fuzzy" Colored Text -> Colored Text -> Colored Text
forall a. Semigroup a => a -> a -> a
<> Colored Text
": Run the tui with fuzzy style for searching.\n"
              Colored Text -> Colored Text -> Colored Text
forall a. Semigroup a => a -> a -> a
<> Color -> Colored Text -> Colored Text
forall a. Color -> Colored a -> Colored a
C.Fg Color
C.Blue Colored Text
"talash tui orderless" Colored Text -> Colored Text -> Colored Text
forall a. Semigroup a => a -> a -> a
<>  Colored Text
": 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 :: IO ()
run = [String] -> IO ()
run' ([String] -> IO ()) -> IO [String] -> IO ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< IO [String]
getArgs