{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ExistentialQuantification #-}

-- | This module is a quick hack to enable representation of data with columns of text. We use the fact the since the candidates are supposed to fit in a line,
-- they can't have a newlines but text with newlines can otherwise be searched normally. We use this here to separate columns by newlines. Like in
-- "Talash.Brick" the candidates comes from vector of text. Each such text consists of a fixed number of lines each representing a column. We match against such
-- text and `partsColumns` then uses the newlines to reconstruct the columns and the parts of the match within each column. This trick of using newline saves us
-- from dealing with the partial state of the match when we cross a column but there is probably a better way . The function `runApp` , `selected` and
-- `selectedIndex` hide this and instead take as argument a `Vector` [`Text`] with each element of the list representing a column. Each list must have the same
-- 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 (..)
                     -- * The Brick App and Helpers
                    , searchApp , defSettings , searchFunctionsFuzzy , searchFunctionsOL , selected , selectedIndex , runApp
                     -- * 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 , partsColumns , emptyIndices , 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 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 { SearchFunctions a -> Text -> Maybe (Matcher a)
_makeMatcher :: Text -> Maybe (Matcher a)
                                         , SearchFunctions a
-> forall (n :: Nat).
   KnownNat n =>
   MatcherSized n a -> Text -> Vector n Int -> [[Text]]
_displayer :: forall n. KnownNat n => MatcherSized n a -> Text -> S.Vector n Int -> [[Text]]
                                         , SearchFunctions a
-> forall (n :: Nat).
   KnownNat n =>
   MatcherSized n a
   -> Vector Text -> Vector Int -> (Vector Int, Vector (Indices n))
_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.
                           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)
                           -- | 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.
                           , 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 they 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]
_columnAttrs :: [AttrName] -- ^ The attrNames to use for each column. Must have the same length or greater length than the number of columns.
                         , AppTheme -> [Int]
_columnLimits :: [Int] -- ^ The area to limit each column to. This has a really naive and unituitive implementation. Each Int
                                                  -- must be between 0 and 100 and refers to the percentage of the width the widget for a column will occupy
                                                  -- from the space left over after all the columns before it have been rendered.
                         , 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

emptyIndices :: Int -> U.Vector  (Indices 0)
emptyIndices :: Int -> Vector (Indices 0)
emptyIndices Int
n = Int -> (Int -> Indices 0) -> Vector (Indices 0)
forall a. Unbox a => Int -> (Int -> a) -> Vector a
U.generate Int
n ( , Vector 0 Int
forall a. Unbox a => Vector 0 a
S.empty)

-- | 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

-- | 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 SearchEnv a
env Key
k [Modifier]
m Searcher b
s
  | Key
k Key -> Key -> Bool
forall a. Eq a => a -> a -> Bool
== Key
KEnter                                Bool -> Bool -> Bool
&& [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                                  Bool -> Bool -> Bool
&& [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 -> [Key] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem Key
k [Key
KUp , Key
KDown , Key
KPageUp , Key
KPageDown] Bool -> Bool -> Bool
&& [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
env (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 :: [AttrName] -> [Int] -> Text -> Text -> Searcher a -> Widget Bool
searcherWidget :: [AttrName] -> [Int] -> Text -> Text -> Searcher a -> Widget Bool
searcherWidget [AttrName]
as [Int]
ls 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]])
-> [AttrName]
-> [Int]
-> Bool
-> List Bool [[Text]]
-> Widget Bool
forall (f :: * -> *) n a.
(Foldable f, Ord n, Show n) =>
Text
-> (a -> [f Text])
-> [AttrName]
-> [Int]
-> Bool
-> List n a
-> Widget n
columnsListWithHighlights Text
"➜ " [[Text]] -> [[Text]]
forall k (cat :: k -> k -> *) (a :: k). Category cat => cat a a
id [AttrName]
as [Int]
ls 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))

-- | 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)

-- | 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 SearchEnv a
env 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
env 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 :: 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)

