{-# LANGUAGE TemplateHaskell #-}
-- | This module provides a split searcher and seeker, a simple server-client version of the search in which searcher runs in the background and can communicate
--   with clients using named pipes. The searcher reads input as a UTF8 encoded bytestring from one named pipe and outputs the search results to another named
--   pipe. It quits when it receives an empty bytestring as input. The main function for starting the server is `runSearch` while a simple client is provided by
--   `askSearcher`. One motivation for this is be able to use this library as search backend for some searches in Emacs (though the implementation may have to wait
--  for a massive improvement in my elisp skills).
module Talash.Piped ( -- * Types and Lenses
                      SearchResult (..) , query , allMatches , matches , IOPipes (..)
                    , SearchFunctions (..) , makeMatcher , lister , displayer , searchFunctionsOL , searchFunctionsFuzzy
                      -- * Searcher
                    , searchLoop , runSearch , runSearchStdIn  ,  runSearchStdInDef , runSearchStdInColor , showMatch , showMatchColor
                      -- * Seeker
                    , askSearcher
                      -- * Default program
                    , run , run'
                      -- * Exposed Internals
                    , response , event , withIOPipes , send , recieve
                    , searchWithMatcher , readVectorStdIn , readVectorHandle , readVectorHandleWith , emptyIndices) where

import qualified Data.ByteString.Char8 as B
import Data.Monoid.Colorful
import qualified Data.Text as T
import qualified Data.Vector as V
import qualified Data.Vector.Unboxed as U
import GHC.Compact
import Intro
import System.Directory
import System.Environment (getArgs)
import System.Exit
import System.IO hiding (print , putStrLn , putStr)
import System.Posix.Files
import System.Posix.Process
import Talash.Core hiding (makeMatcher)
import Talash.Internal

data SearchResult = SearchResult { SearchResult -> Maybe Text
_query :: Maybe Text -- ^ The query that was searched for.
                                 , SearchResult -> Vector Int
_allMatches :: U.Vector Int -- ^ The vector contaning the filtered indices of the candidates using the query.
                                 , SearchResult -> Vector [Text]
_matches :: V.Vector [Text] -- ^ The matches obtained using the query.
                                 } deriving (Int -> SearchResult -> ShowS
[SearchResult] -> ShowS
SearchResult -> String
(Int -> SearchResult -> ShowS)
-> (SearchResult -> String)
-> ([SearchResult] -> ShowS)
-> Show SearchResult
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SearchResult] -> ShowS
$cshowList :: [SearchResult] -> ShowS
show :: SearchResult -> String
$cshow :: SearchResult -> String
showsPrec :: Int -> SearchResult -> ShowS
$cshowsPrec :: Int -> SearchResult -> ShowS
Show , SearchResult -> SearchResult -> Bool
(SearchResult -> SearchResult -> Bool)
-> (SearchResult -> SearchResult -> Bool) -> Eq SearchResult
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SearchResult -> SearchResult -> Bool
$c/= :: SearchResult -> SearchResult -> Bool
== :: SearchResult -> SearchResult -> Bool
$c== :: SearchResult -> SearchResult -> Bool
Eq)
makeLenses ''SearchResult

data IOPipes = IOPipes { IOPipes -> Handle
input :: Handle -- ^ The handle to the named piped on which the server receives input to search for.
                       , IOPipes -> Handle
output :: Handle -- ^ The handle to the named piped on which the searcher outputs the search results.
                       }

response :: SearchFunctions a -- ^ The functions determining how to much.
              -> V.Vector Text -- ^ The vector of candidates.
              -> Text -- ^ The text to match
              -> SearchResult -- ^ The last result result. This is used to determine which candidates to search among.
              -> SearchResult
response :: SearchFunctions a
-> Vector Text -> Text -> SearchResult -> SearchResult
response SearchFunctions a
f Vector Text
v Text
t SearchResult
s
  | Bool -> (Text -> Bool) -> Maybe Text -> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
