{-# 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
                      PipedSearcher (..) , query , allMatches , CaseSensitivity (..)
                    --   -- * Searcher
                    , searchLoop , runSearch , runSearchStdIn  ,  runSearchStdInDef , showMatchColor
                    --   -- * Seeker
                    , askSearcher
                    --   -- * Default program
                    , run , run'
                    --   -- * Exposed Internals
                    , withNamedPipes , send , recieve)
where

import qualified Data.ByteString.Char8 as B
import Data.Monoid.Colorful
import qualified Data.Text as T
import qualified Data.Text.IO as T
import qualified Data.Vector as V
import qualified Data.Vector.Unboxed as U
import GHC.Compact
import 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.Chunked hiding (makeMatcher , send)
import Talash.Intro
import Lens.Micro.TH (makeLenses)

data PipedSearcher = PipedSearcher { PipedSearcher -> Handle
_inputHandle :: Handle
                                   , PipedSearcher -> Handle
_outputHandle :: Handle
                                   , PipedSearcher -> Int
_maximumMatches :: Int
                                   , PipedSearcher -> SearchReport -> Bool
_printStrategy :: SearchReport -> Bool
                                   , PipedSearcher -> Handle -> [Text] -> IO ()
_printer :: Handle -> [Text] -> IO ()}
makeLenses ''PipedSearcher

printMatches :: forall n m a. (KnownNat n , KnownNat m) => SearchFunctions a Text -> PipedSearcher -> Chunks n
                                                                -> SearchReport -> MatcherSized m a -> MatchSetSized m -> IO ()
printMatches :: forall (n :: Nat) (m :: Nat) a.
(KnownNat n, KnownNat m) =>
SearchFunctions a Text
-> PipedSearcher
-> Chunks n
-> SearchReport
-> MatcherSized m a
-> MatchSetSized m
-> IO ()
printMatches SearchFunctions a Text
funcs PipedSearcher
searcher Chunks n
store SearchReport
r MatcherSized m a
m MatchSetSized m
s = forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when ((PipedSearcher
searcher forall s a. s -> Getting a s a -> a
^. Lens' PipedSearcher (SearchReport -> Bool)
printStrategy) SearchReport
r) (Handle -> Text -> IO ()
T.hPutStrLn Handle
out (String -> Text
T.pack forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> String
show forall a b. (a -> b) -> a -> b
$ SearchReport
r forall s a. s -> Getting a s a -> a
^. Lens' SearchReport Int
nummatches) forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ ScoredMatchSized m -> IO ()
doPrint MatchSetSized m
s forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Handle -> IO ()
hFlush Handle
out)
  where
    out :: Handle
out = PipedSearcher
searcher forall s a. s -> Getting a s a -> a
^. Lens' PipedSearcher Handle
outputHandle
    doPrint :: ScoredMatchSized m -> IO ()
doPrint (ScoredMatchSized Down Int
_ ChunkIndex
c Vector m Int
v) =  (PipedSearcher
searcher forall s a. s -> Getting a s a -> a
^. Lens' PipedSearcher (Handle -> [Text] -> IO ())
printer) Handle
out forall b c a. (b -> c) -> (a -> b) -> a -> c
. (SearchFunctions a Text
funcs forall s a. s -> Getting a s a -> a
^. forall a b (n :: Nat).
KnownNat n =>
SimpleGetter
  (SearchFunctions a b)
  ((Bool -> Text -> b)
   -> MatcherSized n a -> Text -> Vector n Int -> [b])
display) (forall a b. a -> b -> a
const forall a. a -> a
id) MatcherSized m a
m (Chunks n
store forall (n :: Nat). KnownNat n => Chunks n -> ChunkIndex -> Text
! ChunkIndex
c) forall a b. (a -> b) -> a -> b
$ Vector m Int
v