-- | 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 :: SearchFunctions a
-> Vector Text
-> Maybe Text
-> Vector Int
-> (Vector Int, (Int, Vector [[Text]]))
searchWithMatcher SearchFunctions a
fs Vector Text
v Maybe Text
t Vector Int
s = (Vector Int, (Int, Vector [[Text]]))
-> (Matcher a -> (Vector Int, (Int, Vector [[Text]])))
-> Maybe (Matcher a)
-> (Vector Int, (Int, Vector [[Text]]))
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Vector Int, (Int, Vector [[Text]]))
nc Matcher a -> (Vector Int, (Int, Vector [[Text]]))
go ((SearchFunctions a
fs SearchFunctions a
-> Getting
     (Text -> Maybe (Matcher a))
     (SearchFunctions a)
     (Text -> Maybe (Matcher a))
-> Text
-> Maybe (Matcher a)
forall s a. s -> Getting a s a -> a
^. Getting
  (Text -> Maybe (Matcher a))
  (SearchFunctions a)
  (Text -> Maybe (Matcher a))
forall a. Lens' (SearchFunctions a) (Text -> Maybe (Matcher a))
makeMatcher) (Text -> Maybe (Matcher a)) -> Maybe Text -> Maybe (Matcher a)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Maybe Text
t)
      where
        nc :: (Vector Int, (Int, Vector [[Text]]))
nc  = (Int -> Int -> Vector Int
forall a. (Unbox a, Num a) => a -> Int -> Vector a
U.enumFromN Int
0 (Vector Text -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length Vector Text
v) , (Int
0 , Vector [[Text]] -> Vector [[Text]]
forall a. Vector a -> Vector a
force (Vector [[Text]] -> Vector [[Text]])
-> (Vector Text -> Vector [[Text]])
-> Vector Text
-> Vector [[Text]]
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (Indices 0 -> [[Text]]) -> Vector (Indices 0) -> Vector [[Text]]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
map (\Indices 0
i -> (Text -> [Text]) -> [Text] -> [[Text]]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
map (Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
:[]) ([Text] -> [[Text]]) -> (Text -> [Text]) -> Text -> [[Text]]
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Text -> [Text]
T.lines (Text -> [[Text]]) -> Text -> [[Text]]
forall a b. (a -> b) -> a -> b
$ Vector Text
v Vector Text -> Int -> Text
forall a. Vector a -> Int -> a
! (Indices 0
i Indices 0 -> Getting Int (Indices 0) Int -> Int
forall s a. s -> Getting a s a -> a
^. Getting Int (Indices 0) Int
forall s t a b. Field1 s t a b => Lens s t a b
_1)) (Vector (Indices 0) -> Vector [[Text]])
-> (Vector Text -> Vector (Indices 0))
-> Vector Text
-> 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 (Indices 0) -> Vector (Indices 0)
forall (v :: * -> *) a (w :: * -> *).
(Vector v a, Vector w a) =>
v a -> w a
convert (Vector (Indices 0) -> Vector (Indices 0))
-> (Vector Text -> Vector (Indices 0))
-> Vector Text
-> Vector (Indices 0)
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Int -> Vector (Indices 0)
emptyIndices (Int -> Vector (Indices 0))
-> (Vector Text -> Int) -> Vector Text -> Vector (Indices 0)
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Int -> Int -> Int
forall a. Ord a => a -> a -> a
min Int
512 (Int -> Int) -> (Vector Text -> Int) -> Vector Text -> 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 [[Text]]) -> Vector Text -> Vector [[Text]]
forall a b. (a -> b) -> a -> b
$ Vector Text
v))
        go :: Matcher a -> (Vector Int, (Int, Vector [[Text]]))
