module Matterhorn.State.ThemeListOverlay
  ( 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.ListOverlay
import           Matterhorn.Themes
import           Matterhorn.Types


-- | Show the user list overlay with the given search scope, and issue a
-- request to gather the first search results.
enterThemeListMode :: MH ()
enterThemeListMode :: MH ()
enterThemeListMode =
    Lens' ChatState (ListOverlayState InternalTheme ())
-> Mode
-> ()
-> (InternalTheme -> MH Bool)
-> (() -> Session -> Text -> IO (Vector InternalTheme))
-> MH ()
forall a b.
Lens' ChatState (ListOverlayState a b)
-> Mode
-> b
-> (a -> MH Bool)
-> (b -> Session -> Text -> IO (Vector a))
-> MH ()
enterListOverlayMode ((TeamState -> f TeamState) -> ChatState -> f ChatState
Lens' ChatState TeamState
csCurrentTeam((TeamState -> f TeamState) -> ChatState -> f ChatState)
-> ((ListOverlayState InternalTheme ()
     -> f (ListOverlayState InternalTheme ()))
    -> TeamState -> f TeamState)
-> (ListOverlayState InternalTheme ()
    -> f (ListOverlayState InternalTheme ()))
-> ChatState
-> f ChatState
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(ListOverlayState InternalTheme ()
 -> f (ListOverlayState InternalTheme ()))
-> TeamState -> f TeamState
Lens' TeamState (ListOverlayState InternalTheme ())
tsThemeListOverlay)
        Mode
ThemeListOverlay () InternalTheme -> MH Bool
setInternalTheme () -> Session -> Text -> IO (Vector InternalTheme)
getThemesMatching

-- | Move the selection up in the user list overlay by one user.
themeListSelectUp :: MH ()
themeListSelectUp :: MH ()
themeListSelectUp = (List Name InternalTheme -> List Name InternalTheme) -> MH ()
themeListMove List Name InternalTheme -> List Name InternalTheme
forall (t :: * -> *) n e.
(Foldable t, Splittable t) =>
GenericList n t e -> GenericList n t e
L.listMoveUp

-- | Move the selection down in the user list overlay by one user.
themeListSelectDown :: MH ()
themeListSelectDown :: MH ()
themeListSelectDown = (List Name InternalTheme -> List Name InternalTheme) -> MH ()
themeListMove List Name InternalTheme -> List Name InternalTheme
forall (t :: * -> *) n e.
(Foldable t, Splittable t) =>
GenericList n t e -> GenericList n t e
L.listMoveDown

-- | Move the selection up in the user list overlay by a page of users
-- (themeListPageSize).
themeListPageUp :: MH ()
themeListPageUp :: MH ()
themeListPageUp = (List Name InternalTheme -> List Name InternalTheme) -> MH ()
themeListMove (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))

-- | Move the selection down in the user list overlay by a page of users
-- (themeListPageSize).
themeListPageDown :: MH ()
themeListPageDown :: MH ()
themeListPageDown = (List Name InternalTheme -> List Name InternalTheme) -> MH ()
themeListMove (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)

-- | Transform the user list results in some way, e.g. by moving the
-- cursor, and then check to see whether the modification warrants a
-- prefetch of more search results.
themeListMove :: (L.List Name InternalTheme -> L.List Name InternalTheme) -> MH ()
themeListMove :: (List Name InternalTheme -> List Name InternalTheme) -> MH ()
themeListMove = Lens' ChatState (ListOverlayState InternalTheme ())
-> (List Name InternalTheme -> List Name InternalTheme) -> MH ()
forall a b.
Lens' ChatState (ListOverlayState a b)
-> (List Name a -> List Name a) -> MH ()
listOverlayMove ((TeamState -> f TeamState) -> ChatState -> f ChatState
Lens' ChatState TeamState
csCurrentTeam((TeamState -> f TeamState) -> ChatState -> f ChatState)
-> ((ListOverlayState InternalTheme ()
     -> f (ListOverlayState InternalTheme ()))
    -> TeamState -> f TeamState)
-> (ListOverlayState InternalTheme ()
    -> f (ListOverlayState InternalTheme ()))
-> ChatState
-> f ChatState
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(ListOverlayState InternalTheme ()
 -> f (ListOverlayState InternalTheme ()))
-> TeamState -> f TeamState
Lens' TeamState (ListOverlayState InternalTheme ())
tsThemeListOverlay)

-- | The number of users in a "page" for cursor movement purposes.
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 (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 :: InternalTheme -> MH Bool
setInternalTheme :: InternalTheme -> MH Bool
setInternalTheme InternalTheme
t = do
    Text -> MH ()
setTheme (Text -> MH ()) -> Text -> MH ()
forall a b. (a -> b) -> a -> b
$ InternalTheme -> Text
internalThemeName InternalTheme
t
    Bool -> MH Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False

setTheme :: Text -> MH ()
setTheme :: Text -> MH ()
setTheme Text
name =
    case Text -> Maybe InternalTheme
lookupTheme Text
name of
        Maybe InternalTheme
Nothing -> MH ()
enterThemeListMode
        Just InternalTheme
it -> do
            EventM Name () -> MH ()
forall a. EventM Name a -> MH a
mh EventM Name ()
forall n. Ord n => EventM n ()
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)