pipedEnv :: KnownNat n => SearchFunctions a Text -> PipedSearcher -> Chunks n -> IO (SearchEnv n a Text)
pipedEnv :: forall (n :: Nat) a.
KnownNat n =>
SearchFunctions a Text
-> PipedSearcher -> Chunks n -> IO (SearchEnv n a Text)
pipedEnv SearchFunctions a Text
funcs PipedSearcher
searcher = forall (n :: Nat) a b.
KnownNat n =>
SearchFunctions a b
-> Int
-> (forall (n1 :: Nat) (m :: Nat).
    (KnownNat n1, KnownNat m) =>
    Chunks n1
    -> SearchReport -> MatcherSized m a -> MatchSetSized m -> IO ())
-> Chunks n
-> IO (SearchEnv n a b)
searchEnv SearchFunctions a Text
funcs (PipedSearcher
searcher forall s a. s -> Getting a s a -> a
^. Lens' PipedSearcher Int
maximumMatches) (forall (n :: Nat) (m :: Nat) a.
(KnownNat n, KnownNat m) =>
SearchFunctions a Text
-> PipedSearcher
-> Chunks n
-> SearchReport
-> MatcherSized m a
-> MatchSetSized m
-> IO ()
printMatches SearchFunctions a Text
funcs PipedSearcher
searcher)

search :: KnownNat n => IO () -> Handle -> SearchEnv n a b -> IO ()
search :: forall (n :: Nat) a b.
KnownNat n =>
IO () -> Handle -> SearchEnv n a b -> IO ()
search IO ()
fin Handle
inp SearchEnv n a b
env = forall a b. IO a -> IO b -> IO a
finally (forall (n :: Nat) a b. KnownNat n => SearchEnv n a b -> IO ()
startSearcher SearchEnv n a b
env forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (Text -> IO ()
loop forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Handle -> IO Text
T.hGetLine Handle
inp)) IO ()
fin
  where
    loop :: Text -> IO ()
loop Text
""    = forall (n :: Nat) a b. KnownNat n => SearchEnv n a b -> IO ()
stopSearcher SearchEnv n a b
env
    loop Text
query = forall (n :: Nat) a b.
KnownNat n =>
SearchEnv n a b -> Text -> IO ()
sendQuery SearchEnv n a b
env Text
query forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (Text -> IO ()
loop forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Handle -> IO Text
T.hGetLine Handle
inp)

-- | Outputs a matching candidate for the terminal with the matches highlighted in blue. Uses the `Colored` `Text` monoid from `colorful-monoids` for coloring.
showMatchColor :: Handle -> [Text] -> IO ()
showMatchColor :: Handle -> [Text] -> IO ()
showMatchColor Handle
o [Text]
t = (forall a.
(Handle -> a -> IO ()) -> Handle -> Term -> Colored a -> IO ()
hPrintColored (\Handle
h -> Handle -> ByteString -> IO ()
B.hPutStr Handle
h forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> ByteString
encodeUtf8) Handle
o Term
Term8 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' forall {a}. (Colored a, Bool) -> a -> (Colored a, Bool)
go (forall a. a -> Colored a
Value Text
"" , Bool
False) forall a b. (a -> b) -> a -> b
$ [Text]
t) 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 forall a. Semigroup a => a -> a -> a
<> forall a. a -> Colored a
Value a
n , Bool
True)
    go (Colored a
c , Bool
True ) a
n = (Colored a
c forall a. Semigroup a => a -> a -> a
<> forall a. Style -> Colored a -> Colored a
Style Style
Bold (forall a. Color -> Colored a -> Colored a
Fg Color
Blue (forall a. a -> Colored a
Value a
n)) , Bool
False)

defSearcher :: Handle -> Handle -> PipedSearcher
defSearcher :: Handle -> Handle -> PipedSearcher
defSearcher Handle
ih Handle
oh = Handle
-> Handle
-> Int
-> (SearchReport -> Bool)
-> (Handle -> [Text] -> IO ())
-> PipedSearcher
PipedSearcher Handle
ih Handle
oh Int
4096 (\SearchReport
r -> SearchReport
r forall s a. s -> Getting a s a -> a
^. Lens' SearchReport Ocassion
ocassion forall a. Eq a => a -> a -> Bool
== Ocassion
QueryDone) Handle -> [Text] -> IO ()
showMatchColor

