-- |

module Talash.SimpleSearcher where

import Control.Concurrent (forkIO, threadDelay)
import Control.Concurrent.MVar
import qualified Data.ByteString.Char8 as B
import Data.Monoid.Colorful
import qualified Data.Text as T
import Data.Text.AhoCorasick.Automaton (CaseSensitivity(..))
import qualified Data.Vector as V
import GHC.TypeLits
import Lens.Micro
import qualified System.IO.Streams as I
import Talash.Chunked
import Talash.Core hiding (match , makeMatcher)
import Talash.Files
import Talash.Intro hiding (splitAt)
import Talash.ScoredMatch
import GHC.Compact (Compact , compact , getCompact)

data SimpleSearcher = SimpleSearcher {SimpleSearcher -> [Text]
terms :: [Text] , SimpleSearcher -> Int
sleepTime :: Int , SimpleSearcher -> Int
matchesToPrint :: Int}

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

printMatches :: forall n m a. (KnownNat n , KnownNat m) => SearchFunctions a Text -> Chunks n -> SearchReport -> MatcherSized m a -> MatchSetSized m -> IO ()
printMatches :: forall (n :: Nat) (m :: Nat) a.
(KnownNat n, KnownNat m) =>
SearchFunctions a Text
-> Chunks n
-> SearchReport
-> MatcherSized m a
-> MatchSetSized m
-> IO ()
printMatches SearchFunctions a Text
funcs Chunks n
store SearchReport
r MatcherSized m a
m MatchSetSized m
s = forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Ocassion
o forall a. Eq a => a -> a -> Bool
== Ocassion
QueryDone Bool -> Bool -> Bool
|| Ocassion
o forall a. Eq a => a -> a -> Bool
== Ocassion
NewQuery) (Text -> IO ()
putStrLn forall a b. (a -> b) -> a -> b
$ (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
$ Int
n) forall a. Semigroup a => a -> a -> a
<> Text
" Matches for this round.\n")
  where
    o :: Ocassion
o = SearchReport
r forall s a. s -> Getting a s a -> a
^. Lens' SearchReport Ocassion
ocassion
    n :: Int
n = SearchReport
r forall s a. s -> Getting a s a -> a
^. Lens' SearchReport Int
nummatches

printMatchesMvar :: forall n m a. (KnownNat n , KnownNat m) => SearchFunctions a Text -> MVar () -> Chunks n -> SearchReport -> MatcherSized m a -> MatchSetSized m -> IO ()
printMatchesMvar :: forall (n :: Nat) (m :: Nat) a.
(KnownNat n, KnownNat m) =>
SearchFunctions a Text
-> MVar ()
-> Chunks n
-> SearchReport
-> MatcherSized m a
-> MatchSetSized m
-> IO ()
printMatchesMvar SearchFunctions a Text
funcs MVar ()
v Chunks n
store SearchReport
r MatcherSized m a
m MatchSetSized m
s = forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (SearchReport
r forall s a. s -> Getting a s a -> a
^. Lens' SearchReport Ocassion
ocassion forall a. Eq a => a -> a -> Bool
== Ocassion
QueryDone) (forall a. MVar a -> a -> IO ()
putMVar MVar ()
v () forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Text -> IO ()
putStrLn ((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 a. Semigroup a => a -> a -> a
<> Text
" matches for this round.")
                                                  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 Down Int
_ ChunkIndex
c Vector m Int
v) -> Handle -> [Text] -> IO ()
showMatchColor Handle
stdout 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) MatchSetSized m
s)

simpleFuzzyEnv :: KnownNat n => Int -> Proxy n -> V.Vector Text -> IO (SearchEnv n MatchPart Text)
simpleFuzzyEnv :: forall (n :: Nat).
KnownNat n =>
Int -> Proxy n -> Vector Text -> IO (SearchEnv n MatchPart Text)
simpleFuzzyEnv Int
n Proxy n
_ = 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 (forall b. CaseSensitivity -> SearchFunctions MatchPart b
fuzzyFunctions CaseSensitivity
IgnoreCase) Int
n (forall (n :: Nat) (m :: Nat) a.
(KnownNat n, KnownNat m) =>
SearchFunctions a Text
-> Chunks n
-> SearchReport
-> MatcherSized m a
-> MatchSetSized m
-> IO ()
printMatches (forall b. CaseSensitivity -> SearchFunctions MatchPart b
fuzzyFunctions CaseSensitivity
IgnoreCase)) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (n :: Nat). KnownNat n => Vector Text -> Chunks n
makeChunks

