<commit_before>{-# OPTIONS_GHC -fno-warn-unused-do-bind #-}
module Input (
  wgetch
, ungetstr
, readline
, readline_
) where

import           Prelude hiding (getChar)

import           System.IO.Unsafe (unsafePerformIO)
import           Data.IORef
import           Control.Monad.Trans (MonadIO, liftIO)

import           UI.Curses hiding (wgetch, ungetch, wchgat)
import qualified UI.Curses as Curses
import           WindowLayout

-- Ncurses uses a bounded FIFO for ungetch, so we can not use it to put
-- arbitrary-length strings back into the queue.  For now we use the
-- unsafePerformIO hack to work around this.
inputQueue :: IORef String
{-# NOINLINE inputQueue #-}
inputQueue = unsafePerformIO (newIORef "")

-- | Push given string into input queue.
ungetstr :: (MonadIO m) => String -> m ()
ungetstr s = liftIO $ do
  old <- readIORef inputQueue
  writeIORef inputQueue $ s ++ old


wgetch :: (MonadIO m) => Window -> m Char
wgetch win = liftIO $ do
  queue <- readIORef inputQueue
  getChar_ queue
  where
    getChar_ []     = Curses.wget_wch win
    getChar_ (x:xs) = do
      writeIORef inputQueue xs
      return x

------------------------------------------------------------------------

-- | just a zipper
data InputState = InputState !String !String

toString :: InputState -> String
toString (InputState prev next) = reverse prev ++ next

updateWindow :: Window -> String -> InputState -> IO ()
updateWindow window prompt (InputState prev next) = do
  mvwaddstr window 0 0 prompt
  waddstr window (reverse prev)
  wchgat window 1 [Reverse] InputColor
  waddstr window next
  return ()

data EditState = Accept String | Continue InputState | Cancel

edit :: InputState -> Char -> EditState
edit s@(InputState prev next) c
  | accept c          = Accept (toString s)
  | cancel c          = Cancel
  | c == keyBackspace = backspace
  | otherwise         = Continue (InputState (c:prev) next)
  where
    accept = (`elem` ['\n', keyEnter])
    cancel = (`elem` ['\ETX', '\ESC'])

    backspace = case s of
      InputState "" ""     -> Cancel
      InputState "" _      -> Continue s
      InputState (_:xs) ys -> Continue (InputState xs ys)

-- | Read a line of user input.
readline_ :: (MonadIO m) => Window -> Char -> m Char -> m (Maybe String)<commit_msg>Add support for keyLeft and keyRight to line editor<commit_after>{-# OPTIONS_GHC -fno-warn-unused-do-bind #-}
module Input (
  wgetch
, ungetstr
, readline
, readline_
) where

import           Prelude hiding (getChar)

import           System.IO.Unsafe (unsafePerformIO)
import           Data.IORef
import           Control.Monad.Trans (MonadIO, liftIO)

import           UI.Curses hiding (wgetch, ungetch, wchgat, mvwchgat)
import qualified UI.Curses as Curses
import           WindowLayout

-- Ncurses uses a bounded FIFO for ungetch, so we can not use it to put
-- arbitrary-length strings back into the queue.  For now we use the
-- unsafePerformIO hack to work around this.
inputQueue :: IORef String
{-# NOINLINE inputQueue #-}
inputQueue = unsafePerformIO (newIORef "")

-- | Push given string into input queue.
ungetstr :: (MonadIO m) => String -> m ()
ungetstr s = liftIO $ do
  old <- readIORef inputQueue
  writeIORef inputQueue $ s ++ old


wgetch :: (MonadIO m) => Window -> m Char
wgetch win = liftIO $ do
  queue <- readIORef inputQueue
  getChar_ queue
  where
    getChar_ []     = Curses.wget_wch win
    getChar_ (x:xs) = do
      writeIORef inputQueue xs
      return x

------------------------------------------------------------------------

-- | just a zipper
data InputState = InputState !String !String

goLeft :: InputState -> InputState
goLeft (InputState (x:xs) ys) = InputState xs (x:ys)
goLeft s = s

goRight :: InputState -> InputState
goRight (InputState xs (y:ys)) = InputState (y:xs) ys
goRight s = s

toString :: InputState -> String
toString (InputState prev next) = reverse prev ++ next

updateWindow :: Window -> String -> InputState -> IO ()
updateWindow window prompt (InputState prev next) = do
  mvwaddstr window 0 0 prompt
  waddstr window (reverse prev)
  waddstr window next
  mvwchgat window 0 (length prompt + length prev) 1 [Reverse] InputColor
  return ()

data EditState = Accept String | Continue InputState | Cancel

edit :: InputState -> Char -> EditState
edit s@(InputState prev next) c
  | accept c          = Accept (toString s)
  | cancel c          = Cancel
  | c == keyLeft      = Continue (goLeft s)
  | c == keyRight     = Continue (goRight s)
  | c == keyBackspace = backspace
  | otherwise         = Continue (InputState (c:prev) next)
  where
    accept = (`elem` ['\n', keyEnter])
    cancel = (`elem` ['\ETX', '\ESC'])

    backspace = case s of
      InputState "" ""     -> Cancel
      InputState "" _      -> Continue s
      InputState (_:xs) ys -> Continue (InputState xs ys)

-- | Read a line of user input.
readline_ :: (MonadIO m) => Window -> Char -> m Char -> m (Maybe String)
{'fraction_non_alphanumeric': 0.12935928629359286, 'fraction_numerical': 0.001419302514193025, 'mean_word_length': 2.5772298767222623, 'pattern_counts': {'":': 0, '<': 7, '<?xml version=': 0, '>': 39, 'https://': 0, 'lorem ipsum': 0, 'www.': 0, 'xml': 0}, 'pii_count': 0, 'substrings_counts': 0, 'word_list_counts': {'cursed_substrings.json': 0, 'profanity_word_list.json': 0, 'sexual_word_list.json': 0, 'zh_pornsignals.json': 0}}
{'dir': 'git-commits-cleaned', 'id': '6045216', 'n_tokens_mistral': 1575, 'n_tokens_neox': 1518, 'n_words': 541}