module Matterhorn.State.ThemeListWindow
( enterThemeListMode
, themeListSelectDown
, themeListSelectUp
, themeListPageDown
, themeListPageUp
, setTheme
)
where
import Prelude ()
import Matterhorn.Prelude
import Brick ( invalidateCache )
import Brick.Themes ( themeToAttrMap )
import qualified Brick.Widgets.List as L
import qualified Data.Text as T
import qualified Data.Vector as Vec
import Lens.Micro.Platform ( (.=) )
import Network.Mattermost.Types
import Matterhorn.State.ListWindow
import Matterhorn.Themes
import Matterhorn.Types
enterThemeListMode :: TeamId -> MH ()
enterThemeListMode :: TeamId -> MH ()
enterThemeListMode TeamId
tId =
TeamId
-> Lens' ChatState (ListWindowState InternalTheme ())
-> Mode
-> ()
-> (InternalTheme -> MH Bool)
-> (() -> Session -> Text -> IO (Vector InternalTheme))
-> MH ()
forall a b.
TeamId
-> Lens' ChatState (ListWindowState a b)
-> Mode
-> b
-> (a -> MH Bool)
-> (b -> Session -> Text -> IO (Vector a))
-> MH ()
enterListWindowMode TeamId
tId (TeamId -> Lens' ChatState TeamState
csTeam(TeamId
tId)((TeamState -> f TeamState) -> ChatState -> f ChatState)
-> ((ListWindowState InternalTheme ()
-> f (ListWindowState InternalTheme ()))
-> TeamState -> f TeamState)
-> (ListWindowState InternalTheme ()
-> f (ListWindowState InternalTheme ()))
-> ChatState
-> f ChatState
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(ListWindowState InternalTheme ()
-> f (ListWindowState InternalTheme ()))
-> TeamState -> f TeamState
Lens' TeamState (ListWindowState InternalTheme ())
tsThemeListWindow)
Mode
ThemeListWindow () (TeamId -> InternalTheme -> MH Bool
setInternalTheme TeamId
tId) () -> Session -> Text -> IO (Vector InternalTheme)
getThemesMatching
themeListSelectUp :: TeamId -> MH ()
themeListSelectUp :: TeamId -> MH ()
themeListSelectUp TeamId
tId = TeamId
-> (List Name InternalTheme -> List Name InternalTheme) -> MH ()
themeListMove TeamId
tId List Name InternalTheme -> List Name InternalTheme
forall (t :: * -> *) n e.
(Foldable t, Splittable t) =>
GenericList n t e -> GenericList n t e
L.listMoveUp
themeListSelectDown :: TeamId -> MH ()
themeListSelectDown :: TeamId -> MH ()
themeListSelectDown TeamId
tId = TeamId
-> (List Name InternalTheme -> List Name InternalTheme) -> MH ()
themeListMove TeamId
tId List Name InternalTheme -> List Name InternalTheme
forall (t :: * -> *) n e.
(Foldable t, Splittable t) =>
GenericList n t e -> GenericList n t e
L.listMoveDown
themeListPageUp :: TeamId -> MH ()
themeListPageUp :: TeamId -> MH ()
themeListPageUp TeamId
tId = TeamId
-> (List Name InternalTheme -> List Name InternalTheme) -> MH ()
themeListMove TeamId
tId (Int -> List Name InternalTheme -> List Name InternalTheme
forall (t :: * -> *) n e.
(Foldable t, Splittable t) =>
Int -> GenericList n t e -> GenericList n t e
L.listMoveBy (-Int
1 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
themeListPageSize))
themeListPageDown :: TeamId -> MH ()
themeListPageDown :: TeamId -> MH ()
themeListPageDown TeamId
tId = TeamId
-> (List Name InternalTheme -> List Name InternalTheme) -> MH ()
themeListMove TeamId
tId (Int -> List Name InternalTheme -> List Name InternalTheme
forall (t :: * -> *) n e.
(Foldable t, Splittable t) =>
Int -> GenericList n t e -> GenericList n t e
L.listMoveBy Int
themeListPageSize)
themeListMove :: TeamId -> (L.List Name InternalTheme -> L.List Name InternalTheme) -> MH ()
themeListMove :: TeamId
-> (List Name InternalTheme -> List Name InternalTheme) -> MH ()
themeListMove TeamId
tId = Lens' ChatState (ListWindowState InternalTheme ())
-> (List Name InternalTheme -> List Name InternalTheme) -> MH ()
forall a b.
Lens' ChatState (ListWindowState a b)
-> (List Name a -> List Name a) -> MH ()
listWindowMove (TeamId -> Lens' ChatState TeamState
csTeam(TeamId
tId)((TeamState -> f TeamState) -> ChatState -> f ChatState)
-> ((ListWindowState InternalTheme ()
-> f (ListWindowState InternalTheme ()))
-> TeamState -> f TeamState)
-> (ListWindowState InternalTheme ()
-> f (ListWindowState InternalTheme ()))
-> ChatState
-> f ChatState
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(ListWindowState InternalTheme ()
-> f (ListWindowState InternalTheme ()))
-> TeamState -> f TeamState
Lens' TeamState (ListWindowState InternalTheme ())
tsThemeListWindow)
themeListPageSize :: Int
themeListPageSize :: Int
themeListPageSize = Int
10
getThemesMatching :: ()
-> Session
-> Text
-> IO (Vec.Vector InternalTheme)
getThemesMatching :: () -> Session -> Text -> IO (Vector InternalTheme)
getThemesMatching ()
_ Session
_ Text
searchString = do
let matching :: [InternalTheme]
matching = (InternalTheme -> Bool) -> [InternalTheme] -> [InternalTheme]
forall a. (a -> Bool) -> [a] -> [a]
filter InternalTheme -> Bool
matches [InternalTheme]
internalThemes
search :: Text
search = Text -> Text
T.toLower Text
searchString
matches :: InternalTheme -> Bool
matches InternalTheme
t = Text
search Text -> Text -> Bool
`T.isInfixOf` Text -> Text
T.toLower (InternalTheme -> Text
internalThemeName InternalTheme
t) Bool -> Bool -> Bool
||
Text
search Text -> Text -> Bool
`T.isInfixOf` Text -> Text
T.toLower (InternalTheme -> Text
internalThemeDesc InternalTheme
t)
Vector InternalTheme -> IO (Vector InternalTheme)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Vector InternalTheme -> IO (Vector InternalTheme))
-> Vector InternalTheme -> IO (Vector InternalTheme)
forall a b. (a -> b) -> a -> b
$ [InternalTheme] -> Vector InternalTheme
forall a. [a] -> Vector a
Vec.fromList [InternalTheme]
matching
setInternalTheme :: TeamId -> InternalTheme -> MH Bool
setInternalTheme :: TeamId -> InternalTheme -> MH Bool
setInternalTheme TeamId
tId InternalTheme
t = do
TeamId -> Text -> MH ()
setTheme TeamId
tId (Text -> MH ()) -> Text -> MH ()
forall a b. (a -> b) -> a -> b
$ InternalTheme -> Text
internalThemeName InternalTheme
t
Bool -> MH Bool
forall a. a -> MH a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
setTheme :: TeamId -> Text -> MH ()
setTheme :: TeamId -> Text -> MH ()
setTheme TeamId
tId Text
name =
case Text -> Maybe InternalTheme
lookupTheme Text
name of
Maybe InternalTheme
Nothing -> TeamId -> MH ()
enterThemeListMode TeamId
tId
Just InternalTheme
it -> do
EventM Name ChatState () -> MH ()
forall a. EventM Name ChatState a -> MH a
mh EventM Name ChatState ()
forall n s. Ord n => EventM n s ()
invalidateCache
(ChatResources -> Identity ChatResources)
-> ChatState -> Identity ChatState
Lens' ChatState ChatResources
csResources((ChatResources -> Identity ChatResources)
-> ChatState -> Identity ChatState)
-> ((AttrMap -> Identity AttrMap)
-> ChatResources -> Identity ChatResources)
-> (AttrMap -> Identity AttrMap)
-> ChatState
-> Identity ChatState
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(AttrMap -> Identity AttrMap)
-> ChatResources -> Identity ChatResources
Lens' ChatResources AttrMap
crTheme ((AttrMap -> Identity AttrMap) -> ChatState -> Identity ChatState)
-> AttrMap -> MH ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= (Theme -> AttrMap
themeToAttrMap (Theme -> AttrMap) -> Theme -> AttrMap
forall a b. (a -> b) -> a -> b
$ InternalTheme -> Theme
internalTheme InternalTheme
it)
(ChatResources -> Identity ChatResources)
-> ChatState -> Identity ChatState
Lens' ChatState ChatResources
csResources((ChatResources -> Identity ChatResources)
-> ChatState -> Identity ChatState)
-> ((Theme -> Identity Theme)
-> ChatResources -> Identity ChatResources)
-> (Theme -> Identity Theme)
-> ChatState
-> Identity ChatState
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Theme -> Identity Theme)
-> ChatResources -> Identity ChatResources
Lens' ChatResources Theme
crThemeOriginal ((Theme -> Identity Theme) -> ChatState -> Identity ChatState)
-> Theme -> MH ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= InternalTheme -> Theme
internalTheme InternalTheme
it