{-# LANGUAGE RankNTypes #-}
module Matterhorn.Events.SaveAttachmentWindow
  ( onEventSaveAttachmentWindow
  )
where

import           Prelude ()
import           Matterhorn.Prelude

import qualified Control.Exception as E

import           Brick ( BrickEvent(VtyEvent) )
import           Brick.Focus
import           Brick.Widgets.Edit ( handleEditorEvent, getEditContents )
import qualified Data.Text as T
import           Lens.Micro.Platform ( (%=), Lens' )
import qualified Graphics.Vty as Vty

import           Matterhorn.Types
import           Matterhorn.State.SaveAttachmentWindow
import           Matterhorn.State.Common ( postInfoMessage, fetchFileAtPath
                                         , doAsyncWith, AsyncPriority(Normal)
                                         , postErrorMessage'
                                         )


onEventSaveAttachmentWindow :: Lens' ChatState (MessageInterface Name i) -> Vty.Event -> MH Bool
onEventSaveAttachmentWindow :: forall i.
Lens' ChatState (MessageInterface Name i) -> Event -> MH Bool
onEventSaveAttachmentWindow Lens' ChatState (MessageInterface Name i)
which (Vty.EvKey (Vty.KChar Char
'\t') []) = do
    Lens' ChatState (MessageInterface Name i)
whichforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall n i.
Lens' (MessageInterface n i) (SaveAttachmentDialogState n)
miSaveAttachmentDialogforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall n. Lens' (SaveAttachmentDialogState n) (FocusRing n)
attachmentPathDialogFocus forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= forall n. FocusRing n -> FocusRing n
focusNext
    forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
onEventSaveAttachmentWindow Lens' ChatState (MessageInterface Name i)
which (Vty.EvKey Key
Vty.KBackTab []) = do
    Lens' ChatState (MessageInterface Name i)
whichforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall n i.
Lens' (MessageInterface n i) (SaveAttachmentDialogState n)
miSaveAttachmentDialogforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall n. Lens' (SaveAttachmentDialogState n) (FocusRing n)
attachmentPathDialogFocus forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= forall n. FocusRing n -> FocusRing n
focusPrev
    forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
onEventSaveAttachmentWindow Lens' ChatState (MessageInterface Name i)
which (Vty.EvKey Key
Vty.KEnter []) = do
    FocusRing Name
f <- forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use (Lens' ChatState (MessageInterface Name i)
whichforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall n i.
Lens' (MessageInterface n i) (SaveAttachmentDialogState n)
miSaveAttachmentDialogforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall n. Lens' (SaveAttachmentDialogState n) (FocusRing n)
attachmentPathDialogFocus)
    Session
session <- MH Session
getSession
    MessageInterfaceMode
mode <- forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use (Lens' ChatState (MessageInterface Name i)
whichforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall n i. Lens' (MessageInterface n i) MessageInterfaceMode
miMode)

    let link :: LinkChoice
link = case MessageInterfaceMode
mode of
            SaveAttachment LinkChoice
l -> LinkChoice
l
            MessageInterfaceMode
_ -> forall a. HasCallStack => [Char] -> a
error forall a b. (a -> b) -> a -> b
$ [Char]
"BUG: invalid mode " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> [Char]
show MessageInterfaceMode
mode forall a. Semigroup a => a -> a -> a
<> [Char]
" in onEventSaveAttachmentWindow"
        fId :: FileId
fId = case LinkChoice
linkforall s a. s -> Getting a s a -> a
^.Lens' LinkChoice LinkTarget
linkTarget of
            LinkFileId FileId
i -> FileId
i
            LinkTarget
_ -> forall a. HasCallStack => [Char] -> a
error forall a b. (a -> b) -> a -> b
$ [Char]
"BUG: invalid link target " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> [Char]
show (LinkChoice
linkforall s a. s -> Getting a s a -> a
^.Lens' LinkChoice LinkTarget
linkTarget) forall a. Semigroup a => a -> a -> a
<> [Char]
" in onEventSaveAttachmentWindow"
        save :: MH ()
save = do
            Editor Text Name
ed <- forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use (Lens' ChatState (MessageInterface Name i)
whichforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall n i.
Lens' (MessageInterface n i) (SaveAttachmentDialogState n)
miSaveAttachmentDialogforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall n. Lens' (SaveAttachmentDialogState n) (Editor Text n)
attachmentPathEditor)
            let path :: [Char]
path = Text -> [Char]
T.unpack forall a b. (a -> b) -> a -> b
$ Text -> Text
T.strip forall a b. (a -> b) -> a -> b
$ [Text] -> Text
T.concat forall a b. (a -> b) -> a -> b
$ forall t n. Monoid t => Editor t n -> [t]
getEditContents Editor Text Name
ed

            forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool -> Bool
not forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Char]
path) forall a b. (a -> b) -> a -> b
$ do
                AsyncPriority -> IO (Maybe (MH ())) -> MH ()
