{-# LANGUAGE MultiWayIf #-}
module Matterhorn.State.ChannelSelect
  ( beginChannelSelect
  , updateChannelSelectMatches
  , channelSelectNext
  , channelSelectPrevious
  )
where

import           Prelude ()
import           Matterhorn.Prelude

import           Brick.Widgets.Edit ( getEditContents )
import           Data.Char ( isUpper )
import qualified Data.Text as T
import           Lens.Micro.Platform

import qualified Network.Mattermost.Types as MM

import           Matterhorn.Constants ( userSigil, normalChannelSigil )
import           Matterhorn.Types
import qualified Matterhorn.Zipper as Z

beginChannelSelect :: MM.TeamId -> MH ()
beginChannelSelect :: TeamId -> MH ()
beginChannelSelect TeamId
tId = do
    TeamId -> Mode -> MH ()
pushMode TeamId
tId Mode
ChannelSelect
    TeamId -> Lens' ChatState TeamState
csTeam(TeamId
tId)forall b c a. (b -> c) -> (a -> b) -> a -> c
.Lens' TeamState ChannelSelectState
tsChannelSelectState forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= TeamId -> ChannelSelectState
emptyChannelSelectState TeamId
tId
    TeamId -> MH ()
updateChannelSelectMatches TeamId
tId

    -- Preserve the current channel selection when initializing channel
    -- selection mode
    Zipper ChannelListGroup ChannelListEntry
zipper <- forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use (TeamId -> Lens' ChatState TeamState
csTeam(TeamId
tId)forall b c a. (b -> c) -> (a -> b) -> a -> c
.Lens' TeamState (Zipper ChannelListGroup ChannelListEntry)
tsFocus)
    let isCurrentFocus :: ChannelSelectMatch -> Bool
isCurrentFocus ChannelSelectMatch
m = forall a. a -> Maybe a
Just (ChannelSelectMatch -> ChannelListEntry
matchEntry ChannelSelectMatch
m) forall a. Eq a => a -> a -> Bool
== forall a b. Zipper a b -> Maybe b
Z.focus Zipper ChannelListGroup ChannelListEntry
zipper
    TeamId -> Lens' ChatState TeamState
csTeam(TeamId
tId)forall b c a. (b -> c) -> (a -> b) -> a -> c
.Lens' TeamState ChannelSelectState
tsChannelSelectStateforall b c a. (b -> c) -> (a -> b) -> a -> c
.Lens'
  ChannelSelectState (Zipper ChannelListGroup ChannelSelectMatch)
channelSelectMatches forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= forall b a. (b -> Bool) -> Zipper a b -> Zipper a b
Z.findRight ChannelSelectMatch -> Bool
isCurrentFocus

-- Select the next match in channel selection mode.
channelSelectNext :: MM.TeamId -> MH ()
channelSelectNext :: TeamId -> MH ()
channelSelectNext TeamId
tId = TeamId
-> (Zipper ChannelListGroup ChannelSelectMatch
    -> Zipper ChannelListGroup ChannelSelectMatch)
-> MH ()
updateSelectedMatch TeamId
tId forall a b. Zipper a b -> Zipper a b
Z.right

-- Select the previous match in channel selection mode.
channelSelectPrevious :: MM.TeamId -> MH ()
channelSelectPrevious :: TeamId -> MH ()
channelSelectPrevious TeamId
tId = TeamId
-> (Zipper ChannelListGroup ChannelSelectMatch
    -> Zipper ChannelListGroup ChannelSelectMatch)
-> MH ()
updateSelectedMatch TeamId
tId forall a b. Zipper a b -> Zipper a b
Z.left

updateChannelSelectMatches :: MM.TeamId -> MH ()
updateChannelSelectMatches :: TeamId -> MH ()
updateChannelSelectMatches TeamId
tId = do
    ChatState
st <- forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use forall a. a -> a
id

    Editor Text Name
input <- forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use (TeamId -> Lens' ChatState TeamState
csTeam(TeamId
tId)forall b c a. (b -> c) -> (a -> b) -> a -> c
.Lens' TeamState ChannelSelectState
tsChannelSelectStateforall b c a. (b -> c) -> (a -> b) -> a -> c
.Lens' ChannelSelectState (Editor Text Name)
channelSelectInput)
    Maybe ClientConfig
cconfig <- forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use Lens' ChatState (Maybe ClientConfig)
csClientConfig
    UserPreferences
prefs <- forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use (Lens' ChatState ChatResources
csResourcesforall b c a. (b -> c) -> (a -> b) -> a -> c
.Lens' ChatResources UserPreferences
crUserPreferences)

    let pat :: Maybe ChannelSelectPattern
pat = Text -> Maybe ChannelSelectPattern
parseChannelSelectPattern 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
input
        chanNameMatches :: ChannelListEntry -> Text -> Maybe ChannelSelectMatch
chanNameMatches ChannelListEntry
e = case Maybe ChannelSelectPattern
pat of
            Maybe ChannelSelectPattern
Nothing -> forall a b. a -> b -> a
const forall a. Maybe a
Nothing
            Just ChannelSelectPattern
p -> ChannelSelectPattern
-> ChannelListEntry -> Text -> Maybe ChannelSelectMatch
applySelectPattern ChannelSelectPattern
p ChannelListEntry
e
        patTy :: Maybe MatchType
patTy = case Maybe ChannelSelectPattern
pat of
            Maybe ChannelSelectPattern
Nothing -> forall a. Maybe a
Nothing
            Just ChannelSelectPattern
CSPAny -> forall a. Maybe a
Nothing
            Just (CSP MatchType
ty Text
_) -> forall a. a -> Maybe a
Just MatchType
ty

    let chanMatches :: ChannelListEntry -> ClientChannel -> Maybe ChannelSelectMatch
chanMatches ChannelListEntry
e ClientChannel
chan =
            if Maybe MatchType
patTy forall a. Eq a => a -> a -> Bool
== forall a. a -> Maybe a
Just MatchType
PrefixDMOnly
            then forall a. Maybe a
Nothing
            else if ClientChannel
chanforall s a. s -> Getting a s a -> a
^.Lens' ClientChannel ChannelInfo
ccInfoforall b c a. (b -> c) -> (a -> b) -> a -> c
.Lens' ChannelInfo Type
cdType forall a. Eq a => a -> a -> Bool
/= Type
MM.Group
                 then ChannelListEntry -> Text -> Maybe ChannelSelectMatch
chanNameMatches ChannelListEntry
e forall a b. (a -> b) -> a -> b
$ ClientChannel
chanforall s a. s -> Getting a s a -> a
^.Lens' ClientChannel ChannelInfo
ccInfoforall b c a. (b -> c) -> (a -> b) -> a -> c
.Lens' ChannelInfo Text
cdDisplayName
                 else forall a. Maybe a
Nothing
        groupChanMatches :: ChannelListEntry -> ClientChannel -> Maybe ChannelSelectMatch
groupChanMatches ChannelListEntry
e ClientChannel
chan =
            if Maybe MatchType
patTy forall a. Eq a => a -> a -> Bool
== forall a. a -> Maybe a
Just MatchType
PrefixNonDMOnly
            then forall a. Maybe a
Nothing
            else if ClientChannel
chanforall s a. s -> Getting a s a -> a
^.Lens' ClientChannel ChannelInfo
ccInfoforall b c a. (b -> c) -> (a -> b) -> a -> c
.Lens' ChannelInfo Type
cdType forall a. Eq a => a -> a -> Bool
== Type
MM.Group
                 then ChannelListEntry -> Text -> Maybe ChannelSelectMatch
chanNameMatches ChannelListEntry
e forall a b. (a -> b) -> a -> b
$ ClientChannel
chanforall s a. s -> Getting a s a -> a
^.Lens' ClientChannel ChannelInfo
ccInfoforall b c a. (b -> c) -> (a -> b) -> a -> c
.Lens' ChannelInfo Text
cdDisplayName
                 else forall a. Maybe a
Nothing
        displayName :: UserInfo -> Text
displayName UserInfo
uInfo = UserInfo -> Maybe ClientConfig -> UserPreferences -> Text
displayNameForUser UserInfo
uInfo Maybe ClientConfig
cconfig UserPreferences
prefs
        userMatches :: ChannelListEntry -> UserInfo -> Maybe ChannelSelectMatch
userMatches ChannelListEntry
e UserInfo
uInfo =
            if Maybe MatchType
patTy forall a. Eq a => a -> a -> Bool
== forall a. a -> Maybe a
Just MatchType
PrefixNonDMOnly
            then forall a. Maybe a
Nothing
            else (ChannelListEntry -> Text -> Maybe ChannelSelectMatch
chanNameMatches ChannelListEntry
e forall b c a. (b -> c) -> (a -> b) -> a -> c
. UserInfo -> Text
displayName) UserInfo
uInfo
        matches :: ChannelListEntry -> Maybe ChannelSelectMatch
matches ChannelListEntry
e =
            let cId :: ChannelId
cId = ChannelListEntry -> ChannelId
channelListEntryChannelId ChannelListEntry
e
            in case ChannelListEntry -> ChannelListEntryType
channelListEntryType ChannelListEntry
e of
                ChannelListEntryType
CLChannel    -> ChannelId -> ClientChannels -> Maybe ClientChannel
findChannelById ChannelId
cId (ChatState
stforall s a. s -> Getting a s a -> a
^.Lens' ChatState ClientChannels
csChannels) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ChannelListEntry -> ClientChannel -> Maybe ChannelSelectMatch
chanMatches ChannelListEntry
e
                CLUserDM UserId
uId -> UserId -> ChatState -> Maybe UserInfo
userById UserId
uId ChatState
st forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ChannelListEntry -> UserInfo -> Maybe ChannelSelectMatch
userMatches ChannelListEntry
e
                ChannelListEntryType
CLGroupDM    -> ChannelId -> ClientChannels -> Maybe ClientChannel
findChannelById ChannelId
cId (ChatState
stforall s a. s -> Getting a s a -> a
^.Lens' ChatState ClientChannels
csChannels) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ChannelListEntry -> ClientChannel -> Maybe ChannelSelectMatch
groupChanMatches ChannelListEntry
e

        preserveFocus :: Maybe ChannelSelectMatch -> ChannelSelectMatch -> Bool
preserveFocus Maybe ChannelSelectMatch
Nothing ChannelSelectMatch
_ = Bool
False
        preserveFocus (Just ChannelSelectMatch
m) ChannelSelectMatch
m2 = ChannelSelectMatch -> ChannelListEntry
matchEntry ChannelSelectMatch
m forall a. Eq a => a -> a -> Bool
== ChannelSelectMatch -> ChannelListEntry
matchEntry ChannelSelectMatch
m2

    TeamId -> Lens' ChatState TeamState
csTeam(TeamId
tId)forall b c a. (b -> c) -> (a -> b) -> a -> c
.Lens' TeamState ChannelSelectState
tsChannelSelectStateforall b c a. (b -> c) -> (a -> b) -> a -> c
.Lens'
  ChannelSelectState (Zipper ChannelListGroup ChannelSelectMatch)
channelSelectMatches forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%=
        (forall b a.
Eq b =>
(Maybe b -> b -> Bool) -> [(a, [b])] -> Zipper a b -> Zipper a b
Z.updateListBy Maybe ChannelSelectMatch -> ChannelSelectMatch -> Bool
preserveFocus forall a b. (a -> b) -> a -> b
$ forall a b. Zipper a b -> [(a, [b])]
Z.toList forall a b. (a -> b) -> a -> b
$ forall c b a. Eq c => (b -> Maybe c) -> Zipper a b -> Zipper a c
Z.maybeMapZipper ChannelListEntry -> Maybe ChannelSelectMatch
matches (ChatState
stforall s a. s -> Getting a s a -> a
^.TeamId -> Lens' ChatState TeamState
csTeam(TeamId
tId)forall b c a. (b -> c) -> (a -> b) -> a -> c
.Lens' TeamState (Zipper ChannelListGroup ChannelListEntry)
tsFocus))

applySelectPattern :: ChannelSelectPattern -> ChannelListEntry -> Text -> Maybe ChannelSelectMatch
applySelectPattern :: ChannelSelectPattern
-> ChannelListEntry -> Text -> Maybe ChannelSelectMatch
applySelectPattern ChannelSelectPattern
CSPAny ChannelListEntry
entry Text
chanName = do
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Text
-> Text -> Text -> Text -> ChannelListEntry -> ChannelSelectMatch
ChannelSelectMatch Text
"" Text
"" Text
chanName Text
chanName ChannelListEntry
entry
applySelectPattern (CSP MatchType
ty Text
pat) ChannelListEntry
entry Text
chanName = do
    let applyType :: MatchType -> Maybe (Text, Text, Text)
applyType MatchType
Infix | Text
pat Text -> Text -> Bool
`T.isInfixOf` Text
normalizedChanName =
            case Text -> Text -> (Text, Text)
T.breakOn Text
pat Text
normalizedChanName of
                (Text
pre, Text
_) ->
                    forall (m :: * -> *) a. Monad m => a -> m a
return ( Int -> Text -> Text
T.take (Text -> Int
T.length Text
pre) Text
chanName
                           , Int -> Text -> Text
T.take (Text -> Int
T.length Text
pat) forall a b. (a -> b) -> a -> b
$ Int -> Text -> Text
T.drop (Text -> Int
T.length Text
pre) Text
chanName
                           , Int -> Text -> Text
T.drop (Text -> Int
T.length Text
pat forall a. Num a => a -> a -> a
+ Text -> Int
T.length Text
pre) Text
chanName
                           )

        applyType MatchType
Prefix | Text
pat Text -> Text -> Bool
`T.isPrefixOf` Text
normalizedChanName = do
            let (Text
b, Text
a) = Int -> Text -> (Text, Text)
T.splitAt (Text -> Int
T.length Text
pat) Text
chanName
            forall (m :: * -> *) a. Monad m => a -> m a
return (Text
"", Text
b, Text
a)

        applyType MatchType
PrefixDMOnly | Text
pat Text -> Text -> Bool
`T.isPrefixOf` Text
normalizedChanName = do
            let (Text
b, Text
a) = Int -> Text -> (Text, Text)
T.splitAt (Text -> Int
T.length Text
pat) Text
chanName
            forall (m :: * -> *) a. Monad m => a -> m a
return (Text
"", Text
b, Text
a)

        applyType MatchType
PrefixNonDMOnly | Text
pat Text -> Text -> Bool
`T.isPrefixOf` Text
normalizedChanName = do
            let (Text
b, Text
a) = Int -> Text -> (Text, Text)
T.splitAt (Text -> Int
T.length Text
pat) Text
chanName
            forall (m :: * -> *) a. Monad m => a -> m a
return (Text
"", Text
b, Text
a)

        applyType MatchType
Suffix | Text
pat Text -> Text -> Bool
`T.isSuffixOf` Text
normalizedChanName = do
            let (Text
b, Text
a) = Int -> Text -> (Text, Text)
T.splitAt (Text -> Int
T.length Text
chanName forall a. Num a => a -> a -> a
- Text -> Int
T.length Text
pat) Text
chanName
            forall (m :: * -> *) a. Monad m => a -> m a
return (Text
b, Text
a, Text
"")

        applyType MatchType
Equal  | Text
pat forall a. Eq a => a -> a -> Bool
== Text
normalizedChanName =
            forall (m :: * -> *) a. Monad m => a -> m a
return (Text
"", Text
chanName, Text
"")

        applyType MatchType
_ = forall a. Maybe a
Nothing

        caseSensitive :: Bool
caseSensitive = (Char -> Bool) -> Text -> Bool
T.any Char -> Bool
isUpper Text
pat
        normalizedChanName :: Text
normalizedChanName = if Bool
caseSensitive
                             then Text
chanName
                             else Text -> Text
T.toLower Text
chanName

    (Text
pre, Text
m, Text
post) <- MatchType -> Maybe (Text, Text, Text)
applyType MatchType
ty
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Text
-> Text -> Text -> Text -> ChannelListEntry -> ChannelSelectMatch
ChannelSelectMatch Text
pre Text
m Text
post Text
chanName ChannelListEntry
entry

parseChannelSelectPattern :: Text -> Maybe ChannelSelectPattern
parseChannelSelectPattern :: Text -> Maybe ChannelSelectPattern
parseChannelSelectPattern Text
"" = forall (m :: * -> *) a. Monad m => a -> m a
return ChannelSelectPattern
CSPAny
parseChannelSelectPattern Text
pat = do
    let only :: Maybe ChannelSelectPattern
only = if | Text
userSigil Text -> Text -> Bool
`T.isPrefixOf` Text
pat -> forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ MatchType -> Text -> ChannelSelectPattern
CSP MatchType
PrefixDMOnly forall a b. (a -> b) -> a -> b
$ Text -> Text
T.tail Text
pat
                  | Text
normalChannelSigil Text -> Text -> Bool
`T.isPrefixOf` Text
pat -> forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ MatchType -> Text -> ChannelSelectPattern
CSP MatchType
PrefixNonDMOnly forall a b. (a -> b) -> a -> b
$ Text -> Text
T.tail Text
pat
                  | Bool
otherwise -> forall a. Maybe a
Nothing

    (Text
pat1, Maybe MatchType
pfx) <- case Text
"^" Text -> Text -> Bool
`T.isPrefixOf` Text
pat of
        Bool
True  -> forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> Text
T.tail Text
pat, forall a. a -> Maybe a
Just MatchType
Prefix)
        Bool