simpleFuzzyEnvM :: KnownNat n => MVar () -> Int -> Proxy n -> V.Vector Text -> IO (SearchEnv n MatchPart Text)
simpleFuzzyEnvM :: forall (n :: Nat).
KnownNat n =>
MVar ()
-> Int -> Proxy n -> Vector Text -> IO (SearchEnv n MatchPart Text)
simpleFuzzyEnvM MVar ()
m Int
n Proxy n
_ = 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 (forall b. CaseSensitivity -> SearchFunctions MatchPart b
fuzzyFunctions CaseSensitivity
IgnoreCase) Int
n (forall (n :: Nat) (m :: Nat) a.
(KnownNat n, KnownNat m) =>
SearchFunctions a Text
-> MVar ()
-> Chunks n
-> SearchReport
-> MatcherSized m a
-> MatchSetSized m
-> IO ()
printMatchesMvar (forall b. CaseSensitivity -> SearchFunctions MatchPart b
fuzzyFunctions CaseSensitivity
IgnoreCase) MVar ()
m) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (n :: Nat). KnownNat n => Vector Text -> Chunks n
makeChunks

simpleFuzzyEnvMI :: KnownNat n => MVar () -> Int -> Proxy n -> Chunks n -> IO (SearchEnv n MatchPart Text)
simpleFuzzyEnvMI :: forall (n :: Nat).
KnownNat n =>
MVar ()
-> Int -> Proxy n -> Chunks n -> IO (SearchEnv n MatchPart Text)
simpleFuzzyEnvMI MVar ()
m Int
n Proxy n
_ = 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 (forall b. CaseSensitivity -> SearchFunctions MatchPart b
fuzzyFunctions CaseSensitivity
IgnoreCase) Int
n (forall (n :: Nat) (m :: Nat) a.
(KnownNat n, KnownNat m) =>
SearchFunctions a Text
-> MVar ()
-> Chunks n
-> SearchReport
-> MatcherSized m a
-> MatchSetSized m
-> IO ()
printMatchesMvar (forall b. CaseSensitivity -> SearchFunctions MatchPart b
fuzzyFunctions CaseSensitivity
IgnoreCase) MVar ()
m)

runSimpleSearcherWithEnv :: KnownNat n => SimpleSearcher -> SearchEnv n MatchPart Text -> IO ()
runSimpleSearcherWithEnv :: forall (n :: Nat).
KnownNat n =>
SimpleSearcher -> SearchEnv n MatchPart Text -> IO ()
runSimpleSearcherWithEnv SimpleSearcher
s SearchEnv n MatchPart Text
env = IO () -> IO ThreadId
forkIO (forall (n :: Nat) a b. KnownNat n => SearchEnv n a b -> IO ()
searchLoop SearchEnv n MatchPart Text
env) 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_ (Maybe Text -> IO ()
doSearch forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> Maybe a
Just) (SimpleSearcher -> [Text]
terms SimpleSearcher
s) forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Maybe Text -> IO ()
doSearch forall a. Maybe a
Nothing
  where
    doSearch :: Maybe Text -> IO ()
doSearch Maybe Text
term = forall a. MVar a -> a -> IO ()
putMVar (SearchEnv n MatchPart Text
env forall s a. s -> Getting a s a -> a
^. forall (n :: Nat) a b. Lens' (SearchEnv n a b) (MVar (Maybe Text))
query) Maybe Text
term forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Int -> IO ()
threadDelay (SimpleSearcher -> Int
sleepTime SimpleSearcher
s)

runSimpleSearcher :: KnownNat n => Proxy n -> SimpleSearcher -> V.Vector Text -> IO ()
runSimpleSearcher :: forall (n :: Nat).
KnownNat n =>
Proxy n -> SimpleSearcher -> Vector Text -> IO ()
runSimpleSearcher Proxy n
p SimpleSearcher
s Vector Text
v = forall (n :: Nat).
KnownNat n =>
SimpleSearcher -> SearchEnv n MatchPart Text -> IO ()
runSimpleSearcherWithEnv SimpleSearcher
s forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall (n :: Nat).
KnownNat n =>
Int -> Proxy n -> Vector Text -> IO (SearchEnv n MatchPart Text)
simpleFuzzyEnv (SimpleSearcher -> Int
matchesToPrint SimpleSearcher
s) Proxy n
p Vector Text
v

runSimpleSearcherWithEnvM :: KnownNat n => SimpleSearcher -> MVar () -> SearchEnv n MatchPart Text -> IO ()
runSimpleSearcherWithEnvM :: forall (n :: Nat).
KnownNat n =>
SimpleSearcher -> MVar () -> SearchEnv n MatchPart Text -> IO ()
runSimpleSearcherWithEnvM SimpleSearcher
s MVar ()
v SearchEnv n MatchPart Text
env = IO () -> IO ThreadId
forkIO (forall (n :: Nat) a b. KnownNat n => SearchEnv n a b -> IO ()
searchLoop SearchEnv n MatchPart Text
env) 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_ Text -> IO ()
doSearch (SimpleSearcher -> [Text]
terms SimpleSearcher
s) forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall a. MVar a -> a -> IO ()
putMVar (SearchEnv n MatchPart Text
env forall s a. s -> Getting a s a -> a
^. forall (n :: Nat) a b. Lens' (SearchEnv n a b) (MVar (Maybe Text))
query) forall a. Maybe a
Nothing
  where
    doSearch :: Text -> IO ()