go (Matcher  MatcherSized n a
f') = (Vector Int
iv , (Vector Int -> Int
forall a. Unbox a => Vector a -> Int
U.length Vector Int
iv , Vector [[Text]] -> Vector [[Text]]
forall a. Vector a -> Vector a
force (Vector [[Text]] -> Vector [[Text]])
-> (Vector (Indices n) -> Vector [[Text]])
-> Vector (Indices n)
-> Vector [[Text]]
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (Indices n -> [[Text]]) -> Vector (Indices n) -> Vector [[Text]]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
map (\Indices n
i -> (SearchFunctions a
fs SearchFunctions a
-> Getting
     (MatcherSized n a -> Text -> Vector n Int -> [[Text]])
     (SearchFunctions a)
     (MatcherSized n a -> Text -> Vector n Int -> [[Text]])
-> MatcherSized n a
-> Text
-> Vector n Int
-> [[Text]]
forall s a. s -> Getting a s a -> a
^. Getting
  (MatcherSized n a -> Text -> Vector n Int -> [[Text]])
  (SearchFunctions a)
  (MatcherSized n a -> Text -> Vector n Int -> [[Text]])
forall a (n :: Nat).
KnownNat n =>
SimpleGetter
  (SearchFunctions a)
  (MatcherSized n a -> Text -> Vector n Int -> [[Text]])
displayer) MatcherSized n a
f' (Vector Text
v Vector Text -> Int -> Text
forall a. Vector a -> Int -> a
! (Indices n
i Indices n -> Getting Int (Indices n) Int -> Int
forall s a. s -> Getting a s a -> a
^. Getting Int (Indices n) Int
forall s t a b. Field1 s t a b => Lens s t a b
_1)) (Indices n
i Indices n
-> Getting (Vector n Int) (Indices n) (Vector n Int)
-> Vector n Int
forall s a. s -> Getting a s a -> a
^. Getting (Vector n Int) (Indices n) (Vector n Int)
forall s t a b. Field2 s t a b => Lens s t a b
_2)) (Vector (Indices n) -> Vector [[Text]])
-> (Vector (Indices n) -> Vector (Indices n))
-> Vector (Indices n)
-> 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 (Indices n) -> Vector (Indices n)
forall (v :: * -> *) a (w :: * -> *).
(Vector v a, Vector w a) =>
v a -> w a
convert (Vector (Indices n) -> Vector [[Text]])
-> Vector (Indices n) -> Vector [[Text]]
forall a b. (a -> b) -> a -> b
$ Vector (Indices n)
mv))
          where
            (Vector Int
iv , Vector (Indices n)
mv) = (SearchFunctions a
fs SearchFunctions a
-> Getting
     (MatcherSized n a
      -> Vector Text -> Vector Int -> (Vector Int, Vector (Indices n)))
     (SearchFunctions a)
     (MatcherSized n a
      -> Vector Text -> Vector Int -> (Vector Int, Vector (Indices n)))
-> MatcherSized n a
-> Vector Text
-> Vector Int
-> (Vector Int, Vector (Indices n))
forall s a. s -> Getting a s a -> a
^. Getting
  (MatcherSized n a
   -> Vector Text -> Vector Int -> (Vector Int, Vector (Indices n)))
  (SearchFunctions a)
  (MatcherSized n a
   -> Vector Text -> Vector Int -> (Vector Int, Vector (Indices n)))
forall a (n :: Nat).
KnownNat n =>
SimpleGetter
  (SearchFunctions a)
  (MatcherSized n a
   -> Vector Text -> Vector Int -> (Vector Int, Vector (Indices n)))
lister) MatcherSized n a
f' Vector Text
v Vector Int
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 :: 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]
-> [Int]
-> [(AttrName, Attr)]
-> BorderStyle
-> AppTheme
AppTheme {_prompt :: Text
_prompt = Text
"Find: " , _columnAttrs :: [AttrName]
_columnAttrs = AttrName -> [AttrName]
forall a. a -> [a]
repeat AttrName
forall a. Monoid a => a
mempty , _columnLimits :: [Int]
_columnLimits = Int -> [Int]
forall a. a -> [a]
repeat Int
50 , _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
fs Vector Text
v BChan SearchEvent
b) = 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
. [AttrName] -> [Int] -> Text -> Text -> Searcher a -> Widget Bool
forall a.
[AttrName] -> [Int] -> Text -> Text -> Searcher a -> Widget Bool
searcherWidget (AppTheme
th AppTheme -> Getting [AttrName] AppTheme [AttrName] -> [AttrName]
forall s a. s -> Getting a s a -> a
^. Getting [AttrName] AppTheme [AttrName]
Lens' AppTheme [AttrName]
columnAttrs) (AppTheme
th AppTheme -> Getting [Int] AppTheme [Int] -> [Int]
forall s a. s -> Getting a s a -> a
^. Getting [Int] AppTheme [Int]
Lens' AppTheme [Int]
columnLimits) (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.
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] -> [[Text]]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
map (Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
:[]) ([Text] -> [[Text]]) -> (Text -> [Text]) -> Text -> [[Text]]
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Text -> [Text]
T.lines (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}

-- | 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 MatchPart
searchFunctionsFuzzy = (Text -> Maybe (Matcher MatchPart))
-> (forall (n :: Nat).
    KnownNat n =>
    MatcherSized n MatchPart -> Text -> Vector n Int -> [[Text]])
-> (forall (n :: Nat).
    KnownNat n =>
    MatcherSized n MatchPart
    -> Vector Text -> Vector Int -> (Vector Int, Vector (Indices n)))
-> SearchFunctions MatchPart
forall a.
(Text -> Maybe (Matcher a))
-> (forall (n :: Nat).
    KnownNat n =>
    MatcherSized n a -> Text -> Vector n Int -> [[Text]])
-> (forall (n :: Nat).
    KnownNat n =>
    MatcherSized n a
    -> Vector Text -> Vector Int -> (Vector Int, Vector (Indices n)))