False (Text -> Text -> Bool
`T.isInfixOf` Text
t) (SearchResult
s SearchResult
-> Getting (Maybe Text) SearchResult (Maybe Text) -> Maybe Text
forall s a. s -> Getting a s a -> a
^. Getting (Maybe Text) SearchResult (Maybe Text)
Lens' SearchResult (Maybe Text)
query)  = (Vector Int, (Int, Vector [Text])) -> SearchResult
forall a. (Vector Int, (a, Vector [Text])) -> SearchResult
go ((Vector Int, (Int, Vector [Text])) -> SearchResult)
-> (Vector Int -> (Vector Int, (Int, Vector [Text])))
-> Vector Int
-> SearchResult
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. 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
f Vector Text
v (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
t) (Vector Int -> SearchResult) -> Vector Int -> SearchResult
forall a b. (a -> b) -> a -> b
$ SearchResult
s SearchResult
-> Getting (Vector Int) SearchResult (Vector Int) -> Vector Int
forall s a. s -> Getting a s a -> a
^. Getting (Vector Int) SearchResult (Vector Int)
Lens' SearchResult (Vector Int)
allMatches
  | Bool
otherwise                                   = (Vector Int, (Int, Vector [Text])) -> SearchResult
forall a. (Vector Int, (a, Vector [Text])) -> SearchResult
go ((Vector Int, (Int, Vector [Text])) -> SearchResult)
-> (Vector Int -> (Vector Int, (Int, Vector [Text])))
-> Vector Int
-> SearchResult
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. 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
f Vector Text
v (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
t) (Vector Int -> SearchResult) -> Vector Int -> SearchResult
forall a b. (a -> b) -> a -> b
$ Int -> Int -> Vector Int
forall a. (Unbox a, Num a) => a -> Int -> Vector a
U.enumFromN Int
0 (Vector Text -> Int
forall a. Vector a -> Int
V.length Vector Text
v)
  where
    go :: (Vector Int, (a, Vector [Text])) -> SearchResult
go (Vector Int
a , (a
_ , Vector [Text]
m)) = Maybe Text -> Vector Int -> Vector [Text] -> SearchResult
SearchResult (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
t) Vector Int
a Vector [Text]
m

-- | One search event consisiting of the searcher reading a bytestring from the input named pipe. If the bytestring is empty the searcher exists. If not it
--   outputs the search results to the output handle and also returns them.
--
--   The first line of the output of results is the query. The second is an decimal integer @n@ which is the number of results to follow. There are @n@ more lines each
--  contaning a result presented according the function supplied.
event :: SearchFunctions a -> (Handle -> [Text] -> IO ()) -- ^ The functions that determines how a results is presented. Must not introduce newlines.
          -> IOPipes -- ^ The handles to the named pipes
          -> V.Vector Text -- ^ The candidates
          -> SearchResult -- ^ The last search result
          -> IO (Maybe SearchResult) -- ^ The final result. The Nothing is for the case if the input was empty signalling that the searcher should exit.
event :: SearchFunctions a
-> (Handle -> [Text] -> IO ())
-> IOPipes
-> Vector Text
-> SearchResult
-> IO (Maybe SearchResult)
event SearchFunctions a
f Handle -> [Text] -> IO ()
g (IOPipes Handle
i Handle
o) Vector Text
v SearchResult
s = (\Text
t -> if Text -> Bool
T.null Text
t then Maybe SearchResult -> IO (Maybe SearchResult)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe SearchResult
forall a. Maybe a
Nothing else Text -> IO (Maybe SearchResult)
go Text
t) (Text -> IO (Maybe SearchResult))
-> (ByteString -> Text) -> ByteString -> IO (Maybe SearchResult)
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.strip (Text -> Text) -> (ByteString -> Text) -> ByteString -> Text
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. ByteString -> Text
forall a b. EncodeString a b => b -> a
decodeStringLenient (ByteString -> IO (Maybe SearchResult))
-> IO ByteString -> IO (Maybe SearchResult)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Handle -> IO ByteString
B.hGetLine Handle
i
  where
    go :: Text -> IO (Maybe SearchResult)