doSearch Text
term = forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Text
term forall a. Eq a => a -> a -> Bool
== Text
"") forall a b. (a -> b) -> a -> b
$ forall a. MVar a -> a -> IO ()
putMVar (SearchEnv n MatchPart Text
env forall s a. s -> Getting a s a -> a
^. forall (n :: Nat) a b. Lens' (SearchEnv n a b) (MVar (Maybe Text))
query) (forall a. a -> Maybe a
Just Text
term) forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall a. MVar a -> IO a
takeMVar MVar ()
v

runSimpleSearcherM :: KnownNat n => Proxy n -> SimpleSearcher -> V.Vector Text -> IO ()
runSimpleSearcherM :: forall (n :: Nat).
KnownNat n =>
Proxy n -> SimpleSearcher -> Vector Text -> IO ()
runSimpleSearcherM Proxy n
p SimpleSearcher
s Vector Text
v = (\MVar ()
mvar -> forall (n :: Nat).
KnownNat n =>
SimpleSearcher -> MVar () -> SearchEnv n MatchPart Text -> IO ()
runSimpleSearcherWithEnvM SimpleSearcher
s MVar ()
mvar forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall (n :: Nat).
KnownNat n =>
MVar ()
-> Int -> Proxy n -> Vector Text -> IO (SearchEnv n MatchPart Text)
simpleFuzzyEnvM MVar ()
mvar (SimpleSearcher -> Int
matchesToPrint SimpleSearcher
s) Proxy n
p Vector Text
v) forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall a. IO (MVar a)
newEmptyMVar

runSimpleSearcherMI :: KnownNat n => Proxy n -> SimpleSearcher -> Chunks n -> IO ()
runSimpleSearcherMI :: forall (n :: Nat).
KnownNat n =>
Proxy n -> SimpleSearcher -> Chunks n -> IO ()
runSimpleSearcherMI Proxy n
p SimpleSearcher
s Chunks n
v = (\MVar ()
mvar -> forall (n :: Nat).
KnownNat n =>
SimpleSearcher -> MVar () -> SearchEnv n MatchPart Text -> IO ()
runSimpleSearcherWithEnvM SimpleSearcher
s MVar ()
mvar forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall (n :: Nat).
KnownNat n =>
MVar ()
-> Int -> Proxy n -> Chunks n -> IO (SearchEnv n MatchPart Text)
simpleFuzzyEnvMI MVar ()
mvar (SimpleSearcher -> Int
matchesToPrint SimpleSearcher
s) Proxy n
p Chunks n
v) forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall a. IO (MVar a)
newEmptyMVar

testVector :: IO (V.Vector Text)
testVector :: IO (Vector Text)
testVector = forall (v :: * -> *) a. Vector v a => InputStream a -> IO (v a)
I.toVector forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< InputStream ByteString -> IO (InputStream Text)
I.decodeUtf8 forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< InputStream ByteString -> IO (InputStream ByteString)
I.lines InputStream ByteString
I.stdin

simpleSearcherTest :: IO ()
simpleSearcherTest :: IO ()
simpleSearcherTest = forall (n :: Nat).
KnownNat n =>
Proxy n -> SimpleSearcher -> Chunks n -> IO ()
runSimpleSearcherMI (forall {k} (t :: k). Proxy t
Proxy :: Proxy 64)
                                         ([Text] -> Int -> Int -> SimpleSearcher
SimpleSearcher [ Text
"m" , Text
"ma" , Text
"mal" , Text
"malda" , Text
"maldac" , Text
"maldace" , Text
"maldacen" , Text
"maldacena" , Text
"maldacenaf" , Text
"maldacenafi" , Text
"maldacenafiv" , Text
"maldacenafive"
                                                         , Text
"maldacenafiv"
                                                         , Text
"w" , Text
"wi" , Text
"wit" , Text
"witt" , Text
"witte" , Text
"witten" , Text
"f" , Text
"fr" , Text
"fra" , Text
"fran" , Text
"franc" , Text
"franco"
                                                         , Text
"c" , Text
"cl" , Text
"clo" , Text
"clos" , Text
"closs" , Text
"closse" , Text
"closset" , Text
"s" , Text
"se" , Text
"sen"
                                                        ] Int
25000 Int
256)
                                         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 => InputStream Text -> IO (Chunks n)
chunksFromStream forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< InputStream ByteString -> IO (InputStream Text)
I.decodeUtf8 forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< InputStream ByteString -> IO (InputStream ByteString)
I.lines InputStream ByteString
I.stdin
-- simpleSearcherTest = runSimpleSearcher (Proxy :: Proxy 32) (SimpleSearcher ["suse", "linux" , "binary" , "close" , "Witten" , "Maldacena" , "Franco" , "Closset"] 100000 1024) =<< testVector