{-# 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.Focus (focusLabel, FocusLabelType(FocusLabelShort))
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           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
  = [Image'] -> [Image']
forall a. [a] -> [a]
reverse
  ([Image'] -> [Image']) -> [Image'] -> [Image']
forall a b. (a -> b) -> a -> b
$ [[Image']] -> [Image']
createColumns
  ([[Image']] -> [Image']) -> [[Image']] -> [Image']
forall a b. (a -> b) -> a -> b
$ [ ClientState -> Image' -> Focus -> Window -> [Image']
renderWindowColumns ClientState
st (Attr -> Char -> Image'
char (Getting Attr Palette Attr -> Palette -> Attr
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Attr Palette Attr
Lens' Palette Attr
palError Palette
pal) Char
'h')    Focus
k Window
v | (Focus
k,Window
v) <- [(Focus, Window)]
hiddenWindows ] [[Image']] -> [[Image']] -> [[Image']]
forall a. [a] -> [a] -> [a]
++
    [ ClientState -> Image' -> Focus -> Window -> [Image']
renderWindowColumns ClientState
st (Attr -> Char -> Image'
char (Getting Attr Palette Attr -> Palette -> Attr
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Attr Palette Attr
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 = Char -> Maybe Char -> Char
forall a. a -> Maybe a -> a
fromMaybe Char
' ' (Maybe Char -> Char) -> (Window -> Maybe Char) -> Window -> Char
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getting (Maybe Char) Window (Maybe Char) -> Window -> Maybe Char
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting (Maybe Char) Window (Maybe Char)
Lens' Window (Maybe Char)
winName

    ([(Focus, Window)]
hiddenWindows, [(Focus, Window)]
windows)
      = ((Focus, Window) -> Bool)
-> [(Focus, Window)] -> ([(Focus, Window)], [(Focus, Window)])
forall a. (a -> Bool) -> [a] -> ([a], [a])
partition (Getting Bool (Focus, Window) Bool -> (Focus, Window) -> Bool
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view ((Window -> Const Bool Window)
-> (Focus, Window) -> Const Bool (Focus, Window)
forall s t a b. Field2 s t a b => Lens s t a b
Lens (Focus, Window) (Focus, Window) Window Window
_2 ((Window -> Const Bool Window)
 -> (Focus, Window) -> Const Bool (Focus, Window))
-> ((Bool -> Const Bool Bool) -> Window -> Const Bool Window)
-> Getting Bool (Focus, Window) Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Bool -> Const Bool Bool) -> Window -> Const Bool Window
Lens' Window Bool
winHidden))
      ([(Focus, Window)] -> ([(Focus, Window)], [(Focus, Window)]))
-> [(Focus, Window)] -> ([(Focus, Window)], [(Focus, Window)])
forall a b. (a -> b) -> a -> b
$ ((Focus, Window) -> Bool) -> [(Focus, Window)] -> [(Focus, Window)]
forall a. (a -> Bool) -> [a] -> [a]
filter (WindowsFilter -> ClientState -> Focus -> Bool
windowMatcher WindowsFilter
filt ClientState
st (Focus -> Bool)
-> ((Focus, Window) -> Focus) -> (Focus, Window) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Focus, Window) -> Focus
forall a b. (a, b) -> a
fst)
      ([(Focus, Window)] -> [(Focus, Window)])
-> [(Focus, Window)] -> [(Focus, Window)]
forall a b. (a -> b) -> a -> b
$ Map Focus Window -> [(Focus, Window)]
forall k a. Map k a -> [(k, a)]
Map.toAscList
      (Map Focus Window -> [(Focus, Window)])
-> Map Focus Window -> [(Focus, Window)]
forall a b. (a -> b) -> a -> b
$ Getting (Map Focus Window) ClientState (Map Focus Window)
-> ClientState -> Map Focus Window
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting (Map Focus Window) ClientState (Map Focus Window)
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 Getting (First NetworkState) ClientState NetworkState
-> ClientState -> Maybe NetworkState
forall s (m :: * -> *) a.
MonadReader s m =>
Getting (First a) s a -> m (Maybe a)
preview (Text -> Getting (First NetworkState) ClientState NetworkState
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 Getting (First NetworkState) ClientState NetworkState
-> ClientState -> Maybe NetworkState
forall s (m :: * -> *) a.
MonadReader s m =>
Getting (First a) s a -> m (Maybe a)
preview (Text -> Getting (First NetworkState) ClientState NetworkState
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 :: ClientState -> Image' -> Focus -> Window -> [Image']
renderWindowColumns :: ClientState -> Image' -> Focus -> Window -> [Image']
renderWindowColumns ClientState
st Image'
name Focus
focus Window
win =
  [ Image'
name
  , FocusLabelType -> ClientState -> Focus -> Image'
focusLabel FocusLabelType
FocusLabelShort ClientState
st Focus
focus
  , Palette -> Window -> Image'
renderedWindowInfo (ClientState -> Palette
clientPalette ClientState
st) Window
win
  ]

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

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