{-# LANGUAGE RankNTypes #-}
module Matterhorn.Events.UrlSelect where

import           Prelude ()
import           Matterhorn.Prelude

import           Brick.Keybindings
import           Brick.Widgets.List
import qualified Graphics.Vty as Vty
import           Lens.Micro.Platform ( Lens' )

import           Matterhorn.State.UrlSelect
import           Matterhorn.State.SaveAttachmentWindow
import           Matterhorn.Types


onEventUrlSelect :: Lens' ChatState (MessageInterface Name i) -> Vty.Event -> MH Bool
onEventUrlSelect :: forall i.
Lens' ChatState (MessageInterface Name i) -> Event -> MH Bool
onEventUrlSelect Lens' ChatState (MessageInterface Name i)
which =
    [Event -> MH Bool] -> Event -> MH Bool
handleEventWith [ (KeyConfig KeyEvent -> KeyDispatcher KeyEvent MH)
-> Event -> MH Bool
mhHandleKeyboardEvent (Lens' ChatState (MessageInterface Name i)
-> KeyConfig KeyEvent -> KeyDispatcher KeyEvent MH
forall i.
Lens' ChatState (MessageInterface Name i)
-> KeyConfig KeyEvent -> KeyDispatcher KeyEvent MH
urlSelectKeybindings (MessageInterface Name i -> f (MessageInterface Name i))
-> ChatState -> f ChatState
Lens' ChatState (MessageInterface Name i)
which)
                    , \Event
e -> Lens' ChatState (GenericList Name Vector (Int, LinkChoice))
-> (Event
    -> EventM Name (GenericList Name Vector (Int, LinkChoice)) ())
-> Event
-> MH ()
forall b e.
Lens' ChatState b -> (e -> EventM Name b ()) -> e -> MH ()
mhZoom ((MessageInterface Name i -> f (MessageInterface Name i))
-> ChatState -> f ChatState
Lens' ChatState (MessageInterface Name i)
which((MessageInterface Name i -> f (MessageInterface Name i))
 -> ChatState -> f ChatState)
-> ((GenericList Name Vector (Int, LinkChoice)
     -> f (GenericList Name Vector (Int, LinkChoice)))
    -> MessageInterface Name i -> f (MessageInterface Name i))
-> (GenericList Name Vector (Int, LinkChoice)
    -> f (GenericList Name Vector (Int, LinkChoice)))
-> ChatState
-> f ChatState
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(URLList Name -> f (URLList Name))
-> MessageInterface Name i -> f (MessageInterface Name i)
forall n i (f :: * -> *).
Functor f =>
(URLList n -> f (URLList n))
-> MessageInterface n i -> f (MessageInterface n i)
miUrlList((URLList Name -> f (URLList Name))
 -> MessageInterface Name i -> f (MessageInterface Name i))
-> ((GenericList Name Vector (Int, LinkChoice)
     -> f (GenericList Name Vector (Int, LinkChoice)))
    -> URLList Name -> f (URLList Name))
-> (GenericList Name Vector (Int, LinkChoice)
    -> f (GenericList Name Vector (Int, LinkChoice)))
-> MessageInterface Name i
-> f (MessageInterface Name i)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(GenericList Name Vector (Int, LinkChoice)
 -> f (GenericList Name Vector (Int, LinkChoice)))
-> URLList Name -> f (URLList Name)
forall n1 n2 (f :: * -> *).
Functor f =>
(List n1 (Int, LinkChoice) -> f (List n2 (Int, LinkChoice)))
-> URLList n1 -> f (URLList n2)
ulList) Event -> EventM Name (GenericList Name Vector (Int, LinkChoice)) ()
forall (t :: * -> *) n e.
(Foldable t, Splittable t, Ord n) =>
Event -> EventM n (GenericList n t e) ()
handleListEvent Event
e MH () -> MH Bool -> MH Bool
forall a b. MH a -> MH b -> MH b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Bool -> MH Bool
forall a. a -> MH a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
                    ]

urlSelectKeybindings :: Lens' ChatState (MessageInterface Name i) -> KeyConfig KeyEvent -> KeyDispatcher KeyEvent MH
urlSelectKeybindings :: forall i.
Lens' ChatState (MessageInterface Name i)
-> KeyConfig KeyEvent -> KeyDispatcher KeyEvent MH
urlSelectKeybindings Lens' ChatState (MessageInterface Name i)
which KeyConfig KeyEvent
kc = KeyConfig KeyEvent
-> [KeyEventHandler KeyEvent MH] -> KeyDispatcher KeyEvent MH
forall k (m :: * -> *).
Ord k =>
KeyConfig k -> [KeyEventHandler k m] -> KeyDispatcher k m
unsafeKeyDispatcher KeyConfig KeyEvent
kc (Lens' ChatState (MessageInterface Name i)
-> [KeyEventHandler KeyEvent MH]
forall i.
Lens' ChatState (MessageInterface Name i)
-> [KeyEventHandler KeyEvent MH]
urlSelectKeyHandlers (MessageInterface Name i -> f (MessageInterface Name i))
-> ChatState -> f ChatState
Lens' ChatState (MessageInterface Name i)
which)

urlSelectKeyHandlers :: Lens' ChatState (MessageInterface Name i) -> [MHKeyEventHandler]
urlSelectKeyHandlers :: forall i.
Lens' ChatState (MessageInterface Name i)
-> [KeyEventHandler KeyEvent MH]
urlSelectKeyHandlers Lens' ChatState (MessageInterface Name i)
which =
    [ Binding -> Text -> MH () -> KeyEventHandler KeyEvent MH
forall a (m :: * -> *) k.
ToBinding a =>
a -> Text -> m () -> KeyEventHandler k m
onKey (Key -> Binding
forall a. ToBinding a => a -> Binding
bind Key
Vty.KEnter)
          Text
"Open the selected URL, if any" (MH () -> KeyEventHandler KeyEvent MH)
-> MH () -> KeyEventHandler KeyEvent MH
forall a b. (a -> b) -> a -> b
$
          Lens' ChatState (MessageInterface Name i) -> MH ()
forall n i. Lens' ChatState (MessageInterface n i) -> MH ()
openSelectedURL (MessageInterface Name i -> f (MessageInterface Name i))
-> ChatState -> f ChatState
Lens' ChatState (MessageInterface Name i)
which

    , KeyEvent -> Text -> MH () -> KeyEventHandler KeyEvent MH
forall k (m :: * -> *). k -> Text -> m () -> KeyEventHandler k m
onEvent KeyEvent
SaveAttachmentEvent Text
"Save the selected attachment" (MH () -> KeyEventHandler KeyEvent MH)
-> MH () -> KeyEventHandler KeyEvent MH
forall a b. (a -> b) -> a -> b
$
        Lens' ChatState (MessageInterface Name i) -> MH ()
forall i. Lens' ChatState (MessageInterface Name i) -> MH ()
openSaveAttachmentWindow (MessageInterface Name i -> f (MessageInterface Name i))
-> ChatState -> f ChatState
Lens' ChatState (MessageInterface Name i)
which

    , KeyEvent -> Text -> MH () -> KeyEventHandler KeyEvent MH
forall k (m :: * -> *). k -> Text -> m () -> KeyEventHandler k m
onEvent KeyEvent
CancelEvent Text
"Cancel URL selection" (MH () -> KeyEventHandler KeyEvent MH)
-> MH () -> KeyEventHandler KeyEvent MH
forall a b. (a -> b) -> a -> b
$ Lens' ChatState (MessageInterface Name i) -> MH ()
forall n i. Lens' ChatState (MessageInterface n i) -> MH ()
stopUrlSelect (MessageInterface Name i -> f (MessageInterface Name i))
-> ChatState -> f ChatState
Lens' ChatState (MessageInterface Name i)
which

    , KeyEvent -> Text -> MH () -> KeyEventHandler KeyEvent MH
forall k (m :: * -> *). k -> Text -> m () -> KeyEventHandler k m
onEvent KeyEvent
SelectUpEvent Text
"Move cursor up" (MH () -> KeyEventHandler KeyEvent MH)
-> MH () -> KeyEventHandler KeyEvent MH
forall a b. (a -> b) -> a -> b
$
        Lens' ChatState (GenericList Name Vector (Int, LinkChoice))
-> (Event
    -> EventM Name (GenericList Name Vector (Int, LinkChoice)) ())
-> Event
-> MH ()
forall b e.
Lens' ChatState b -> (e -> EventM Name b ()) -> e -> MH ()
mhZoom ((MessageInterface Name i -> f (MessageInterface Name i))
-> ChatState -> f ChatState
Lens' ChatState (MessageInterface Name i)
which((MessageInterface Name i -> f (MessageInterface Name i))
 -> ChatState -> f ChatState)
-> ((GenericList Name Vector (Int, LinkChoice)
     -> f (GenericList Name Vector (Int, LinkChoice)))
    -> MessageInterface Name i -> f (MessageInterface Name i))
-> (GenericList Name Vector (Int, LinkChoice)
    -> f (GenericList Name Vector (Int, LinkChoice)))
-> ChatState
-> f ChatState
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(URLList Name -> f (URLList Name))
-> MessageInterface Name i -> f (MessageInterface Name i)
forall n i (f :: * -> *).
Functor f =>
(URLList n -> f (URLList n))
-> MessageInterface n i -> f (MessageInterface n i)
miUrlList((URLList Name -> f (URLList Name))
 -> MessageInterface Name i -> f (MessageInterface Name i))
-> ((GenericList Name Vector (Int, LinkChoice)
     -> f (GenericList Name Vector (Int, LinkChoice)))
    -> URLList Name -> f (URLList Name))
-> (GenericList Name Vector (Int, LinkChoice)
    -> f (GenericList Name Vector (Int, LinkChoice)))
-> MessageInterface Name i
-> f (MessageInterface Name i)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(GenericList Name Vector (Int, LinkChoice)
 -> f (GenericList Name Vector (Int, LinkChoice)))
-> URLList Name -> f (URLList Name)
forall n1 n2 (f :: * -> *).
Functor f =>
(List n1 (Int, LinkChoice) -> f (List n2 (Int, LinkChoice)))
-> URLList n1 -> f (URLList n2)
ulList) Event -> EventM Name (GenericList Name Vector (Int, LinkChoice)) ()
forall (t :: * -> *) n e.
(Foldable t, Splittable t, Ord n) =>
Event -> EventM n (GenericList n t e) ()
handleListEvent (Key -> [Modifier] -> Event
Vty.EvKey Key
Vty.KUp [])

    , KeyEvent -> Text -> MH () -> KeyEventHandler KeyEvent MH
forall k (m :: * -> *). k -> Text -> m () -> KeyEventHandler k m
onEvent KeyEvent
SelectDownEvent Text
"Move cursor down" (MH () -> KeyEventHandler KeyEvent MH)
-> MH () -> KeyEventHandler KeyEvent MH
forall a b. (a -> b) -> a -> b
$
        Lens' ChatState (GenericList Name Vector (Int, LinkChoice))
-> (Event
    -> EventM Name (GenericList Name Vector (Int, LinkChoice)) ())
-> Event
-> MH ()
forall b e.
Lens' ChatState b -> (e -> EventM Name b ()) -> e -> MH ()
mhZoom ((MessageInterface Name i -> f (MessageInterface Name i))
-> ChatState -> f ChatState
Lens' ChatState (MessageInterface Name i)
which((MessageInterface Name i -> f (MessageInterface Name i))
 -> ChatState -> f ChatState)
-> ((GenericList Name Vector (Int, LinkChoice)
     -> f (GenericList Name Vector (Int, LinkChoice)))
    -> MessageInterface Name i -> f (MessageInterface Name i))
-> (GenericList Name Vector (Int, LinkChoice)
    -> f (GenericList Name Vector (Int, LinkChoice)))
-> ChatState
-> f ChatState
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(URLList Name -> f (URLList Name))
-> MessageInterface Name i -> f (MessageInterface Name i)
forall n i (f :: * -> *).
Functor f =>
(URLList n -> f (URLList n))
-> MessageInterface n i -> f (MessageInterface n i)
miUrlList((URLList Name -> f (URLList Name))
 -> MessageInterface Name i -> f (MessageInterface Name i))
-> ((GenericList Name Vector (Int, LinkChoice)
     -> f (GenericList Name Vector (Int, LinkChoice)))
    -> URLList Name -> f (URLList Name))
-> (GenericList Name Vector (Int, LinkChoice)
    -> f (GenericList Name Vector (Int, LinkChoice)))
-> MessageInterface Name i
-> f (MessageInterface Name i)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(GenericList Name Vector (Int, LinkChoice)
 -> f (GenericList Name Vector (Int, LinkChoice)))
-> URLList Name -> f (URLList Name)
forall n1 n2 (f :: * -> *).
Functor f =>
(List n1 (Int, LinkChoice) -> f (List n2 (Int, LinkChoice)))
-> URLList n1 -> f (URLList n2)
ulList) Event -> EventM Name (GenericList Name Vector (Int, LinkChoice)) ()
forall (t :: * -> *) n e.
(Foldable t, Splittable t, Ord n) =>
Event -> EventM n (GenericList n t e) ()
handleListEvent (Key -> [Modifier] -> Event
Vty.EvKey Key
Vty.KDown [])

    , Binding -> Text -> MH () -> KeyEventHandler KeyEvent MH
forall a (m :: * -> *) k.
ToBinding a =>
a -> Text -> m () -> KeyEventHandler k m
onKey (Char -> Binding
forall a. ToBinding a => a -> Binding
bind Char
'q')
         Text
"Cancel URL selection" (MH () -> KeyEventHandler KeyEvent MH)
-> MH () -> KeyEventHandler KeyEvent MH
forall a b. (a -> b) -> a -> b
$
         Lens' ChatState (MessageInterface Name i) -> MH ()
forall n i. Lens' ChatState (MessageInterface n i) -> MH ()
stopUrlSelect (MessageInterface Name i -> f (MessageInterface Name i))
-> ChatState -> f ChatState
Lens' ChatState (MessageInterface Name i)
which
    ]