-- | Run an IO action that needs two handles to named pipes by creating two named pipes, opening the handles to them performing the action
--   and then cleaning up by closing the handles and deleting the named pipes created. The names of the pipes are printed on the stdout and are of the
--   form @\/tmp\/talash-input-pipe@ or @\/tmp\/talash-input-pipe\<n\>@ where n is an integer for the input-pipe and @\/tmp\/talash-output-pipe@ or
--   @\/tmp\/talash-output-pipe\<n\>@ for the output pipe. The integer @n@ will be the same for both.
withNamedPipes :: (IO () -> Handle -> Handle -> IO a) -> IO a
withNamedPipes :: forall a. (IO () -> Handle -> Handle -> IO a) -> IO a
withNamedPipes IO () -> Handle -> Handle -> IO a
f = (String, String, Handle, Handle) -> IO a
doAct forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< (String, String) -> IO (String, String, Handle, Handle)
openP forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall (m :: * -> *) a. Monad m => m Bool -> m a -> m a -> m a
ifM (Bool -> Bool -> Bool
(||) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> IO Bool
fileExist String
i forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> String -> IO Bool
fileExist String
o) (forall {a}. (Num a, Show a) => a -> IO (String, String)
go Integer
1) ((,) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> IO String
mkp String
i 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, Handle, Handle) -> IO a
doAct (String
fi , String
fo , Handle
ih , Handle
oh) = IO () -> Handle -> Handle -> IO a
f (Handle -> IO ()
hClose Handle
ih forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Handle -> IO ()
hClose Handle
oh forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> String -> IO ()
removeFile String
fi forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> String -> IO ()
removeFile String
fo) Handle
ih Handle
oh
    openP :: (String, String) -> IO (String, String, Handle, Handle)
openP (String
ip , String
op) = (\Handle
ih Handle
oh -> (String
ip , String
op , Handle
ih , Handle
oh)) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> IOMode -> IO Handle
openFile String
ip IOMode
ReadWriteMode 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 forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall a. Show a => a -> IO ()
print String
p  forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> String
p
    go :: a -> IO (String, String)
