{-# Language OverloadedStrings #-}
{-|
Module      : Client.View.Windows
Description : View of the list of open windows
Copyright   : (c) Eric Mertens, 2016
License     : ISC
Maintainer  : emertens@gmail.com

This module implements the rendering of the client window list.

-}
module Client.View.Windows
  ( windowsImages
  ) where

import           Client.Image.Message (coloredIdentifier, IdentifierColorMode (NormalIdentifier))
import           Client.Image.PackedImage
import           Client.Image.Palette
import           Client.State
import           Client.State.Focus
import           Client.State.Window
import           Client.State.Network
import           Control.Lens
import qualified Data.HashMap.Strict as HashMap
import           Data.List
import           Data.Maybe (fromMaybe)
import qualified Data.Map as Map
import           Graphics.Vty.Attributes

-- | Draw the image lines associated with the @/windows@ command.
windowsImages :: WindowsFilter -> ClientState -> [Image']
windowsImages :: WindowsFilter -> ClientState -> [Image']
windowsImages WindowsFilter
filt ClientState
st
  = forall a. [a] -> [a]
reverse
  forall a b. (a -> b) -> a -> b
$ [[Image']] -> [Image']
createColumns
  forall a b. (a -> b) -> a -> b
$ [ Palette -> Image' -> Focus -> Window -> [Image']
renderWindowColumns Palette
pal (Attr -> Char -> Image'
char (forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Lens' Palette Attr
palError Palette
pal) Char
'h')    Focus
k Window
v | (Focus
k,Window
v) <- [(Focus, Window)]
hiddenWindows ] forall a. [a] -> [a] -> [a]
++
    [ Palette -> Image' -> Focus -> Window -> [Image']
renderWindowColumns Palette
pal (Attr -> Char -> Image'
char (forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Lens' Palette Attr
palWindowName Palette
pal) (Window -> Char
name Window
v)) Focus
k Window
v | (Focus
k,Window
v) <- [(Focus, Window)]
windows ]
  where
    pal :: Palette
pal = ClientState -> Palette
clientPalette ClientState
st
    name :: Window -> Char
name = forall a. a -> Maybe a -> a
fromMaybe Char
' ' forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Lens' Window (Maybe Char)
winName

    ([(Focus, Window)]
hiddenWindows, [(Focus, Window)]
windows)
      = forall a. (a -> Bool) -> [a] -> ([a], [a])
partition (forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view (forall s t a b. Field2 s t a b => Lens s t a b
_2 forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' Window Bool
winHidden))
      forall a b. (a -> b) -> a -> b
$ forall a. (a -> Bool) -> [a] -> [a]
filter (WindowsFilter -> ClientState -> Focus -> Bool
windowMatcher WindowsFilter
filt ClientState
st forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst)
      forall a b. (a -> b) -> a -> b
$ forall k a. Map k a -> [(k, a)]
Map.toAscList
      forall a b. (a -> b) -> a -> b
$ forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Lens' ClientState (Map Focus Window)
clientWindows ClientState
st

------------------------------------------------------------------------

windowMatcher :: WindowsFilter -> ClientState -> Focus -> Bool

windowMatcher :: WindowsFilter -> ClientState -> Focus -> Bool
windowMatcher WindowsFilter
AllWindows ClientState
_ Focus
_ = Bool
True

windowMatcher WindowsFilter
NetworkWindows ClientState
_ NetworkFocus{} = Bool
True

windowMatcher WindowsFilter
ChannelWindows ClientState
st (ChannelFocus Text
net Identifier
chan) =
  case forall s (m :: * -> *) a.
MonadReader s m =>
Getting (First a) s a -> m (Maybe a)
preview (forall (f :: * -> *).
Applicative f =>
Text -> LensLike' f ClientState NetworkState
clientConnection Text
net) ClientState
st of
    Just NetworkState
cs -> NetworkState -> Identifier -> Bool
isChannelIdentifier NetworkState
cs Identifier
chan
    Maybe NetworkState
Nothing -> Bool
True

windowMatcher WindowsFilter
UserWindows ClientState
st (ChannelFocus Text
net Identifier
chan) =
  case forall s (m :: * -> *) a.
MonadReader s m =>
Getting (First a) s a -> m (Maybe a)
preview (forall (f :: * -> *).
Applicative f =>
Text -> LensLike' f ClientState NetworkState
clientConnection Text
net) ClientState
st of
    Just NetworkState
cs -> Bool -> Bool
not (NetworkState -> Identifier -> Bool
isChannelIdentifier NetworkState
cs Identifier
chan)
    Maybe NetworkState
Nothing -> Bool
True

windowMatcher WindowsFilter
_ ClientState
_ Focus
_ = Bool
False

------------------------------------------------------------------------


renderWindowColumns :: Palette -> Image' -> Focus -> Window -> [Image']
renderWindowColumns :: Palette -> Image' -> Focus -> Window -> [Image']
renderWindowColumns Palette
pal Image'
name Focus
focus Window
win =
  [ Image'
name
  , Palette -> Focus -> Image'
renderedFocus Palette
pal Focus
focus
  , Palette -> Window -> Image'
renderedWindowInfo Palette
pal Window
win
  ]