doAsyncWith AsyncPriority
Normal forall a b. (a -> b) -> a -> b
$ do
                    Either SomeException ()
result <- forall e a. Exception e => IO a -> IO (Either e a)
E.try forall a b. (a -> b) -> a -> b
$ FileId -> Session -> [Char] -> IO ()
fetchFileAtPath FileId
fId Session
session [Char]
path
                    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
                        case Either SomeException ()
result of
                            Left (SomeException
e::E.SomeException) ->
                                Text -> MH ()
postErrorMessage' forall a b. (a -> b) -> a -> b
$ [Char] -> Text
T.pack forall a b. (a -> b) -> a -> b
$ [Char]
"Error saving to " forall a. Semigroup a => a -> a -> a
<> [Char]
path forall a. Semigroup a => a -> a -> a
<> [Char]
": " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> [Char]
show SomeException
e
                            Right () ->
                                Text -> MH ()
postInfoMessage forall a b. (a -> b) -> a -> b
$ [Char] -> Text
T.pack forall a b. (a -> b) -> a -> b
$ [Char]
"Attachment saved to " forall a. Semigroup a => a -> a -> a
<> [Char]
path
                forall n i. Lens' ChatState (MessageInterface n i) -> MH ()
closeSaveAttachmentWindow Lens' ChatState (MessageInterface Name i)
which

    case forall n. FocusRing n -> Maybe n
focusGetCurrent FocusRing Name
f of
        Just (AttachmentPathSaveButton {})   -> MH ()
save
        Just (AttachmentPathEditor {})       -> MH ()
save
        Just (AttachmentPathCancelButton {}) -> forall n i. Lens' ChatState (MessageInterface n i) -> MH ()
closeSaveAttachmentWindow Lens' ChatState (MessageInterface Name i)
which
        Maybe Name
_                                    -> forall n i. Lens' ChatState (MessageInterface n i) -> MH ()
closeSaveAttachmentWindow Lens' ChatState (MessageInterface Name i)
which

    forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
onEventSaveAttachmentWindow Lens' ChatState (MessageInterface Name i)
which (Vty.EvKey Key
Vty.KEsc []) = do
    forall n i. Lens' ChatState (MessageInterface n i) -> MH ()
closeSaveAttachmentWindow Lens' ChatState (MessageInterface Name i)
which
    forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
onEventSaveAttachmentWindow Lens' ChatState (MessageInterface Name i)
which Event
e = do
    FocusRing Name
f <- forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use (Lens' ChatState (MessageInterface Name i)
whichforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall n i.
Lens' (MessageInterface n i) (SaveAttachmentDialogState n)
miSaveAttachmentDialogforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall n. Lens' (SaveAttachmentDialogState n) (FocusRing n)
attachmentPathDialogFocus)
    case forall n. FocusRing n -> Maybe n
focusGetCurrent FocusRing Name
f of
        Just (AttachmentPathEditor {}) -> do
            forall b e.
Lens' ChatState b -> (e -> EventM Name b ()) -> e -> MH ()
mhZoom (Lens' ChatState (MessageInterface Name i)
whichforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall n i.
Lens' (MessageInterface n i) (SaveAttachmentDialogState n)
miSaveAttachmentDialogforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall n. Lens' (SaveAttachmentDialogState n) (Editor Text n)
attachmentPathEditor)
                                forall n t e.
(Eq n, DecodeUtf8 t, Eq t, GenericTextZipper t) =>
BrickEvent n e -> EventM n (Editor t n) ()
handleEditorEvent (forall n e. Event -> BrickEvent n e
VtyEvent Event
e)
            forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
        Maybe Name
_ ->
            forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False