go a
n = forall (m :: * -> *) a. Monad m => m Bool -> m a -> m a -> m a
ifM (Bool -> Bool -> Bool
(||) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> IO Bool
fileExist String
i' forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> String -> IO Bool
fileExist String
o') (a -> IO (String, String)
go forall a b. (a -> b) -> a -> b
$ a
n forall a. Num a => a -> a -> a
+ a
1) ((,) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> IO String
mkp String
i' 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 forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show a
n
        o' :: String
o' = String
o forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
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 :: KnownNat n => IO () -> SearchFunctions a Text -> PipedSearcher -> Chunks n -> IO ()
runSearch :: forall (n :: Nat) a.
KnownNat n =>
IO ()
-> SearchFunctions a Text -> PipedSearcher -> Chunks n -> IO ()
runSearch IO ()
fin SearchFunctions a Text
funcs PipedSearcher
searcher Chunks n
c = IO ProcessID
createSession forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> IO () -> IO ProcessID
forkProcess (forall (n :: Nat) a b.
KnownNat n =>
IO () -> Handle -> SearchEnv n a b -> IO ()
search IO ()
fin (PipedSearcher
searcher forall s a. s -> Getting a s a -> a
^. Lens' PipedSearcher Handle
inputHandle) forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall (n :: Nat) a.
KnownNat n =>
SearchFunctions a Text
-> PipedSearcher -> Chunks n -> IO (SearchEnv n a Text)
pipedEnv SearchFunctions a Text
funcs PipedSearcher
searcher Chunks n
c) 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 :: KnownNat n => Proxy n -> IO () -> SearchFunctions a Text -> PipedSearcher -> IO ()
runSearchStdIn :: forall (n :: Nat) a.
KnownNat n =>
Proxy n
-> IO () -> SearchFunctions a Text -> PipedSearcher -> IO ()
runSearchStdIn Proxy n
p IO ()
fin SearchFunctions a Text
funcs PipedSearcher
searcher = forall (n :: Nat) a.
KnownNat n =>
IO ()
-> SearchFunctions a Text -> PipedSearcher -> Chunks n -> IO ()
runSearch IO ()
fin SearchFunctions a Text
funcs PipedSearcher
searcher forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Compact a -> a
getCompact forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall a. a -> IO (Compact a)
compact forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (n :: Nat). KnownNat n => Chunks n -> Chunks n
forceChunks forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall (n :: Nat). KnownNat n => Proxy n -> Handle -> IO (Chunks n)
chunksFromHandle Proxy n
p Handle
stdin

-- | Version of `runSearchStdIn` which uses `showMatch` to put the output on the handle.
runSearchStdInDef :: SearchFunctions a Text -> IO ()
runSearchStdInDef :: forall a. SearchFunctions a Text -> IO ()
runSearchStdInDef SearchFunctions a Text
funcs = forall a. (IO () -> Handle -> Handle -> IO a) -> IO a
withNamedPipes (\IO ()
fin Handle
ih -> forall (n :: Nat) a.
KnownNat n =>
Proxy n
-> IO () -> SearchFunctions a Text -> PipedSearcher -> IO ()
runSearchStdIn (forall {k} (t :: k). Proxy t
Proxy :: Proxy 32) IO ()
fin SearchFunctions a Text
funcs forall b c a. (b -> c) -> (a -> b) -> a -> c
. Handle -> Handle -> PipedSearcher
defSearcher Handle
ih) -- runSearchStdIn f showMatch

-- Send a query to the searcher by writing the text in the second argument to the named-pipe with path given by the first argument.
-- Does not check if the file is a named pipe.
send :: String -> Text -> IO ()
send :: String -> Text -> IO ()
send String
i Text
q = forall (m :: * -> *) a. Monad m => m Bool -> m a -> m a -> m a
ifM (String -> IO Bool
fileExist String
i) (forall r. String -> IOMode -> (Handle -> IO r) -> IO r
withFile String
i IOMode
WriteMode (Handle -> ByteString -> IO ()
`B.hPutStrLn` Text -> ByteString
encodeUtf8 Text
q)) (Text -> IO ()
putStrLn forall a b. (a -> b) -> a -> b
$ Text
"the named pipe" forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack String
i forall a. Semigroup a => a -> a -> a
<> Text
" 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 = forall r. String -> IOMode -> (Handle -> IO r) -> IO r
withFile String
o IOMode
ReadMode (\Handle
h -> (Handle -> Maybe Int -> IO ()
go Handle
h forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Read a => String -> Maybe a
readMaybe forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> String
B.unpack 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 = forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Text -> IO ()
putStrLn Text
"Couldn't read the number of results.") (\Int
n -> forall (m :: * -> *) a. Applicative m => Int -> m a -> m ()
replicateM_ Int
n (ByteString -> IO ()
B.putStrLn 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 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 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"]               = forall a. SearchFunctions a Text -> IO ()
runSearchStdInDef (forall b. CaseSensitivity -> SearchFunctions Int b
orderlessFunctions CaseSensitivity
IgnoreCase)
run' [String
"load" , String
"fuzzy"]     = forall a. SearchFunctions a Text -> IO ()
runSearchStdInDef (forall b. CaseSensitivity -> SearchFunctions MatchPart b
fuzzyFunctions CaseSensitivity
IgnoreCase)
run' [String
"load" , String
"orderless"] = forall a. SearchFunctions a Text -> IO ()
runSearchStdInDef (forall b. CaseSensitivity -> SearchFunctions Int b
orderlessFunctions CaseSensitivity
IgnoreCase)
run' [String
"find" , String
x]           = String -> String -> Text -> IO ()
askSearcher String
"/tmp/talash-input-pipe"  String
"/tmp/talash-output-pipe" forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
T.pack 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" forall a. Semigroup a => a -> a -> a
<> String
n)  (String
"/tmp/talash-output-pipe" forall a. Semigroup a => a -> a -> a
<> String
n) forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
T.pack 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 forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
T.pack 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" forall a. Semigroup a => a -> a -> a
<> String
n)  (String
"/tmp/talash-output-pipe" 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 -> forall a. (a -> IO ()) -> Term -> Colored a -> IO ()
printColored Text -> IO ()
putStr Term
t Colored Text
usageString) 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"
             forall a. Semigroup a => a -> a -> a