createColumns :: [[Image']] -> [Image']
createColumns :: [[Image']] -> [Image']
createColumns [[Image']]
xs = forall a b. (a -> b) -> [a] -> [b]
map [Image'] -> Image'
makeRow [[Image']]
xs
  where
    columnWidths :: [Int]
columnWidths = forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map Image' -> Int
imageWidth forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. [[a]] -> [[a]]
transpose [[Image']]
xs
    makeRow :: [Image'] -> Image'
makeRow = forall a. Monoid a => [a] -> a
mconcat
            forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> [a] -> [a]
intersperse (Attr -> Char -> Image'
char Attr
defAttr Char
' ')
            forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith Int -> Image' -> Image'
resizeImage [Int]
columnWidths

renderedFocus :: Palette -> Focus -> Image'
renderedFocus :: Palette -> Focus -> Image'
renderedFocus Palette
pal Focus
focus =
  case Focus
focus of
    Focus
Unfocused ->
      Attr -> Char -> Image'
char (forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Lens' Palette Attr
palError Palette
pal) Char
'*'
    NetworkFocus Text
network ->
      Attr -> Text -> Image'
text' (forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Lens' Palette Attr
palLabel Palette
pal) Text
network
    ChannelFocus Text
network Identifier
channel ->
      Attr -> Text -> Image'
text' (forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Lens' Palette Attr
palLabel Palette
pal) Text
network forall a. Semigroup a => a -> a -> a
<>
      Attr -> Char -> Image'
char Attr
defAttr Char
':' forall a. Semigroup a => a -> a -> a
<>
      Palette
-> IdentifierColorMode
-> HashMap Identifier Highlight
-> Identifier
-> Image'
coloredIdentifier Palette
pal IdentifierColorMode
NormalIdentifier forall k v. HashMap k v
HashMap.empty Identifier
channel

renderedWindowInfo :: Palette -> Window -> Image'
renderedWindowInfo :: Palette -> Window -> Image'
renderedWindowInfo Palette
pal Window
win =
  Attr -> String -> Image'
string (forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view (Attr -> Const Attr Attr) -> Palette -> Const Attr Palette
newMsgAttrLens Palette
pal) (forall s (m :: * -> *) r a.
MonadReader s m =>
LensLike' (Const r) s a -> (a -> r) -> m r
views Lens' Window Int
winUnread forall a. Show a => a -> String
show Window
win) forall a. Semigroup a => a -> a -> a
<> Image'
"/" forall a. Semigroup a => a -> a -> a
<>
  Attr -> String -> Image'
string (forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Lens' Palette Attr
palActivity    Palette
pal) (forall s (m :: * -> *) r a.
MonadReader s m =>
LensLike' (Const r) s a -> (a -> r) -> m r
views Lens' Window Int
winTotal  forall a. Show a => a -> String
show Window
win) forall a. Semigroup a => a -> a -> a
<>
  case forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Lens' Window ActivityFilter
winActivityFilter Window
win of
    ActivityFilter
AFLoud -> forall a. Monoid a => a
mempty
    ActivityFilter
other -> Attr -> String -> Image'
string (forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Lens' Palette Attr
palMeta Palette
pal) (Char
' 'forall a. a -> [a] -> [a]
:forall a. Show a => a -> String
show ActivityFilter
other)
  where
    newMsgAttrLens :: (Attr -> Const Attr Attr) -> Palette -> Const Attr Palette
newMsgAttrLens =
      case forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Lens' Window WindowLineImportance
winMention Window
win of
        WindowLineImportance
WLImportant -> Lens' Palette Attr
palMention
        WindowLineImportance
_           -> Lens' Palette Attr
palActivity