module Matterhorn.State.SaveAttachmentWindow
  ( openSaveAttachmentWindow
  )
where

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

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

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

import           Matterhorn.Types
import           Matterhorn.State.Common


-- | 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 :: MH ()
openSaveAttachmentWindow :: MH ()
openSaveAttachmentWindow = do
    Maybe (Int, (Int, LinkChoice))
selected <- Getting
  (Maybe (Int, (Int, LinkChoice)))
  ChatState
  (Maybe (Int, (Int, LinkChoice)))
-> MH (Maybe (Int, (Int, LinkChoice)))
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use ((TeamState -> Const (Maybe (Int, (Int, LinkChoice))) TeamState)
-> ChatState -> Const (Maybe (Int, (Int, LinkChoice))) ChatState
Lens' ChatState TeamState
csCurrentTeam((TeamState -> Const (Maybe (Int, (Int, LinkChoice))) TeamState)
 -> ChatState -> Const (Maybe (Int, (Int, LinkChoice))) ChatState)
-> ((Maybe (Int, (Int, LinkChoice))
     -> Const
          (Maybe (Int, (Int, LinkChoice))) (Maybe (Int, (Int, LinkChoice))))
    -> TeamState -> Const (Maybe (Int, (Int, LinkChoice))) TeamState)
-> Getting
     (Maybe (Int, (Int, LinkChoice)))
     ChatState
     (Maybe (Int, (Int, LinkChoice)))
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(List Name (Int, LinkChoice)
 -> Const
      (Maybe (Int, (Int, LinkChoice))) (List Name (Int, LinkChoice)))
-> TeamState -> Const (Maybe (Int, (Int, LinkChoice))) TeamState
Lens' TeamState (List Name (Int, LinkChoice))
tsUrlList((List Name (Int, LinkChoice)
  -> Const
       (Maybe (Int, (Int, LinkChoice))) (List Name (Int, LinkChoice)))
 -> TeamState -> Const (Maybe (Int, (Int, LinkChoice))) TeamState)
-> ((Maybe (Int, (Int, LinkChoice))
     -> Const
          (Maybe (Int, (Int, LinkChoice))) (Maybe (Int, (Int, LinkChoice))))
    -> List Name (Int, LinkChoice)
    -> Const
         (Maybe (Int, (Int, LinkChoice))) (List Name (Int, LinkChoice)))
-> (Maybe (Int, (Int, LinkChoice))
    -> Const
         (Maybe (Int, (Int, LinkChoice))) (Maybe (Int, (Int, LinkChoice))))
-> TeamState
-> Const (Maybe (Int, (Int, LinkChoice))) TeamState
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(List Name (Int, LinkChoice) -> Maybe (Int, (Int, LinkChoice)))
-> SimpleGetter
     (List Name (Int, LinkChoice)) (Maybe (Int, (Int, LinkChoice)))
forall s a. (s -> a) -> SimpleGetter s a
to List Name (Int, LinkChoice) -> Maybe (Int, (Int, LinkChoice))
forall (t :: * -> *) n e.
(Splittable t, Foldable t) =>
GenericList n t e -> Maybe (Int, e)
listSelectedElement)
    case Maybe (Int, (Int, LinkChoice))
selected of
        Maybe (Int, (Int, LinkChoice))
Nothing -> () -> MH ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
        Just (Int
_, (Int
_, LinkChoice
link)) ->
            case LinkChoice
linkLinkChoice
-> Getting LinkTarget LinkChoice LinkTarget -> LinkTarget
forall s a. s -> Getting a s a -> a
^.Getting LinkTarget LinkChoice LinkTarget
Lens' LinkChoice LinkTarget
linkTarget of
                LinkFileId FileId
fId -> do
                    TeamId
tId <- Getting TeamId ChatState TeamId -> MH TeamId
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use Getting TeamId ChatState TeamId
SimpleGetter ChatState TeamId
csCurrentTeamId
                    Session
session <- MH Session
getSession
                    AsyncPriority -> IO (Maybe (MH ())) -> MH ()
doAsyncWith AsyncPriority
Normal (IO (Maybe (MH ())) -> MH ()) -> IO (Maybe (MH ())) -> MH ()
forall a b. (a -> b) -> a -> b
$ do
                        FileInfo
info <- FileId -> Session -> IO FileInfo
mmGetMetadataForFile FileId
fId Session
session
                        Maybe (MH ()) -> IO (Maybe (MH ()))
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (MH ()) -> IO (Maybe (MH ())))
-> Maybe (MH ()) -> IO (Maybe (MH ()))
forall a b. (a -> b) -> a -> b
$ MH () -> Maybe (MH ())
forall a. a -> Maybe a
Just (MH () -> Maybe (MH ())) -> MH () -> Maybe (MH ())
forall a b. (a -> b) -> a -> b
$ do
                            (TeamState -> Identity TeamState)
-> ChatState -> Identity ChatState
Lens' ChatState TeamState
csCurrentTeam((TeamState -> Identity TeamState)
 -> ChatState -> Identity ChatState)
-> ((SaveAttachmentDialogState
     -> Identity SaveAttachmentDialogState)
    -> TeamState -> Identity TeamState)
-> (SaveAttachmentDialogState
    -> Identity SaveAttachmentDialogState)
-> ChatState
-> Identity ChatState
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(SaveAttachmentDialogState -> Identity SaveAttachmentDialogState)
-> TeamState -> Identity TeamState
Lens' TeamState SaveAttachmentDialogState
tsSaveAttachmentDialog ((SaveAttachmentDialogState -> Identity SaveAttachmentDialogState)
 -> ChatState -> Identity ChatState)
-> SaveAttachmentDialogState -> MH ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= TeamId -> Text -> SaveAttachmentDialogState
newSaveAttachmentDialog TeamId
tId (FileInfo -> Text
fileInfoName FileInfo
info)
                            Mode -> MH ()
setMode (Mode -> MH ()) -> Mode -> MH ()
forall a b. (a -> b) -> a -> b
$ LinkChoice -> Mode
SaveAttachmentWindow LinkChoice
link
                LinkTarget
_ ->
                    -- The selected link is not for an attachment.
                    () -> MH ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()