<> Colored Text
"The input pipe for default instance is at " forall a. Semigroup a => a -> a -> a
<> forall a. Color -> Colored a -> Colored a
Fg Color
Green Colored Text
" /tmp/talash-input-pipe " forall a. Semigroup a => a -> a -> a
<> Colored Text
" and the output pipe is at " forall a. Semigroup a => a -> a -> a
<> forall a. Color -> Colored a -> Colored a
Fg Color
Green Colored Text
" /tmp/talash-output-pipe \n"
             forall a. Semigroup a => a -> a -> a
<> Colored Text
"The input and output pipes for the <n>-th default instances are at " forall a. Semigroup a => a -> a -> a
<> forall a. Color -> Colored a -> Colored a
Fg Color
Green Colored Text
" /tmp/talash-input-pipe<n> and " forall a. Semigroup a => a -> a -> a
<> forall a. Color -> Colored a -> Colored a
Fg Color
Green Colored Text
" /tmp/talash-output-pipe<n> \n"
             forall a. Semigroup a => a -> a -> a
<> forall a. Color -> Colored a -> Colored a
Fg Color
Blue Colored Text
" talash piped load" forall a. Semigroup a => a -> a -> a
<> Colored Text
" : loads the candidates from the stdin (uses orderless style) for later searches. \n"
             forall a. Semigroup a => a -> a -> a
<> forall a. Color -> Colored a -> Colored a
Fg Color
Blue Colored Text
" talash piped load fuzzy" forall a. Semigroup a => a -> a -> a
<> Colored Text
" : loads the candidates and uses fuzzy style for search \n"
             forall a. Semigroup a => a -> a -> a
<> forall a. Color -> Colored a -> Colored a
Fg Color
Blue Colored Text
" talash piped load orderless" forall a. Semigroup a => a -> a -> a
<> Colored Text
" : loads the candidates and uses orderless style for search \n"
             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."
             forall a. Semigroup a => a -> a -> a
<> forall a. Color -> Colored a -> Colored a
Fg Color
Blue Colored Text
" talash piped find <x>" forall a. Semigroup a => a -> a -> a
<> Colored Text
" : prints the search results for query <x> from the already running default instance \n"
             forall a. Semigroup a => a -> a -> a
<> forall a. Color -> Colored a -> Colored a
Fg Color
Blue Colored Text
" talash piped find <i> <o> x" 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"
             forall a. Semigroup a => a -> a -> a
<> forall a. Color -> Colored a -> Colored a
Fg Color
Blue Colored Text
" talash piped find <n> <x>" forall a. Semigroup a => a -> a -> a
<> Colored Text
" : prints the search results for query <x> from the <n>-th default instance.\n"
             forall a. Semigroup a => a -> a -> a
<> forall a. Color -> Colored a -> Colored a
Fg Color
Blue Colored Text
" talash piped exit" forall a. Semigroup a => a -> a -> a
<> Colored Text
" : causes the default instance to exit and deletes its pipes.\n"
             forall a. Semigroup a => a -> a -> a
<> forall a. Color -> Colored a -> Colored a
Fg Color
Blue Colored Text
" talash piped exit <n>" forall a. Semigroup a => a -> a -> a
<> Colored Text
" : causes the <n>-th instance to exit and deletes its pipes.\n"
             forall a. Semigroup a => a -> a -> a
<> forall a. Color -> Colored a -> Colored a
Fg Color
Blue Colored Text
" talash piped exit <i> <o>" forall a. Semigroup a => a -> a -> a
<> Colored Text
" : causes the instance at pipes <i> and <o> to exist and deletes the pipes.\n"
             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' forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< IO [String]
getArgs