False -> forall (m :: * -> *) a. Monad m => a -> m a
return (Text
pat, forall a. Maybe a
Nothing)

    (Text
pat2, Maybe MatchType
sfx) <- case Text
"$" Text -> Text -> Bool
`T.isSuffixOf` Text
pat1 of
        Bool
True  -> forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> Text
T.init Text
pat1, forall a. a -> Maybe a
Just MatchType
Suffix)
        Bool
False -> forall (m :: * -> *) a. Monad m => a -> m a
return (Text
pat1, forall a. Maybe a
Nothing)

    Maybe ChannelSelectPattern
only forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> case (Maybe MatchType
pfx, Maybe MatchType
sfx) of
        (Maybe MatchType
Nothing, Maybe MatchType
Nothing)         -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ MatchType -> Text -> ChannelSelectPattern
CSP MatchType
Infix  Text
pat2
        (Just MatchType
Prefix, Maybe MatchType
Nothing)     -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ MatchType -> Text -> ChannelSelectPattern
CSP MatchType
Prefix Text
pat2
        (Maybe MatchType
Nothing, Just MatchType
Suffix)     -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ MatchType -> Text -> ChannelSelectPattern
CSP MatchType
Suffix Text
pat2
        (Just MatchType
Prefix, Just MatchType
Suffix) -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ MatchType -> Text -> ChannelSelectPattern
CSP MatchType
Equal  Text
pat2
        (Maybe MatchType, Maybe MatchType)
