Event.hs

module SampleBrowser.Event where

import Brick (BrickEvent (..), EventM, vScrollBy, viewportScroll)
import Brick.Types (gets)
import Control.Monad (when)
import Control.Monad.IO.Class (liftIO)
import qualified Data.Text as T
import qualified Data.Vector as V
import qualified Graphics.Vty as V
import UI.Core (AppState (..), Name (..), SampleBrowser (..))
import Zwirn.Language.Compiler (Environment, compilerInterpreterWithBlock, runCI)

handleSampleBrowserEvent :: SampleBrowser -> BrickEvent Name e -> EventM Name AppState SampleBrowser
handleSampleBrowserEvent s (VtyEvent (V.EvKey (V.KChar '\t') _)) = return s
handleSampleBrowserEvent (SampleB search vs) (VtyEvent (V.EvKey (V.KChar x) _)) = return (SampleB (T.snoc search x) vs)
handleSampleBrowserEvent (SampleB search vs) (VtyEvent (V.EvKey V.KBS _)) = case T.unsnoc search of
  Just (rest, _) -> return (SampleB rest vs)
  Nothing -> return (SampleB T.empty vs)
handleSampleBrowserEvent s (MouseDown name V.BScrollUp _ _) = when (isSamp name) (vScrollBy (viewportScroll SampleBrowserViewport) (-1)) >> return s
handleSampleBrowserEvent s (MouseDown name V.BScrollDown _ _) = when (isSamp name) (vScrollBy (viewportScroll SampleBrowserViewport) 1) >> return s
handleSampleBrowserEvent s _ = return s

isSamp :: Name -> Bool
isSamp SampleBrowser = True
isSamp SampleBrowserViewport = True
isSamp _ = False

sampleBrowserClickAction :: SampleBrowser -> (Int, Int) -> EventM Name AppState SampleBrowser
sampleBrowserClickAction (SampleB search vs) (mx, my) = do
  let fs = V.filter (\(t, _) -> T.isPrefixOf (T.toLower search) (T.toLower t)) vs
  case fs V.!? (my - 3) of
    Just (samp, _) -> do
      env <- gets asEnvironment
      liftIO $ evalSampOnce samp (mx - 1) env
      return (SampleB search vs)
    Nothing -> return (SampleB search vs)

evalSampOnce :: T.Text -> Int -> Environment -> IO ()
evalSampOnce samp num env = do
  _ <- runCI env (compilerInterpreterWithBlock 0 ("once $ s " <> T.show samp <> "# n " <> T.show num))
  return ()