-> SearchFunctions a
SearchFunctions (CaseSensitivity -> Text -> Maybe (Matcher MatchPart)
fuzzyMatcher CaseSensitivity
IgnoreCase) (\MatcherSized n MatchPart
m Text
t -> [Text] -> [[Text]]
partsColumns ([Text] -> [[Text]])
-> (Vector n Int -> [Text]) -> Vector n Int -> [[Text]]
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Either Int (Vector Int) -> Text -> Vector Int -> [Text]
parts (Vector n Int -> Vector Int
forall (n :: Nat) a. Vector n a -> Vector a
S.fromSized (Vector n Int -> Vector Int)
-> Either Int (Vector n Int) -> Either Int (Vector Int)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> MatcherSized n MatchPart -> Either Int (Vector n Int)
forall (n :: Nat) a. MatcherSized n a -> Either Int (Vector n Int)
sizes MatcherSized n MatchPart
m) Text
t (Vector Int -> [Text])
-> (Vector n Int -> Vector Int) -> Vector n Int -> [Text]
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Vector n Int -> Vector Int
forall (n :: Nat) a. Vector n a -> Vector a
S.fromSized) (SearchSettings (MatcherSized n MatchPart) n
-> MatcherSized n MatchPart
-> Vector Text
-> Vector Int
-> (Vector Int, Vector (Indices n))
forall a (n :: Nat).
KnownNat n =>
SearchSettings a n
-> a
-> Vector Text
-> Vector Int
-> (Vector Int, Vector (Indices n))
searchSome (Int -> SearchSettings (MatcherSized n MatchPart) n
forall (n :: Nat).
KnownNat n =>
Int -> SearchSettings (MatcherSized n MatchPart) n
fuzzySettings Int
512))

-- | This function reconstructs the columns from the parts returned by the search by finding the newlines.
partsColumns :: [Text] -> [[Text]]
partsColumns :: [Text] -> [[Text]]
partsColumns = [[Text]] -> [[Text]] -> [[Text]]
forall a. [a] -> [a] -> [a]
initDef [] ([[Text]] -> [[Text]])
-> ([Text] -> [[Text]]) -> [Text] -> [[Text]]
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. ([Text] -> Maybe ([Text], [Text])) -> [Text] -> [[Text]]
forall b a. (b -> Maybe (a, b)) -> b -> [a]
unfoldr (\[Text]
l -> if [Text] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Text]
l then Maybe ([Text], [Text])
forall a. Maybe a
Nothing else ([Text], [Text]) -> Maybe ([Text], [Text])
forall a. a -> Maybe a
Just (([Text], [Text]) -> Maybe ([Text], [Text]))
-> ([Text] -> ([Text], [Text])) -> [Text] -> Maybe ([Text], [Text])
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. [Text] -> ([Text], [Text])
go ([Text] -> Maybe ([Text], [Text]))
-> [Text] -> Maybe ([Text], [Text])
forall a b. (a -> b) -> a -> b
$ [Text]
l)
  where
    go :: [Text] -> ([Text], [Text])
