{-# LANGUAGE RankNTypes #-}
module Matterhorn.State.SaveAttachmentWindow
  ( openSaveAttachmentWindow
  , closeSaveAttachmentWindow
  )
where

import           Prelude ()
import           Matterhorn.Prelude
import           Brick ( getName )
import           Brick.Widgets.List ( listSelectedElement )

import           Lens.Micro.Platform ( Lens', (.=), to )

import           Network.Mattermost.Types ( fileInfoName )
import           Network.Mattermost.Endpoints ( mmGetMetadataForFile )

import           Matterhorn.Types
import           Matterhorn.State.Common
import           Matterhorn.State.Teams ( newSaveAttachmentDialog )


-- | If the currently selected link in the URL list is for an
-- attachment, open a window to get the user to provide a path to which
-- to save the attachment. If the URL list is empty or if the selected
-- entry is not for an attachment, this returns to the Main mode but
-- otherwise does nothing.
openSaveAttachmentWindow :: Lens' ChatState (MessageInterface Name i) -> MH ()
openSaveAttachmentWindow :: forall i. Lens' ChatState (MessageInterface Name i) -> MH ()
openSaveAttachmentWindow Lens' ChatState (MessageInterface Name i)
which = do
    Maybe (Int, (Int, LinkChoice))
selected <- 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) (URLList n)
miUrlListforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall n1 n2.
Lens
  (URLList n1)
  (URLList n2)
  (List n1 (Int, LinkChoice))
  (List n2 (Int, LinkChoice))
ulListforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall s a. (s -> a) -> SimpleGetter s a
to forall (t :: * -> *) e n.
(Splittable t, Traversable t, Semigroup (t e)) =>
GenericList n t e -> Maybe (Int, e)
listSelectedElement)
    case Maybe (Int, (Int, LinkChoice))
selected of
        Maybe (Int, (Int, LinkChoice))
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return ()
        Just (Int
_, (Int
_, LinkChoice
link)) ->
            case LinkChoice
linkforall s a. s -> Getting a s a -> a
^.Lens' LinkChoice LinkTarget
linkTarget of
                LinkFileId FileId
fId -> do
                    Session
session <- MH Session
getSession
                    AsyncPriority -> IO (Maybe (MH ())) -> MH ()
doAsyncWith AsyncPriority
Normal forall a b. (a -> b) -> a -> b
$ do
                        FileInfo
info <- FileId -> Session -> IO FileInfo
mmGetMetadataForFile FileId
fId Session
session
                        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
                            -- Use the message interface's URL list name
                            -- as a unique basis for the names of the UI
                            -- elements in the attachment dialog
                            Name
listName <- forall a n. Named a n => a -> n
getName 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 (MessageInterface Name i)
whichforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall n i. Lens' (MessageInterface n i) (URLList n)
miUrlListforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall n1 n2.
Lens
  (URLList n1)
  (URLList n2)
  (List n1 (Int, LinkChoice))
  (List n2 (Int, LinkChoice))
ulList)
                            Lens' ChatState (MessageInterface Name i)
whichforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall n i.
Lens' (MessageInterface n i) (SaveAttachmentDialogState n)
miSaveAttachmentDialog forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= Name -> Text -> SaveAttachmentDialogState Name
newSaveAttachmentDialog Name
listName (FileInfo -> Text
fileInfoName FileInfo
info)
                            Lens' ChatState (MessageInterface Name i)
whichforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall n i. Lens' (MessageInterface n i) MessageInterfaceMode
miMode forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= LinkChoice -> MessageInterfaceMode
SaveAttachment LinkChoice
link
                LinkTarget
_ ->
                    -- The selected link is not for an attachment.
                    forall (m :: * -> *) a. Monad m => a -> m a
return ()

closeSaveAttachmentWindow :: Lens' ChatState (MessageInterface n i)
                          -> MH ()
closeSaveAttachmentWindow :: forall n i. Lens' ChatState (MessageInterface n i) -> MH ()
closeSaveAttachmentWindow Lens' ChatState (MessageInterface n i)
which =
    Lens' ChatState (MessageInterface n i)
whichforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall n i. Lens' (MessageInterface n i) MessageInterfaceMode
miMode forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= MessageInterfaceMode
Compose