{-# LANGUAGE RankNTypes #-}
module Matterhorn.State.UrlSelect
  (
  -- * URL selection mode
    startUrlSelect
  , stopUrlSelect
  , openSelectedURL
  )
where

import           Prelude ()
import           Matterhorn.Prelude

import           Brick.Widgets.List ( listSelectedElement, listReplace )
import qualified Data.Vector as V
import           Lens.Micro.Platform ( (.=), (%=), to, Lens' )

import           Matterhorn.State.Links
import           Matterhorn.Types
import           Matterhorn.Util


startUrlSelect :: Lens' ChatState (MessageInterface n i)
               -> MH ()
startUrlSelect :: forall n i. Lens' ChatState (MessageInterface n i) -> MH ()
startUrlSelect Lens' ChatState (MessageInterface n i)
which = do
    Messages
msgs <- Getting Messages ChatState Messages -> MH Messages
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use ((MessageInterface n i -> Const Messages (MessageInterface n i))
-> ChatState -> Const Messages ChatState
Lens' ChatState (MessageInterface n i)
which((MessageInterface n i -> Const Messages (MessageInterface n i))
 -> ChatState -> Const Messages ChatState)
-> ((Messages -> Const Messages Messages)
    -> MessageInterface n i -> Const Messages (MessageInterface n i))
-> Getting Messages ChatState Messages
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Messages -> Const Messages Messages)
-> MessageInterface n i -> Const Messages (MessageInterface n i)
forall n i (f :: * -> *).
Functor f =>
(Messages -> f Messages)
-> MessageInterface n i -> f (MessageInterface n i)
miMessages)
    URLListSource
src <- Getting URLListSource ChatState URLListSource -> MH URLListSource
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use ((MessageInterface n i
 -> Const URLListSource (MessageInterface n i))
-> ChatState -> Const URLListSource ChatState
Lens' ChatState (MessageInterface n i)
which((MessageInterface n i
  -> Const URLListSource (MessageInterface n i))
 -> ChatState -> Const URLListSource ChatState)
-> ((URLListSource -> Const URLListSource URLListSource)
    -> MessageInterface n i
    -> Const URLListSource (MessageInterface n i))
-> Getting URLListSource ChatState URLListSource
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(URLListSource -> Const URLListSource URLListSource)
-> MessageInterface n i
-> Const URLListSource (MessageInterface n i)
forall n i (f :: * -> *).
Functor f =>
(URLListSource -> f URLListSource)
-> MessageInterface n i -> f (MessageInterface n i)
miUrlListSource)
    let urls :: Vector LinkChoice
urls = [LinkChoice] -> Vector LinkChoice
forall a. [a] -> Vector a
V.fromList ([LinkChoice] -> Vector LinkChoice)
-> [LinkChoice] -> Vector LinkChoice
forall a b. (a -> b) -> a -> b
$ Messages -> [LinkChoice]
findUrls Messages
msgs
        urlsWithIndexes :: Vector (Int, LinkChoice)
urlsWithIndexes = Vector LinkChoice -> Vector (Int, LinkChoice)
forall a. Vector a -> Vector (Int, a)
V.indexed Vector LinkChoice
urls
    (MessageInterface n i -> Identity (MessageInterface n i))
-> ChatState -> Identity ChatState
Lens' ChatState (MessageInterface n i)
which((MessageInterface n i -> Identity (MessageInterface n i))
 -> ChatState -> Identity ChatState)
-> ((MessageInterfaceMode -> Identity MessageInterfaceMode)
    -> MessageInterface n i -> Identity (MessageInterface n i))
-> (MessageInterfaceMode -> Identity MessageInterfaceMode)
-> ChatState
-> Identity ChatState
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(MessageInterfaceMode -> Identity MessageInterfaceMode)
-> MessageInterface n i -> Identity (MessageInterface n i)
forall n i (f :: * -> *).
Functor f =>
(MessageInterfaceMode -> f MessageInterfaceMode)
-> MessageInterface n i -> f (MessageInterface n i)
miMode ((MessageInterfaceMode -> Identity MessageInterfaceMode)
 -> ChatState -> Identity ChatState)
-> MessageInterfaceMode -> MH ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= MessageInterfaceMode
ShowUrlList
    (MessageInterface n i -> Identity (MessageInterface n i))
-> ChatState -> Identity ChatState
Lens' ChatState (MessageInterface n i)
which((MessageInterface n i -> Identity (MessageInterface n i))
 -> ChatState -> Identity ChatState)
-> ((List n (Int, LinkChoice)
     -> Identity (List n (Int, LinkChoice)))
    -> MessageInterface n i -> Identity (MessageInterface n i))
-> (List n (Int, LinkChoice)
    -> Identity (List n (Int, LinkChoice)))
-> ChatState
-> Identity ChatState
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(URLList n -> Identity (URLList n))
-> MessageInterface n i -> Identity (MessageInterface n i)
forall n i (f :: * -> *).
Functor f =>
(URLList n -> f (URLList n))
-> MessageInterface n i -> f (MessageInterface n i)
miUrlList((URLList n -> Identity (URLList n))
 -> MessageInterface n i -> Identity (MessageInterface n i))
-> ((List n (Int, LinkChoice)
     -> Identity (List n (Int, LinkChoice)))
    -> URLList n -> Identity (URLList n))
-> (List n (Int, LinkChoice)
    -> Identity (List n (Int, LinkChoice)))
-> MessageInterface n i
-> Identity (MessageInterface n i)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(List n (Int, LinkChoice) -> Identity (List n (Int, LinkChoice)))
-> URLList n -> Identity (URLList n)
forall n1 n2 (f :: * -> *).
Functor f =>
(List n1 (Int, LinkChoice) -> f (List n2 (Int, LinkChoice)))
-> URLList n1 -> f (URLList n2)
ulList ((List n (Int, LinkChoice) -> Identity (List n (Int, LinkChoice)))
 -> ChatState -> Identity ChatState)
-> (List n (Int, LinkChoice) -> List n (Int, LinkChoice)) -> MH ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= Vector (Int, LinkChoice)
-> Maybe Int
-> List n (Int, LinkChoice)
-> List n (Int, LinkChoice)
forall (t :: * -> *) e n.
(Foldable t, Splittable t) =>
t e -> Maybe Int -> GenericList n t e -> GenericList n t e
listReplace Vector (Int, LinkChoice)
urlsWithIndexes (Int -> Maybe Int
forall a. a -> Maybe a
Just (Int -> Maybe Int) -> Int -> Maybe Int
forall a b. (a -> b) -> a -> b
$ Vector LinkChoice -> Int
forall a. Vector a -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length Vector LinkChoice
urls Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)
    (MessageInterface n i -> Identity (MessageInterface n i))
-> ChatState -> Identity ChatState
Lens' ChatState (MessageInterface n i)
which((MessageInterface n i -> Identity (MessageInterface n i))
 -> ChatState -> Identity ChatState)
-> ((Maybe URLListSource -> Identity (Maybe URLListSource))
    -> MessageInterface n i -> Identity (MessageInterface n i))
-> (Maybe URLListSource -> Identity (Maybe URLListSource))
-> ChatState
-> Identity ChatState
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(URLList n -> Identity (URLList n))
-> MessageInterface n i -> Identity (MessageInterface n i)
forall n i (f :: * -> *).
Functor f =>
(URLList n -> f (URLList n))
-> MessageInterface n i -> f (MessageInterface n i)
miUrlList((URLList n -> Identity (URLList n))
 -> MessageInterface n i -> Identity (MessageInterface n i))
-> ((Maybe URLListSource -> Identity (Maybe URLListSource))
    -> URLList n -> Identity (URLList n))
-> (Maybe URLListSource -> Identity (Maybe URLListSource))
-> MessageInterface n i
-> Identity (MessageInterface n i)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Maybe URLListSource -> Identity (Maybe URLListSource))
-> URLList n -> Identity (URLList n)
forall n (f :: * -> *).
Functor f =>
(Maybe URLListSource -> f (Maybe URLListSource))
-> URLList n -> f (URLList n)
ulSource ((Maybe URLListSource -> Identity (Maybe URLListSource))
 -> ChatState -> Identity ChatState)