go [Text]
x = ([Text] -> [Text])
-> (Maybe Text -> [Text])
-> ([Text], Maybe Text)
-> ([Text], [Text])
forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap ([Text]
f [Text] -> [Text] -> [Text]
forall a. Semigroup a => a -> a -> a
<>) ([Text] -> (Text -> [Text]) -> Maybe Text -> [Text]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [Text]
s' (Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: [Text]
s')) ([Text], Maybe Text)
hs
      where
        ([Text]
f , [Text]
s) = (Text -> Bool) -> [Text] -> ([Text], [Text])
forall a. (a -> Bool) -> [a] -> ([a], [a])
break (Text -> Text -> Bool
T.isInfixOf Text
"\n") [Text]
x
        s' :: [Text]
s'      = [Text] -> [Text] -> [Text]
forall a. [a] -> [a] -> [a]
tailDef [] [Text]
s
        hs :: ([Text], Maybe Text)
hs      = ([Text], Maybe Text)
-> (Text -> ([Text], Maybe Text))
-> Maybe Text
-> ([Text], Maybe Text)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe ([] , Maybe Text
forall a. Maybe a
Nothing) ((Text -> [Text])
-> (Text -> Maybe Text) -> (Text, Text) -> ([Text], Maybe Text)
forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap (Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
:[]) (Text -> Text -> Maybe Text
T.stripPrefix Text
"\n") ((Text, Text) -> ([Text], Maybe Text))
-> (Text -> (Text, Text)) -> Text -> ([Text], Maybe Text)
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Text -> Text -> (Text, Text)
T.breakOn Text
"\n") (Maybe Text -> ([Text], Maybe Text))
-> ([Text] -> Maybe Text) -> [Text] -> ([Text], Maybe Text)
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. [Text] -> Maybe Text
forall a. [a] -> Maybe a
headMay ([Text] -> ([Text], Maybe Text)) -> [Text] -> ([Text], Maybe Text)
forall a b. (a -> b) -> a -> b
$ [Text]
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 Int
searchFunctionsOL = (Text -> Maybe (Matcher Int))
-> (forall (n :: Nat).
    KnownNat n =>
    MatcherSized n Int -> Text -> Vector n Int -> [[Text]])
-> (forall (n :: Nat).
    KnownNat n =>
    MatcherSized n Int
    -> Vector Text -> Vector Int -> (Vector Int, Vector (Indices n)))
-> SearchFunctions Int
forall a.
(Text -> Maybe (Matcher a))
-> (forall (n :: Nat).
    KnownNat n =>
    MatcherSized n a -> Text -> Vector n Int -> [[Text]])
-> (forall (n :: Nat).
    KnownNat n =>
    MatcherSized n a
    -> Vector Text -> Vector Int -> (Vector Int, Vector (Indices n)))
-> SearchFunctions a
SearchFunctions (CaseSensitivity -> Text -> Maybe (Matcher Int)
orderlessMatcher CaseSensitivity
IgnoreCase) (\MatcherSized n Int
m Text
t -> [Text] -> [[Text]]
partsColumns ([Text] -> [[Text]])
-> (Vector n Int -> [Text]) -> Vector n Int -> [[Text]]
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Either Int (Vector Int) -> Text -> Vector Int -> [Text]
partsOrderless (Vector n Int -> Vector Int
forall (n :: Nat) a. Vector n a -> Vector a
S.fromSized (Vector n Int -> Vector Int)
-> Either Int (Vector n Int) -> Either Int (Vector Int)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> MatcherSized n Int -> Either Int (Vector n Int)
forall (n :: Nat) a. MatcherSized n a -> Either Int (Vector n Int)
sizes MatcherSized n Int
m) Text
t (Vector Int -> [Text])
-> (Vector n Int -> Vector Int) -> Vector n Int -> [Text]
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Vector n Int -> Vector Int
forall (n :: Nat) a. Vector n a -> Vector a
S.fromSized)
                                        (SearchSettings (MatcherSized n Int) n
-> MatcherSized n Int
-> Vector Text
-> Vector Int
-> (Vector Int, Vector (Indices n))
forall a (n :: Nat).
KnownNat n =>
SearchSettings a n
-> a
-> Vector Text
-> Vector Int
-> (Vector Int, Vector (Indices n))
searchSome (Int -> SearchSettings (MatcherSized n Int) n
forall (n :: Nat).
KnownNat n =>
Int -> SearchSettings (MatcherSized n Int) n
orderlessSettings Int
512))

-- | 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' :: 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 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 = 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))
-> (Vector [Text] -> Vector Text)
-> 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
. ([Text] -> Text) -> Vector [Text] -> Vector Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
map [Text] -> Text
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' :: 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) -> [[Text]] -> [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

-- | Run app and return the 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  = 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 [Text] -> Vector Text)
-> 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
. ([Text] -> Text) -> Vector [Text] -> Vector Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
map [Text] -> Text
T.unlines

-- | 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' :: AppSettings a ()
-> SearchFunctions a -> Vector Text -> IO (Maybe Int)
selectedIndex' AppSettings a ()
s SearchFunctions a
f Vector Text
v = ((Text -> Vector Text -> Maybe Int
forall a. Eq a => a -> Vector a -> Maybe Int
`elemIndex` Vector Text
v) (Text -> Maybe Int) -> ([Text] -> Text) -> [Text] -> Maybe Int
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. [Text] -> Text
T.unlines ([Text] -> Maybe Int) -> Maybe [Text] -> Maybe Int
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<<) (Maybe [Text] -> Maybe Int) -> IO (Maybe [Text]) -> IO (Maybe Int)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f 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
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 :: AppSettings a ()
-> SearchFunctions a -> Vector [Text] -> IO (Maybe Int)
selectedIndex AppSettings a ()
s SearchFunctions a
f = AppSettings a ()
-> SearchFunctions a -> Vector Text -> IO (Maybe Int)
forall a.
AppSettings a ()
-> SearchFunctions a -> Vector Text -> IO (Maybe Int)
selectedIndex' AppSettings a ()
s SearchFunctions a
f (Vector Text -> IO (Maybe Int))
-> (Vector [Text] -> Vector Text)
-> Vector [Text]
-> IO (Maybe Int)
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. ([Text] -> Text) -> Vector [Text] -> Vector Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
map [Text] -> Text
T.unlines