{-# LANGUAGE RankNTypes #-}
module Matterhorn.State.ListWindow
  ( listWindowActivateCurrent
  , listWindowActivate
  , listWindowSearchString
  , listWindowMove
  , exitListWindow
  , enterListWindowMode
  , resetListWindowSearch
  , onEventListWindow
  )
where

import           Prelude ()
import           Matterhorn.Prelude

import           Brick ( BrickEvent(VtyEvent) )
import qualified Brick.Widgets.List as L
import qualified Brick.Widgets.Edit as E
import qualified Data.Text.Zipper as Z
import qualified Data.Vector as Vec
import           Lens.Micro.Platform ( Lens', (%=), (.=) )
import           Network.Mattermost.Types ( Session, TeamId )
import qualified Graphics.Vty as Vty

import           Matterhorn.Types
import           Brick.Keybindings
import           Matterhorn.State.Common
import           Matterhorn.State.Editing ( editingKeybindings )


-- | Activate the specified list window's selected item by invoking the
-- window's configured enter keypress handler function.
listWindowActivateCurrent :: TeamId -> Lens' ChatState (ListWindowState a b) -> MH ()
listWindowActivateCurrent :: forall a b.
TeamId -> Lens' ChatState (ListWindowState a b) -> MH ()
listWindowActivateCurrent TeamId
tId Lens' ChatState (ListWindowState a b)
which = do
  Maybe (Int, a)
mItem <- forall (t :: * -> *) e n.
(Splittable t, Traversable t, Semigroup (t e)) =>
GenericList n t e -> Maybe (Int, e)
L.listSelectedElement forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use (Lens' ChatState (ListWindowState a b)
whichforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall a b. Lens' (ListWindowState a b) (List Name a)
listWindowSearchResults)
  case Maybe (Int, a)
mItem of
      Maybe (Int, a)
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return ()
      Just (Int
_, a
val) -> forall a b.
TeamId -> Lens' ChatState (ListWindowState a b) -> a -> MH ()
listWindowActivate TeamId
tId Lens' ChatState (ListWindowState a b)
which a
val

-- | Activate the specified list window's selected item by invoking the
-- window's configured enter keypress handler function.
listWindowActivate :: TeamId -> Lens' ChatState (ListWindowState a b) -> a -> MH ()
listWindowActivate :: forall a b.
TeamId -> Lens' ChatState (ListWindowState a b) -> a -> MH ()
listWindowActivate TeamId
tId Lens' ChatState (ListWindowState a b)
which a
val = do
    a -> MH Bool
handler <- forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use (Lens' ChatState (ListWindowState a b)
whichforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall a b. Lens' (ListWindowState a b) (a -> MH Bool)
listWindowEnterHandler)
    Bool
activated <- a -> MH Bool
handler a
val
    if Bool
activated
       then TeamId -> MH ()
popMode TeamId
tId
       else forall (m :: * -> *) a. Monad m => a -> m a
return ()

-- | Get the current search string for the specified window.
listWindowSearchString :: Lens' ChatState (ListWindowState a b) -> MH Text
listWindowSearchString :: forall a b. Lens' ChatState (ListWindowState a b) -> MH Text
listWindowSearchString Lens' ChatState (ListWindowState a b)
which =
    (forall a. [a] -> a
head forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall t n. Monoid t => Editor t n -> [t]
E.getEditContents) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use (Lens' ChatState (ListWindowState a b)
whichforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall a b. Lens' (ListWindowState a b) (Editor Text Name)
listWindowSearchInput)

-- | Move the list cursor in the specified window.
listWindowMove :: Lens' ChatState (ListWindowState a b)
                -- ^ Which window
                -> (L.List Name a -> L.List Name a)
                -- ^ How to transform the list in the window
                -> MH ()
listWindowMove :: forall a b.
Lens' ChatState (ListWindowState a b)
-> (List Name a -> List Name a) -> MH ()
listWindowMove Lens' ChatState (ListWindowState a b)
which List Name a -> List Name a
how = Lens' ChatState (ListWindowState a b)
whichforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall a b. Lens' (ListWindowState a b) (List Name a)
listWindowSearchResults forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= List Name a -> List Name a
how

-- | Clear the state of the specified list window and return to the
-- Main mode.
exitListWindow :: TeamId
                -> Lens' ChatState (ListWindowState a b)
                -- ^ Which window to reset
                -> MH ()
exitListWindow :: forall a b.
TeamId -> Lens' ChatState (ListWindowState a b) -> MH ()
exitListWindow TeamId
tId Lens' ChatState (ListWindowState a b)
which = do
    Vector a -> List Name a
newList <- forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use (Lens' ChatState (ListWindowState a b)
whichforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall a b. Lens' (ListWindowState a b) (Vector a -> List Name a)
listWindowNewList)
    Lens' ChatState (ListWindowState a b)
whichforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall a b. Lens' (ListWindowState a b) (List Name a)
listWindowSearchResults forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= Vector a -> List Name a
newList forall a. Monoid a => a
mempty
    Lens' ChatState (ListWindowState a b)
whichforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall a b. Lens' (ListWindowState a b) (a -> MH Bool)
listWindowEnterHandler forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= (forall a b. a -> b -> a
const forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False)
    TeamId -> MH ()
popMode TeamId
tId

-- | Initialize a list window with the specified arguments and switch
-- to the specified mode.
enterListWindowMode :: TeamId
                     -> (Lens' ChatState (ListWindowState a b))
                     -- ^ Which window to initialize
                     -> Mode
                     -- ^ The mode to change to
                     -> b
                     -- ^ The window's initial search scope
                     -> (a -> MH Bool)
                     -- ^ The window's enter keypress handler
                     -> (b -> Session -> Text -> IO (Vec.Vector a))
                     -- ^ The window's results fetcher function
                     -> MH ()
enterListWindowMode :: forall a b.
TeamId
-> Lens' ChatState (ListWindowState a b)
-> Mode
-> b
-> (a -> MH Bool)
-> (b -> Session -> Text -> IO (Vector a))
-> MH ()
enterListWindowMode TeamId
tId Lens' ChatState (ListWindowState a b)
which Mode
mode b
scope a -> MH Bool
enterHandler b -> Session -> Text -> IO (Vector a)
fetcher = do
    Lens' ChatState (ListWindowState a b)
whichforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall a b. Lens' (ListWindowState a b) b
listWindowSearchScope forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= b
scope
    Lens' ChatState (ListWindowState a b)
whichforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall a b. Lens' (ListWindowState a b) (Editor Text Name)
listWindowSearchInputforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall t1 n t2.
Lens (Editor t1 n) (Editor t2 n) (TextZipper t1) (TextZipper t2)
E.editContentsL forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= forall a. Monoid a => TextZipper a -> TextZipper a
Z.clearZipper
    Lens' ChatState (ListWindowState a b)
whichforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall a b. Lens' (ListWindowState a b) (a -> MH Bool)
listWindowEnterHandler forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= a -> MH Bool
enterHandler
    Lens' ChatState (ListWindowState a b)
whichforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall a b.
Lens' (ListWindowState a b) (b -> Session -> Text -> IO (Vector a))
listWindowFetchResults forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= b -> Session -> Text -> IO (Vector a)
fetcher
    Lens' ChatState (ListWindowState a b)
whichforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall a b. Lens' (ListWindowState a b) Bool
listWindowSearching forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= Bool
False
    Vector a -> List Name a
newList <- forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use (Lens' ChatState (ListWindowState a b)
whichforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall a b. Lens' (ListWindowState a b) (Vector a -> List Name a)
listWindowNewList)
    Lens' ChatState (ListWindowState a b)
whichforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall a b. Lens' (ListWindowState a b) (List Name a)
listWindowSearchResults forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= Vector a -> List Name a
newList forall a. Monoid a => a
mempty
    TeamId -> Mode -> MH ()
pushMode TeamId
tId Mode
mode
    forall a b. Lens' ChatState (ListWindowState a b) -> MH ()
resetListWindowSearch Lens' ChatState (ListWindowState a b)
which

-- | Reset the window's search by initiating a new search request for
-- the string that is currently in the window's editor. This does
-- nothing if a search for this window is already in progress.
resetListWindowSearch :: Lens' ChatState (ListWindowState a b) -> MH ()
resetListWindowSearch :: forall a b. Lens' ChatState (ListWindowState a b) -> MH ()
resetListWindowSearch Lens' ChatState (ListWindowState a b)
which = do
    Bool
searchPending <- forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use (Lens' ChatState (ListWindowState a b)
whichforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall a b. Lens' (ListWindowState a b) Bool
listWindowSearching)

    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool -> Bool
not Bool
searchPending) forall a b. (a -> b) -> a -> b
$ do
        Text
searchString <- forall a b. Lens' ChatState (ListWindowState a b) -> MH Text
listWindowSearchString Lens' ChatState (ListWindowState a b)
which
        Lens' ChatState (ListWindowState a b)
whichforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall a b. Lens' (ListWindowState a b) Bool
listWindowSearching forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= Bool
True
        Vector a -> List Name a
newList <- forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use (Lens' ChatState (ListWindowState a b)
whichforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall a b. Lens' (ListWindowState a b) (Vector a -> List Name a)
listWindowNewList)
        Session
session <- MH Session
getSession
        b
scope <- forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use (Lens' ChatState (ListWindowState a b)
whichforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall a b. Lens' (ListWindowState a b) b
listWindowSearchScope)
        b -> Session -> Text -> IO (Vector a)
fetcher <- forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use (Lens' ChatState (ListWindowState a b)
whichforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall a b.
Lens' (ListWindowState a b) (b -> Session -> Text -> IO (Vector a))
listWindowFetchResults)
        AsyncPriority -> IO (Maybe (MH ())) -> MH ()
doAsyncWith AsyncPriority
Preempt forall a b. (a -> b) -> a -> b
$ do
            Vector a
results <- b -> Session -> Text -> IO (Vector a)
fetcher b
scope Session
session Text
searchString
            forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ do
                Lens' ChatState (ListWindowState a b)
whichforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall a b. Lens' (ListWindowState a b) (List Name a)
listWindowSearchResults forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= Vector a -> List Name a
newList Vector a
results
                Lens' ChatState (ListWindowState a b)
whichforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall a b. Lens' (ListWindowState a b) Bool
listWindowSearching forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= Bool
False

                -- Now that the results are available, check to see if the
                -- search string changed since this request was submitted.
                -- If so, issue another search.
                Text
afterSearchString <- forall a b. Lens' ChatState (ListWindowState a b) -> MH Text
listWindowSearchString Lens' ChatState (ListWindowState a b)
which
                forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Text
searchString forall a. Eq a => a -> a -> Bool
/= Text
afterSearchString) forall a b. (a -> b) -> a -> b
$ forall a b. Lens' ChatState (ListWindowState a b) -> MH ()
resetListWindowSearch Lens' ChatState (ListWindowState a b)
which

-- | Generically handle an event for the list window state targeted
-- by the specified lens. Automatically dispatches new searches in the
-- window's editor if the editor contents change.
onEventListWindow :: Lens' ChatState (ListWindowState a b)
                   -- ^ Which window to dispatch to?
                   -> (KeyConfig KeyEvent -> KeyDispatcher KeyEvent MH)
                   -- ^ The keybinding builder
                   -> Vty.Event
                   -- ^ The event
                   -> MH Bool
onEventListWindow :: forall a b.
Lens' ChatState (ListWindowState a b)
-> (KeyConfig KeyEvent -> KeyDispatcher KeyEvent MH)
-> Event
-> MH Bool
onEventListWindow Lens' ChatState (ListWindowState a b)
which KeyConfig KeyEvent -> KeyDispatcher KeyEvent MH
keybindings =
    [Event -> MH Bool] -> Event -> MH Bool
handleEventWith [ (KeyConfig KeyEvent -> KeyDispatcher KeyEvent MH)
-> Event -> MH Bool
mhHandleKeyboardEvent KeyConfig KeyEvent -> KeyDispatcher KeyEvent MH
keybindings
                    , forall a b.
Lens' ChatState (ListWindowState a b) -> Event -> MH Bool
handleEditorEvent Lens' ChatState (ListWindowState a b)
which
                    ]

handleEditorEvent :: Lens' ChatState (ListWindowState a b) -> Vty.Event -> MH Bool
handleEditorEvent :: forall a b.
Lens' ChatState (ListWindowState a b) -> Event -> MH Bool
handleEditorEvent Lens' ChatState (ListWindowState a b)
which Event
e = do
    -- Get the editor content before the event.
    Text
before <- forall a b. Lens' ChatState (ListWindowState a b) -> MH Text
listWindowSearchString Lens' ChatState (ListWindowState a b)
which

    -- First find a matching keybinding in the keybinding list.
    Bool
handled <- (KeyConfig KeyEvent -> KeyDispatcher KeyEvent MH)
-> Event -> MH Bool
mhHandleKeyboardEvent (Lens' ChatState (Editor Text Name)
-> KeyConfig KeyEvent -> KeyDispatcher KeyEvent MH
editingKeybindings (Lens' ChatState (ListWindowState a b)
whichforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall a b. Lens' (ListWindowState a b) (Editor Text Name)
listWindowSearchInput)) Event
e

    -- If we didn't find a matching binding, just handle the event as a
    -- normal editor input event.
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool -> Bool
not Bool
handled) forall a b. (a -> b) -> a -> b
$
        forall b e.
Lens' ChatState b -> (e -> EventM Name b ()) -> e -> MH ()
mhZoom (Lens' ChatState (ListWindowState a b)
whichforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall a b. Lens' (ListWindowState a b) (Editor Text Name)
listWindowSearchInput) forall n t e.
(Eq n, DecodeUtf8 t, Eq t, GenericTextZipper t) =>
BrickEvent n e -> EventM n (Editor t n) ()
E.handleEditorEvent (forall n e. Event -> BrickEvent n e
VtyEvent Event
e)

    -- Get the editor content after the event. If the string changed,
    -- start a new search.
    Text
after <- forall a b. Lens' ChatState (ListWindowState a b) -> MH Text
listWindowSearchString Lens' ChatState (ListWindowState a b)
which
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Text
before forall a. Eq a => a -> a -> Bool
/= Text
after) forall a b. (a -> b) -> a -> b
$ forall a b. Lens' ChatState (ListWindowState a b) -> MH ()
resetListWindowSearch Lens' ChatState (ListWindowState a b)
which

    forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True