-> Maybe URLListSource -> MH ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= URLListSource -> Maybe URLListSource
forall a. a -> Maybe a
Just URLListSource
src

stopUrlSelect :: Lens' ChatState (MessageInterface n i)
              -> MH ()
stopUrlSelect :: forall n i. Lens' ChatState (MessageInterface n i) -> MH ()
stopUrlSelect Lens' ChatState (MessageInterface n i)
which = do
    (MessageInterface n i -> Identity (MessageInterface n i))
-> ChatState -> Identity ChatState
Lens' ChatState (MessageInterface n i)
which((MessageInterface n i -> Identity (MessageInterface n i))
 -> ChatState -> Identity ChatState)
-> ((MessageInterfaceMode -> Identity MessageInterfaceMode)
    -> MessageInterface n i -> Identity (MessageInterface n i))
-> (MessageInterfaceMode -> Identity MessageInterfaceMode)
-> ChatState
-> Identity ChatState
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(MessageInterfaceMode -> Identity MessageInterfaceMode)
-> MessageInterface n i -> Identity (MessageInterface n i)
forall n i (f :: * -> *).
Functor f =>
(MessageInterfaceMode -> f MessageInterfaceMode)
-> MessageInterface n i -> f (MessageInterface n i)
miMode ((MessageInterfaceMode -> Identity MessageInterfaceMode)
 -> ChatState -> Identity ChatState)