go Text
t     = (\SearchResult
s' -> SearchResult -> IO ()
pream SearchResult
s' IO () -> IO () -> IO ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ([Text] -> IO ()) -> Vector [Text] -> IO ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> Vector a -> m ()
V.mapM_ (Handle -> [Text] -> IO ()
g Handle
o) (SearchResult
s' SearchResult
-> Getting (Vector [Text]) SearchResult (Vector [Text])
-> Vector [Text]
forall s a. s -> Getting a s a -> a
^. Getting (Vector [Text]) SearchResult (Vector [Text])
Lens' SearchResult (Vector [Text])
matches) IO () -> IO () -> IO ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Handle -> IO ()
hFlush Handle
o IO () -> Maybe SearchResult -> IO (Maybe SearchResult)
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> SearchResult -> Maybe SearchResult
forall a. a -> Maybe a
Just SearchResult
s') (SearchResult -> IO (Maybe SearchResult))
-> (SearchResult -> SearchResult)
-> SearchResult
-> IO (Maybe SearchResult)
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. SearchFunctions a
-> Vector Text -> Text -> SearchResult -> SearchResult
forall a.
SearchFunctions a
-> Vector Text -> Text -> SearchResult -> SearchResult
response SearchFunctions a
f Vector Text
v Text
t (SearchResult -> IO (Maybe SearchResult))
-> SearchResult -> IO (Maybe SearchResult)
forall a b. (a -> b) -> a -> b
$ SearchResult
s
    pream :: SearchResult -> IO ()
pream SearchResult
s' = Handle -> ByteString -> IO ()
B.hPutStrLn Handle
o (Text -> ByteString
forall a b. EncodeString a b => a -> b
encodeString (Text -> ByteString)
-> (Maybe Text -> Text) -> Maybe Text -> ByteString
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
forall a. a -> Maybe a -> a
fromMaybe Text
"" (Maybe Text -> ByteString) -> Maybe Text -> ByteString
forall a b. (a -> b) -> a -> b
$ SearchResult
s' SearchResult
-> Getting (Maybe Text) SearchResult (Maybe Text) -> Maybe Text
forall s a. s -> Getting a s a -> a
^. Getting (Maybe Text) SearchResult (Maybe Text)
Lens' SearchResult (Maybe Text)
query) IO () -> IO () -> IO ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Handle -> ByteString -> IO ()
B.hPutStrLn Handle
o (Int -> ByteString
forall a s. (Show a, ConvertString String s) => a -> s
show (Int -> ByteString)
-> (Vector [Text] -> Int) -> Vector [Text] -> ByteString
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 a. Vector a -> Int
V.length (Vector [Text] -> ByteString) -> Vector [Text] -> ByteString
forall a b. (a -> b) -> a -> b
$ SearchResult
s' SearchResult
-> Getting (Vector [Text]) SearchResult (Vector [Text])
-> Vector [Text]
forall s a. s -> Getting a s a -> a
^. Getting (Vector [Text]) SearchResult (Vector [Text])
Lens' SearchResult (Vector [Text])
matches)

-- | Starts with the dummy `initialSearchResult` and handles `event` in a loop until the searcher receives an empty input and exits.
searchLoop :: SearchFunctions a -> (Handle -> [Text] -> IO ())  -> V.Vector Text -> IO ()
searchLoop :: SearchFunctions a
-> (Handle -> [Text] -> IO ()) -> Vector Text -> IO ()
searchLoop SearchFunctions a
f Handle -> [Text] -> IO ()
g Vector Text
v = (IOPipes -> IO ()) -> IO ()
forall a. (IOPipes -> IO a) -> IO a
withIOPipes (\IOPipes
p -> IOPipes -> Maybe SearchResult -> IO ()
go IOPipes
p (Maybe SearchResult -> IO ())
-> (Vector Text -> Maybe SearchResult) -> Vector Text -> IO ()
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. SearchResult -> Maybe SearchResult
forall a. a -> Maybe a
Just (SearchResult -> Maybe SearchResult)
-> (Vector Text -> SearchResult)
-> Vector Text
-> Maybe SearchResult
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Vector Text -> SearchResult
initialSearchResult (Vector Text -> IO ()) -> Vector Text -> IO ()
forall a b. (a -> b) -> a -> b
$ Vector Text
v)
  where
    go :: IOPipes -> Maybe SearchResult -> IO ()
go IOPipes
p = IO () -> (SearchResult -> IO ()) -> Maybe SearchResult -> IO ()
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (() -> IO ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()) (IOPipes -> Maybe SearchResult -> IO ()
go IOPipes
p (Maybe SearchResult -> IO ())
-> (SearchResult -> IO (Maybe SearchResult))
-> SearchResult
-> IO ()
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=<  SearchFunctions a
-> (Handle -> [Text] -> IO ())
-> IOPipes
-> Vector Text
-> SearchResult
-> IO (Maybe SearchResult)
forall a.
SearchFunctions a
-> (Handle -> [Text] -> IO ())
-> IOPipes
-> Vector Text
-> SearchResult
-> IO (Maybe SearchResult)
event SearchFunctions a
f Handle -> [Text] -> IO ()
g IOPipes
p Vector Text
v)

-- | The dummy `SearchResult` use as the initial value. Contains an empty query, all the indices and no matches.
initialSearchResult :: V.Vector Text -> SearchResult
initialSearchResult :: Vector Text -> SearchResult
initialSearchResult Vector Text
v = Maybe Text -> Vector Int -> Vector [Text] -> SearchResult
SearchResult Maybe Text
forall a. Maybe a
Nothing (Int -> Int -> Vector Int
forall a. (Unbox a, Num a) => a -> Int -> Vector a
U.enumFromN Int
0 (Vector Text -> Int
forall a. Vector a -> Int
V.length Vector Text
v)) Vector [Text]
forall a. Vector a
V.empty

-- | Outputs the parts of a matching candidate to handle as space separated double quoted strings alternating between a match and a gap. The first text is
-- always a gap and can be empty the rest should be non-empty
showMatch :: Handle -> [Text] -> IO ()
showMatch :: Handle -> [Text] -> IO ()
showMatch Handle
o = Handle -> ByteString -> IO ()
B.hPutStrLn Handle
o (ByteString -> IO ()) -> ([Text] -> ByteString) -> [Text] -> IO ()
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (ByteString -> Text -> ByteString)
-> ByteString -> [Text] -> ByteString
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (\ByteString
b Text
n -> ByteString
b ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
" \"" ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> Text -> ByteString
forall a b. EncodeString a b => a -> b
encodeString Text
n ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
"\" ") ByteString
""

-- | Outputs a matching candidate for the terminal with the matches highlighted in blue. Uses the `Colored` `Text` monoid from `colorful-monoids` for coloring.
showMatchColor :: Handle -> [Text] -> IO ()
showMatchColor :: Handle -> [Text] -> IO ()
showMatchColor Handle
o [Text]
t = ((Handle -> Text -> IO ())
-> Handle -> Term -> Colored Text -> IO ()
forall a.
(Handle -> a -> IO ()) -> Handle -> Term -> Colored a -> IO ()
hPrintColored (\Handle
h -> Handle -> ByteString -> IO ()
B.hPutStr Handle
h (ByteString -> IO ()) -> (Text -> ByteString) -> Text -> IO ()
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Text -> ByteString
forall a b. EncodeString a b => a -> b
encodeString) Handle
o Term
Term8 (Colored Text -> IO ())
-> ([Text] -> Colored Text) -> [Text] -> IO ()
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (Colored Text, Bool) -> Colored Text
forall a b. (a, b) -> a
fst ((Colored Text, Bool) -> Colored Text)
-> ([Text] -> (Colored Text, Bool)) -> [Text] -> Colored Text
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. ((Colored Text, Bool) -> Text -> (Colored Text, Bool))
-> (Colored Text, Bool) -> [Text] -> (Colored Text, Bool)
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (Colored Text, Bool) -> Text -> (Colored Text, Bool)
forall a. (Colored a, Bool) -> a -> (Colored a, Bool)
go (Text -> Colored Text
forall a. a -> Colored a
Value Text
"" , Bool
False) ([Text] -> IO ()) -> [Text] -> IO ()
forall a b. (a -> b) -> a -> b
$ [Text]
t) IO () -> IO () -> IO ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Handle -> ByteString -> IO ()
B.hPutStrLn Handle
o ByteString
""
  where
    go :: (Colored a, Bool) -> a -> (Colored a, Bool)
go (Colored a
c , Bool
False) a
n = (Colored a
c Colored a -> Colored a -> Colored a
forall a. Semigroup a => a -> a -> a
<> a -> Colored a
forall a. a -> Colored a
Value a
n , Bool
True)
    go (Colored a
c , Bool
True ) a
n = (Colored a
c Colored a -> Colored a -> Colored a
forall a. Semigroup a => a -> a -> a
<> Color -> Colored a -> Colored a
forall a. Color -> Colored a -> Colored a
Fg Color
Blue (a -> Colored a
forall a. a -> Colored a
Value a
n) , Bool
False)

-- | Run an IO action that needs two handles to named pipes by creating two named pipes, opening the handles to them performing the action
--   and then cleaning up by closing the handles and deleting the named pipes created. The names of the pipes are printed on the stdout and are of the
--   form @\/tmp\/talash-input-pipe@ or @\/tmp\/talash-input-pipe\<n\>@ where n is an integer for the input-pipe and @\/tmp\/talash-output-pipe@ or
--   @\/tmp\/talash-output-pipe\<n\>@ for the output pipe. The integer @n@ will be the same for both.
withIOPipes :: (IOPipes -> IO a) -> IO a
withIOPipes :: (IOPipes -> IO a) -> IO a
withIOPipes IOPipes -> IO a
f = (String, String, IOPipes) -> IO a
doAct ((String, String, IOPipes) -> IO a)
-> IO (String, String, IOPipes) -> IO a
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< (String, String) -> IO (String, String, IOPipes)
openP ((String, String) -> IO (String, String, IOPipes))
-> IO (String, String) -> IO (String, String, IOPipes)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< IO Bool
-> IO (String, String)
-> IO (String, String)
-> IO (String, String)
forall (m :: * -> *) a. Monad m => m Bool -> m a -> m a -> m a
ifM (Bool -> Bool -> Bool
(||) (Bool -> Bool -> Bool) -> IO Bool -> IO (Bool -> Bool)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> IO Bool
fileExist String
i IO (Bool -> Bool) -> IO Bool -> IO Bool
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> String -> IO Bool
fileExist String
o) (Integer -> IO (String, String)
forall a. (Num a, Show a) => a -> IO (String, String)
go Integer
1) ((,) (String -> String -> (String, String))
-> IO String -> IO (String -> (String, String))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> IO String
mkp String
i IO (String -> (String, String)) -> IO String -> IO (String, String)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> String -> IO String
mkp String
o)
  where
    i :: String
i = String
"/tmp/talash-input-pipe"
    o :: String
o = String
"/tmp/talash-output-pipe"
    doAct :: (String, String, IOPipes) -> IO a
doAct (String
fi , String
fo , p :: IOPipes
p@(IOPipes Handle
ip Handle
op)) = IO a -> IO () -> IO a
forall a b. IO a -> IO b -> IO a
finally (IOPipes -> IO a
f IOPipes
p) (Handle -> IO ()
hClose Handle
ip IO () -> IO () -> IO ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Handle -> IO ()
hClose Handle
op IO () -> IO () -> IO ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> String -> IO ()
removeFile String
fi IO () -> IO () -> IO ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> String -> IO ()
removeFile String
fo)
    openP :: (String, String) -> IO (String, String, IOPipes)
openP (String
ip , String
op) = (\Handle
h Handle
g -> (String
ip , String
op , Handle -> Handle -> IOPipes
IOPipes Handle
h Handle
g)) (Handle -> Handle -> (String, String, IOPipes))
-> IO Handle -> IO (Handle -> (String, String, IOPipes))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> IOMode -> IO Handle
openFile String
ip IOMode
ReadWriteMode IO (Handle -> (String, String, IOPipes))
-> IO Handle -> IO (String, String, IOPipes)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> String -> IOMode -> IO Handle
openFile String
op IOMode
ReadWriteMode
    mkp :: String -> IO String
mkp String
p = String -> FileMode -> IO ()
createNamedPipe String
p FileMode
stdFileMode IO () -> IO () -> IO ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> String -> IO ()
forall (m :: * -> *) a. (MonadIO m, Show a) => a -> m ()
print String
p  IO () -> String -> IO String
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> String
p
    go :: a -> IO (String, String)
go a
n = IO Bool
-> IO (String, String)
-> IO (String, String)
-> IO (String, String)
forall (m :: * -> *) a. Monad m => m Bool -> m a -> m a -> m a
ifM (Bool -> Bool -> Bool
(||) (Bool -> Bool -> Bool) -> IO Bool -> IO (Bool -> Bool)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> IO Bool
fileExist String
i' IO (Bool -> Bool) -> IO Bool -> IO Bool
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> String -> IO Bool
fileExist String
o') (a -> IO (String, String)
go (a -> IO (String, String)) -> a -> IO (String, String)
forall a b. (a -> b) -> a -> b
$ a
n a -> a -> a
forall a. Num a => a -> a -> a
+ a
1) ((,) (String -> String -> (String, String))
-> IO String -> IO (String -> (String, String))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> IO String
mkp String
i' IO (String -> (String, String)) -> IO String -> IO (String, String)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> String -> IO String
mkp String
o')
      where
        i' :: String
i' = String
i String -> ShowS
forall a. Semigroup a => a -> a -> a
<> a -> String
forall a s. (Show a, ConvertString String s) => a -> s
show a
n
        o' :: String
o' = String
o String -> ShowS
forall a. Semigroup a => a -> a -> a
<> a -> String
forall a s. (Show a, ConvertString String s) => a -> s
show a
n

-- | Run search create a new session for the searcher to run in, forks a process in which the `searchLoop` is run in the background and exits.
runSearch :: SearchFunctions a -> (Handle -> [Text] -> IO ()) -> V.Vector Text -> IO ()
runSearch :: SearchFunctions a
-> (Handle -> [Text] -> IO ()) -> Vector Text -> IO ()
runSearch SearchFunctions a
f Handle -> [Text] -> IO ()
g Vector Text
v = IO ProcessGroupID
createSession IO ProcessGroupID -> IO ProcessGroupID -> IO ProcessGroupID
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> IO () -> IO ProcessGroupID
forkProcess (SearchFunctions a
-> (Handle -> [Text] -> IO ()) -> Vector Text -> IO ()
forall a.
SearchFunctions a
-> (Handle -> [Text] -> IO ()) -> Vector Text -> IO ()
searchLoop SearchFunctions a
f Handle -> [Text] -> IO ()
g Vector Text
v) IO ProcessGroupID -> IO () -> IO ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ExitCode -> IO ()
exitImmediately ExitCode
ExitSuccess

-- | Version of `runSearch` in which the vector of candidates is built by reading lines from stdin.
runSearchStdIn :: SearchFunctions a -> (Handle -> [Text] -> IO ()) -> IO ()
runSearchStdIn :: SearchFunctions a -> (Handle -> [Text] -> IO ()) -> IO ()
runSearchStdIn SearchFunctions a
f Handle -> [Text] -> IO ()
g = SearchFunctions a
-> (Handle -> [Text] -> IO ()) -> Vector Text -> IO ()
forall a.
SearchFunctions a
-> (Handle -> [Text] -> IO ()) -> Vector Text -> IO ()
runSearch SearchFunctions a
f Handle -> [Text] -> IO ()
g (Vector Text -> IO ())
-> (Compact (Vector Text) -> Vector Text)
-> Compact (Vector Text)
-> IO ()
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 ())
-> IO (Compact (Vector Text)) -> IO ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< 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
V.force (Vector Text -> IO (Compact (Vector Text)))
-> IO (Vector Text) -> IO (Compact (Vector Text))
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< IO (Vector Text)
readVectorStdIn

-- | Version of `runSearchStdIn` which uses `showMatch` to put the output on the handle.
runSearchStdInDef :: SearchFunctions a -> IO ()
runSearchStdInDef :: SearchFunctions a -> IO ()
runSearchStdInDef SearchFunctions a
f = SearchFunctions a -> (Handle -> [Text] -> IO ()) -> IO ()
forall a. SearchFunctions a -> (Handle -> [Text] -> IO ()) -> IO ()
runSearchStdIn SearchFunctions a
f Handle -> [Text] -> IO ()
showMatch

-- | Version of `runSearchStdIn` for viewing the matches on a terminal which uses `showMatchColor` to put the output on the handle.
runSearchStdInColor :: SearchFunctions a -> IO ()
runSearchStdInColor :: SearchFunctions a -> IO ()
runSearchStdInColor SearchFunctions a
f = SearchFunctions a -> (Handle -> [Text] -> IO ()) -> IO ()
forall a. SearchFunctions a -> (Handle -> [Text] -> IO ()) -> IO ()
runSearchStdIn SearchFunctions a
f Handle -> [Text] -> IO ()
showMatchColor

-- Send a query to the searcher by writing the text in the second argument to the named-pipe with path given by the first argument.
-- Does not check if the file is a named pipe.
send :: String -> Text -> IO ()
send :: String -> Text -> IO ()
send String
i Text
q = IO Bool -> IO () -> IO () -> IO ()
forall (m :: * -> *) a. Monad m => m Bool -> m a -> m a -> m a
ifM (String -> IO Bool
fileExist String
i) (String -> IOMode -> (Handle -> IO ()) -> IO ()
forall r. String -> IOMode -> (Handle -> IO r) -> IO r
withFile String
i IOMode
WriteMode (Handle -> ByteString -> IO ()
`B.hPutStrLn` Text -> ByteString
forall a b. EncodeString a b => a -> b
encodeString Text
q)) (Text -> IO ()
forall (m :: * -> *). MonadIO m => Text -> m ()
putStrLn (Text -> IO ()) -> (String -> Text) -> String -> IO ()
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. String -> Text
forall a b. ConvertString a b => a -> b
convertString (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
"the named pipe" String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
i String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" does not exist")

-- Read the results from the searcher from the named pipe with the path given as the argument. Does not check if the file exists or is a named pipe.
recieve :: String -> IO ()
recieve :: String -> IO ()
recieve String
o = String -> IOMode -> (Handle -> IO ()) -> IO ()
forall r. String -> IOMode -> (Handle -> IO r) -> IO r
withFile String
o IOMode
ReadMode (\Handle
h -> Handle -> IO ByteString
B.hGetLine Handle
h IO ByteString -> IO () -> IO ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (Handle -> Maybe Int -> IO ()
go Handle
h (Maybe Int -> IO ())
-> (ByteString -> Maybe Int) -> ByteString -> IO ()
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. String -> Maybe Int
forall b a. (Read b, ConvertString a String) => a -> Maybe b
readMaybe (String -> Maybe Int)
-> (ByteString -> String) -> ByteString -> Maybe Int
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. ByteString -> String
B.unpack (ByteString -> IO ()) -> IO ByteString -> IO ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Handle -> IO ByteString
B.hGetLine Handle
h))
  where
    go :: Handle -> Maybe Int -> IO ()
go Handle
h = IO () -> (Int -> IO ()) -> Maybe Int -> IO ()
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Text -> IO ()
forall (m :: * -> *). MonadIO m => Text -> m ()
putStrLn Text
"Couldn't read the number of results.") (\Int
n -> Int -> IO () -> IO ()
forall (m :: * -> *) a. Applicative m => Int -> m a -> m ()
replicateM_ Int
n (ByteString -> IO ()
B.putStrLn (ByteString -> IO ()) -> IO ByteString -> IO ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Handle -> IO ByteString
B.hGetLine Handle
h))

-- Do one round of sending a qeury to the searcher and receiving the results.
askSearcher :: String -- ^ Path to the input named pipe to which to write the query.
  -> String -- ^ Path to the output named pipe from which to read the results.
  -> Text -- ^ Th qeury itself.
  -> IO ()
askSearcher :: String -> String -> Text -> IO ()
askSearcher String
ip String
op Text
q = if Text
q Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"" then String -> Text -> IO ()
send String
ip Text
q else String -> Text -> IO ()
send String
ip Text
q IO () -> IO () -> IO ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> String -> IO ()
recieve String
op

-- | run' is the backend of `run` which is just `run\' =<< getArgs`
run' :: [String] -> IO ()
run' :: [String] -> IO ()
run' [String
"load"]               = SearchFunctions Int -> IO ()
forall a. SearchFunctions a -> IO ()
runSearchStdInColor SearchFunctions Int
searchFunctionsOL
run' [String
"load" , String
"fuzzy"]     = SearchFunctions MatchPart -> IO ()
forall a. SearchFunctions a -> IO ()
runSearchStdInColor SearchFunctions MatchPart
searchFunctionsFuzzy
run' [String
"load" , String
"orderless"] = SearchFunctions Int -> IO ()
forall a. SearchFunctions a -> IO ()
runSearchStdInColor SearchFunctions Int
searchFunctionsOL
run' [String
"find" , String
x]           = String -> String -> Text -> IO ()
askSearcher String
"/tmp/talash-input-pipe"  String
"/tmp/talash-output-pipe" (Text -> IO ()) -> (String -> Text) -> String -> IO ()
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. String -> Text
forall a b. ConvertString a b => a -> b
convertString (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
x
run' [String
"find" , String
n , String
x]       = String -> String -> Text -> IO ()
askSearcher (String
"/tmp/talash-input-pipe" String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
n)  (String
"/tmp/talash-output-pipe" String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
n) (Text -> IO ()) -> (String -> Text) -> String -> IO ()
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. String -> Text
forall a b. ConvertString a b => a -> b
convertString (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
x
run' [String
"find" , String
i , String
o , String
x]   = String -> String -> Text -> IO ()
askSearcher String
i String
o (Text -> IO ()) -> (String -> Text) -> String -> IO ()
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. String -> Text
forall a b. ConvertString a b => a -> b
convertString (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
x
run' [String
"exit"]               = String -> String -> Text -> IO ()
askSearcher String
"/tmp/talash-input-pipe"  String
"/tmp/talash-output-pipe" Text
""
run' [String
"exit" , String
n]           = String -> String -> Text -> IO ()
askSearcher (String
"/tmp/talash-input-pipe" String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
n)  (String
"/tmp/talash-output-pipe" String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
n) Text
""
run' [String
"exit" , String
i , String
o]       = String -> String -> Text -> IO ()
askSearcher String
i String
o Text
""
run' [String]
xs                     = (\Term
t -> (Text -> IO ()) -> Term -> Colored Text -> IO ()
forall a. (a -> IO ()) -> Term -> Colored a -> IO ()
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
getTerm

usageString :: Colored Text
usageString :: Colored Text
usageString =   Colored Text
"talash piped is a set of commands for loading data into a talash instance or searching from a running one. \n"
             Colored Text -> Colored Text -> Colored Text
forall a. Semigroup a => a -> a -> a
<> Colored Text
"The input pipe for default instance is at " 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
Fg Color
Green Colored Text
" /tmp/talash-input-pipe " Colored Text -> Colored Text -> Colored Text
forall a. Semigroup a => a -> a -> a
<> Colored Text
" and the output pipe is at " 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
Fg Color
Green Colored Text
" /tmp/talash-output-pipe \n"
             Colored Text -> Colored Text -> Colored Text
forall a. Semigroup a => a -> a -> a
<> Colored Text
"The input and output pipes for the <n>-th default instances are at " 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
Fg Color
Green Colored Text
" /tmp/talash-input-pipe<n> and " 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
Fg Color
Green Colored Text
" /tmp/talash-output-pipe<n> \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
Fg Color
Blue Colored Text
" talash piped load" Colored Text -> Colored Text -> Colored Text
forall a. Semigroup a => a -> a -> a
<> Colored Text
" : loads the candidates from the stdin (uses orderless style) for later searches. \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
Fg Color
Blue Colored Text
" talash piped load fuzzy" Colored Text -> Colored Text -> Colored Text
forall a. Semigroup a => a -> a -> a
<> Colored Text
" : loads the candidates and uses fuzzy style for search \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
Fg Color
Blue Colored Text
" talash piped load orderless" Colored Text -> Colored Text -> Colored Text
forall a. Semigroup a => a -> a -> a
<> Colored Text
" : loads the candidates and uses orderless style for search \n"
             Colored Text -> Colored Text -> Colored Text
forall a. Semigroup a => a -> a -> a
<> Colored Text
"All the load command print the input and output pipes for their instances on the stdout."
             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
Fg Color
Blue Colored Text
" talash piped find <x>" Colored Text -> Colored Text -> Colored Text
forall a. Semigroup a => a -> a -> a
<> Colored Text
" : prints the search results for query <x> from the already running default instance \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
Fg Color
Blue Colored Text
" talash piped find <i> <o> x" Colored Text -> Colored Text -> Colored Text
forall a. Semigroup a => a -> a -> a
<> Colored Text
" : prints the search results for query <x> from the instance with input pipe <i> and output pipe <o>\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
Fg Color
Blue Colored Text
" talash piped find <n> <x>" Colored Text -> Colored Text -> Colored Text
forall a. Semigroup a => a -> a -> a
<> Colored Text
" : prints the search results for query <x> from the <n>-th default instance.\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
Fg Color
Blue Colored Text
" talash piped exit" Colored Text -> Colored Text -> Colored Text
forall a. Semigroup a => a -> a -> a
<> Colored Text
" : causes the default instance to exit and deletes its pipes.\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
Fg Color
Blue Colored Text
" talash piped exit <n>" Colored Text -> Colored Text -> Colored Text
forall a. Semigroup a => a -> a -> a
<> Colored Text
" : causes the <n>-th instance to exit and deletes its pipes.\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
Fg Color
Blue Colored Text
" talash piped exit <i> <o>" Colored Text -> Colored Text -> Colored Text
forall a. Semigroup a => a -> a -> a
<> Colored Text
" : causes the instance at pipes <i> and <o> to exist and deletes the pipes.\n"
             Colored Text -> Colored Text -> Colored Text
forall a. Semigroup a => a -> a -> a
<> Colored Text
" A running instance also exits on the usage of a find command with empty query. \n"

-- | run is a small demo program for the piped search. Run `talash piped` to see usage information.
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