module Escoger.Interactive (interactiveLoop) where
import Control.Monad.Reader
import Control.Monad.State.Strict
import Data.ByteString (ByteString)
import qualified Data.ByteString as B
import qualified Data.ByteString.Char8 as BC
import Data.Maybe (fromMaybe)
import qualified Data.Vector as V
import Escoger.Internal
import Escoger.Matches (sortByScore)
import Escoger.Utils
import Graphics.Vty
import System.Exit (exitSuccess)
interactiveLoop :: SearchM ByteString
interactiveLoop = do
render
loop
where
loop :: SearchM ByteString
loop = do
vty <- asks _vty
st <- get
e <- liftIO $ nextEvent vty
let result = handleKeyPress e st
case result of
Right selectionIndex -> do
liftIO $ shutdown vty
if selectionIndex > 0
then do
matches <- gets _matches
return $ fromMaybe "" $ matches V.!? (selectionIndex 1)
else liftIO exitSuccess
Left ss -> do
updateMatches ss
render
loop
render :: SearchM ()
render = do
vty <- asks _vty
term <- gets _term
index <- gets _index
matches <- gets _matches
let termLine = utf8Bytestring' defAttr $ mconcat ["> ", term]
imatches = (V.map (formatMatch index) . V.zip [1..maxRows] . V.take maxRows) matches
img = V.foldl' vertJoin termLine imatches
pic = picForImage img
liftIO $ update vty pic
where
formatMatch :: Index -> (Index,ByteString) -> Image
formatMatch i (x,y) = if i == x
then utf8Bytestring' (defAttr `withBackColor` white `withForeColor` black) y
else utf8Bytestring' defAttr y
handleKeyPress :: Event -> SearchState -> Either SearchState Index
handleKeyPress e ss@(SearchState m t i) = do
case e of
(EvKey KBS []) -> Left $ ss { _term = safeInit t }
(EvKey KDel []) -> Left $ ss { _term = safeInit t }
(EvKey KUp []) -> Left $ ss { _index = safePred i }
(EvKey KDown []) -> Left $ ss { _index = safeSucc' i }
(EvKey KEnter []) -> Right i
(EvKey (KChar 'p') [MCtrl]) -> Left $ ss { _index = safePred i }
(EvKey (KChar 'n') [MCtrl]) -> Left $ ss { _index = safeSucc' i }
(EvKey (KChar 'u') [MCtrl]) -> Left $ ss { _term = "" }
(EvKey (KChar 'w') [MCtrl]) -> Left $ ss { _term = (BC.unwords . init . BC.words) t }
(EvKey (KChar 'c') [MCtrl]) -> Right (1)
(EvKey (KChar c) []) -> Left $ ss { _index = 1, _term = BC.snoc t c }
(EvKey KEsc []) -> Right (1)
_ -> Left ss
where
safeSucc' = safeSucc (V.length m)
updateMatches :: SearchState -> SearchM ()
updateMatches (SearchState _ t i) = do
st <- get
term <- gets _term
if B.length t /= B.length term
then do
terms <- if BC.length term < BC.length t then gets _matches else asks _content
put $ st { _index = i, _term = t, _matches = sortByScore t terms }
else put $ st { _index = i }