-> MessageInterfaceMode -> MH ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= MessageInterfaceMode
Compose

openSelectedURL :: Lens' ChatState (MessageInterface n i) -> MH ()
openSelectedURL :: forall n i. Lens' ChatState (MessageInterface n i) -> MH ()
openSelectedURL Lens' ChatState (MessageInterface n i)
which = 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 ((MessageInterface n i
 -> Const (Maybe (Int, (Int, LinkChoice))) (MessageInterface n i))
-> ChatState -> Const (Maybe (Int, (Int, LinkChoice))) ChatState
Lens' ChatState (MessageInterface n i)
which((MessageInterface n i
  -> Const (Maybe (Int, (Int, LinkChoice))) (MessageInterface n i))
 -> ChatState -> Const (Maybe (Int, (Int, LinkChoice))) ChatState)
-> ((Maybe (Int, (Int, LinkChoice))
     -> Const
          (Maybe (Int, (Int, LinkChoice))) (Maybe (Int, (Int, LinkChoice))))
    -> MessageInterface n i
    -> Const (Maybe (Int, (Int, LinkChoice))) (MessageInterface n i))
-> Getting
     (Maybe (Int, (Int, LinkChoice)))
     ChatState
     (Maybe (Int, (Int, LinkChoice)))
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(URLList n -> Const (Maybe (Int, (Int, LinkChoice))) (URLList n))
-> MessageInterface n i
-> Const (Maybe (Int, (Int, LinkChoice))) (MessageInterface n i)
forall n i (f :: * -> *).
Functor f =>
(URLList n -> f (URLList n))
-> MessageInterface n i -> f (MessageInterface n i)
miUrlList((URLList n -> Const (Maybe (Int, (Int, LinkChoice))) (URLList n))
 -> MessageInterface n i
 -> Const (Maybe (Int, (Int, LinkChoice))) (MessageInterface n i))
-> ((Maybe (Int, (Int, LinkChoice))
     -> Const
          (Maybe (Int, (Int, LinkChoice))) (Maybe (Int, (Int, LinkChoice))))
    -> URLList n -> Const (Maybe (Int, (Int, LinkChoice))) (URLList n))
-> (Maybe (Int, (Int, LinkChoice))
    -> Const
         (Maybe (Int, (Int, LinkChoice))) (Maybe (Int, (Int, LinkChoice))))
-> MessageInterface n i
-> Const (Maybe (Int, (Int, LinkChoice))) (MessageInterface n i)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(List n (Int, LinkChoice)
 -> Const
      (Maybe (Int, (Int, LinkChoice))) (List n (Int, LinkChoice)))
-> URLList n -> Const (Maybe (Int, (Int, LinkChoice))) (URLList n)
forall n1 n2 (f :: * -> *).
Functor f =>
(List n1 (Int, LinkChoice) -> f (List n2 (Int, LinkChoice)))
-> URLList n1 -> f (URLList n2)
ulList((List n (Int, LinkChoice)
  -> Const
       (Maybe (Int, (Int, LinkChoice))) (List n (Int, LinkChoice)))
 -> URLList n -> Const (Maybe (Int, (Int, LinkChoice))) (URLList n))
-> ((Maybe (Int, (Int, LinkChoice))
     -> Const
          (Maybe (Int, (Int, LinkChoice))) (Maybe (Int, (Int, LinkChoice))))
    -> List n (Int, LinkChoice)
    -> Const
         (Maybe (Int, (Int, LinkChoice))) (List n (Int, LinkChoice)))
-> (Maybe (Int, (Int, LinkChoice))
    -> Const
         (Maybe (Int, (Int, LinkChoice))) (Maybe (Int, (Int, LinkChoice))))
-> URLList n
-> Const (Maybe (Int, (Int, LinkChoice))) (URLList n)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(List n (Int, LinkChoice) -> Maybe (Int, (Int, LinkChoice)))
-> SimpleGetter
     (List n (Int, LinkChoice)) (Maybe (Int, (Int, LinkChoice)))
forall s a. (s -> a) -> SimpleGetter s a
to List n (Int, LinkChoice) -> Maybe (Int, (Int, LinkChoice))
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 -> () -> MH ()
forall a. a -> MH a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
        Just (Int
_, (Int
_, LinkChoice
link)) -> LinkTarget -> MH ()
openLinkTarget (LinkChoice
linkLinkChoice
-> Getting LinkTarget LinkChoice LinkTarget -> LinkTarget
forall s a. s -> Getting a s a -> a
^.Getting LinkTarget LinkChoice LinkTarget
Lens' LinkChoice LinkTarget
linkTarget)
    Lens' ChatState (MessageInterface n i) -> MH ()
forall n i. Lens' ChatState (MessageInterface n i) -> MH ()
stopUrlSelect (MessageInterface n i -> f (MessageInterface n i))
-> ChatState -> f ChatState
Lens' ChatState (MessageInterface n i)
which

findUrls :: Messages -> [LinkChoice]
findUrls :: Messages -> [LinkChoice]
findUrls Messages
ms =
    let msgs :: Messages
msgs = (Message -> Bool) -> Messages -> Messages
forall seq a.
SeqDirection seq =>
(a -> Bool) -> DirectionalSeq seq a -> DirectionalSeq seq a
filterMessages (Bool -> Bool
not (Bool -> Bool) -> (Message -> Bool) -> Message -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Message -> Bool
_mDeleted) Messages
ms
    in [LinkChoice] -> [LinkChoice]
removeDuplicates ([LinkChoice] -> [LinkChoice]) -> [LinkChoice] -> [LinkChoice]
forall a b. (a -> b) -> a -> b
$ [[LinkChoice]] -> [LinkChoice]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[LinkChoice]] -> [LinkChoice]) -> [[LinkChoice]] -> [LinkChoice]
forall a b. (a -> b) -> a -> b
$ DirectionalSeq Chronological [LinkChoice] -> [[LinkChoice]]
forall a. DirectionalSeq Chronological a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList (DirectionalSeq Chronological [LinkChoice] -> [[LinkChoice]])
-> DirectionalSeq Chronological [LinkChoice] -> [[LinkChoice]]
forall a b. (a -> b) -> a -> b
$ Seq LinkChoice -> [LinkChoice]
forall a. Seq a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList (Seq LinkChoice -> [LinkChoice])
-> (Message -> Seq LinkChoice) -> Message -> [LinkChoice]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Message -> Seq LinkChoice
msgURLs (Message -> [LinkChoice])
-> Messages -> DirectionalSeq Chronological [LinkChoice]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Messages
msgs

removeDuplicates :: [LinkChoice] -> [LinkChoice]
removeDuplicates :: [LinkChoice] -> [LinkChoice]
removeDuplicates = (LinkChoice -> (LinkTarget, UserRef, Maybe Inlines))
-> [LinkChoice] -> [LinkChoice]
forall b a. Ord b => (a -> b) -> [a] -> [a]
nubOn (\ LinkChoice
l -> (LinkChoice
lLinkChoice
-> Getting LinkTarget LinkChoice LinkTarget -> LinkTarget
forall s a. s -> Getting a s a -> a
^.Getting LinkTarget LinkChoice LinkTarget
Lens' LinkChoice LinkTarget
linkTarget, LinkChoice
lLinkChoice -> Getting UserRef LinkChoice UserRef -> UserRef
forall s a. s -> Getting a s a -> a
^.Getting UserRef LinkChoice UserRef
Lens' LinkChoice UserRef
linkUser, LinkChoice
lLinkChoice
-> Getting (Maybe Inlines) LinkChoice (Maybe Inlines)
-> Maybe Inlines
forall s a. s -> Getting a s a -> a
^.Getting (Maybe Inlines) LinkChoice (Maybe Inlines)
Lens' LinkChoice (Maybe Inlines)
linkLabel))