tys                        -> forall a. HasCallStack => [Char] -> a
error forall a b. (a -> b) -> a -> b
$ [Char]
"BUG: invalid channel select case: " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> [Char]
show (Maybe MatchType, Maybe MatchType)
tys

-- Update the channel selection mode match cursor. The argument function
-- determines how to navigate to the next item.
updateSelectedMatch :: MM.TeamId
                    -> (Z.Zipper ChannelListGroup ChannelSelectMatch -> Z.Zipper ChannelListGroup ChannelSelectMatch)
                    -> MH ()
updateSelectedMatch :: TeamId
-> (Zipper ChannelListGroup ChannelSelectMatch
    -> Zipper ChannelListGroup ChannelSelectMatch)
-> MH ()
updateSelectedMatch TeamId
tId Zipper ChannelListGroup ChannelSelectMatch
-> Zipper ChannelListGroup ChannelSelectMatch
nextItem =
    TeamId -> Lens' ChatState TeamState
csTeam(TeamId
tId)forall b c a. (b -> c) -> (a -> b) -> a -> c
.Lens' TeamState ChannelSelectState
tsChannelSelectStateforall b c a. (b -> c) -> (a -> b) -> a -> c
.Lens'
  ChannelSelectState (Zipper ChannelListGroup ChannelSelectMatch)
channelSelectMatches forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= Zipper ChannelListGroup ChannelSelectMatch
-> Zipper ChannelListGroup ChannelSelectMatch
nextItem