1{-# LANGUAGE MultiWayIf #-}
2module Matterhorn.State.ChannelSelect
3  ( beginChannelSelect
4  , updateChannelSelectMatches
5  , channelSelectNext
6  , channelSelectPrevious
7  )
8where
9
10import           Prelude ()
11import           Matterhorn.Prelude
12
13import           Brick.Widgets.Edit ( getEditContents )
14import           Data.Char ( isUpper )
15import qualified Data.Text as T
16import           Lens.Micro.Platform
17
18import qualified Network.Mattermost.Types as MM
19
20import           Matterhorn.Constants ( userSigil, normalChannelSigil )
21import           Matterhorn.Types
22import qualified Matterhorn.Zipper as Z
23
24beginChannelSelect :: MH ()
25beginChannelSelect = do
26    setMode ChannelSelect
27    tId <- use csCurrentTeamId
28    csCurrentTeam.tsChannelSelectState .= emptyChannelSelectState tId
29    updateChannelSelectMatches
30
31    -- Preserve the current channel selection when initializing channel
32    -- selection mode
33    zipper <- use (csCurrentTeam.tsFocus)
34    let isCurrentFocus m = Just (matchEntry m) == Z.focus zipper
35    csCurrentTeam.tsChannelSelectState.channelSelectMatches %= Z.findRight isCurrentFocus
36
37-- Select the next match in channel selection mode.
38channelSelectNext :: MH ()
39channelSelectNext = updateSelectedMatch Z.right
40
41-- Select the previous match in channel selection mode.
42channelSelectPrevious :: MH ()
43channelSelectPrevious = updateSelectedMatch Z.left
44
45updateChannelSelectMatches :: MH ()
46updateChannelSelectMatches = do
47    st <- use id
48
49    input <- use (csCurrentTeam.tsChannelSelectState.channelSelectInput)
50    cconfig <- use csClientConfig
51    prefs <- use (csResources.crUserPreferences)
52
53    let pat = parseChannelSelectPattern $ T.concat $ getEditContents input
54        chanNameMatches e = case pat of
55            Nothing -> const Nothing
56            Just p -> applySelectPattern p e
57        patTy = case pat of
58            Nothing -> Nothing
59            Just CSPAny -> Nothing
60            Just (CSP ty _) -> Just ty
61
62    let chanMatches e chan =
63            if patTy == Just PrefixDMOnly
64            then Nothing
65            else if chan^.ccInfo.cdType /= MM.Group
66                 then chanNameMatches e $ chan^.ccInfo.cdDisplayName
67                 else Nothing
68        groupChanMatches e chan =
69            if patTy == Just PrefixNonDMOnly
70            then Nothing
71            else if chan^.ccInfo.cdType == MM.Group
72                 then chanNameMatches e $ chan^.ccInfo.cdDisplayName
73                 else Nothing
74        displayName uInfo = displayNameForUser uInfo cconfig prefs
75        userMatches e uInfo =
76            if patTy == Just PrefixNonDMOnly
77            then Nothing
78            else (chanNameMatches e . displayName) uInfo
79        matches e =
80            let cId = channelListEntryChannelId e
81            in case channelListEntryType e of
82                CLChannel    -> findChannelById cId (st^.csChannels) >>= chanMatches e
83                CLUserDM uId -> userById uId st >>= userMatches e
84                CLGroupDM    -> findChannelById cId (st^.csChannels) >>= groupChanMatches e
85
86        preserveFocus Nothing _ = False
87        preserveFocus (Just m) m2 = matchEntry m == matchEntry m2
88
89    csCurrentTeam.tsChannelSelectState.channelSelectMatches %=
90        (Z.updateListBy preserveFocus $ Z.toList $ Z.maybeMapZipper matches (st^.csCurrentTeam.tsFocus))
91
92applySelectPattern :: ChannelSelectPattern -> ChannelListEntry -> Text -> Maybe ChannelSelectMatch
93applySelectPattern CSPAny entry chanName = do
94    return $ ChannelSelectMatch "" "" chanName chanName entry
95applySelectPattern (CSP ty pat) entry chanName = do
96    let applyType Infix | pat `T.isInfixOf` normalizedChanName =
97            case T.breakOn pat normalizedChanName of
98                (pre, _) ->
99                    return ( T.take (T.length pre) chanName
100                           , T.take (T.length pat) $ T.drop (T.length pre) chanName
101                           , T.drop (T.length pat + T.length pre) chanName
102                           )
103
104        applyType Prefix | pat `T.isPrefixOf` normalizedChanName = do
105            let (b, a) = T.splitAt (T.length pat) chanName
106            return ("", b, a)
107
108        applyType PrefixDMOnly | pat `T.isPrefixOf` normalizedChanName = do
109            let (b, a) = T.splitAt (T.length pat) chanName
110            return ("", b, a)
111
112        applyType PrefixNonDMOnly | pat `T.isPrefixOf` normalizedChanName = do
113            let (b, a) = T.splitAt (T.length pat) chanName
114            return ("", b, a)
115
116        applyType Suffix | pat `T.isSuffixOf` normalizedChanName = do
117            let (b, a) = T.splitAt (T.length chanName - T.length pat) chanName
118            return (b, a, "")
119
120        applyType Equal  | pat == normalizedChanName =
121            return ("", chanName, "")
122
123        applyType _ = Nothing
124
125        caseSensitive = T.any isUpper pat
126        normalizedChanName = if caseSensitive
127                             then chanName
128                             else T.toLower chanName
129
130    (pre, m, post) <- applyType ty
131    return $ ChannelSelectMatch pre m post chanName entry
132
133parseChannelSelectPattern :: Text -> Maybe ChannelSelectPattern
134parseChannelSelectPattern "" = return CSPAny
135parseChannelSelectPattern pat = do
136    let only = if | userSigil `T.isPrefixOf` pat -> Just $ CSP PrefixDMOnly $ T.tail pat
137                  | normalChannelSigil `T.isPrefixOf` pat -> Just $ CSP PrefixNonDMOnly $ T.tail pat
138                  | otherwise -> Nothing
139
140    (pat1, pfx) <- case "^" `T.isPrefixOf` pat of
141        True  -> return (T.tail pat, Just Prefix)
142        False -> return (pat, Nothing)
143
144    (pat2, sfx) <- case "$" `T.isSuffixOf` pat1 of
145        True  -> return (T.init pat1, Just Suffix)
146        False -> return (pat1, Nothing)
147
148    only <|> case (pfx, sfx) of
149        (Nothing, Nothing)         -> return $ CSP Infix  pat2
150        (Just Prefix, Nothing)     -> return $ CSP Prefix pat2
151        (Nothing, Just Suffix)     -> return $ CSP Suffix pat2
152        (Just Prefix, Just Suffix) -> return $ CSP Equal  pat2
153        tys                        -> error $ "BUG: invalid channel select case: " <> show tys
154
155-- Update the channel selection mode match cursor. The argument function
156-- determines how to navigate to the next item.
157updateSelectedMatch :: (Z.Zipper ChannelListGroup ChannelSelectMatch -> Z.Zipper ChannelListGroup ChannelSelectMatch)
158                    -> MH ()
159updateSelectedMatch nextItem =
160    csCurrentTeam.tsChannelSelectState.channelSelectMatches %= nextItem
161