{-# 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.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
import           Irc.Identifier

-- | 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
$ [ Palette -> Image' -> Focus -> Window -> [Image']
renderWindowColumns Palette
pal (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]
++
    [ Palette -> Image' -> Focus -> Window -> [Image']
renderWindowColumns Palette
pal (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
_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 :: 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 = ([Image'] -> Image') -> [[Image']] -> [Image']
forall a b. (a -> b) -> [a] -> [b]
map [Image'] -> Image'
makeRow [[Image']]
xs
  where
    columnWidths :: [Int]
columnWidths = [Int] -> Int
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

renderedFocus :: Palette -> Focus -> Image'
renderedFocus :: Palette -> Focus -> Image'
renderedFocus Palette
pal Focus
focus =
  case Focus
focus of
    Focus
Unfocused ->
      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
'*'
    NetworkFocus Text
network ->
      Attr -> Text -> Image'
text' (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
palLabel Palette
pal) Text
network
    ChannelFocus Text
network Identifier
channel ->
      Attr -> Text -> Image'
text' (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
palLabel Palette
pal) Text
network Image' -> Image' -> Image'
forall a. Semigroup a => a -> a -> a
<>
      Attr -> Char -> Image'
char Attr
defAttr Char
':' Image' -> Image' -> Image'
forall a. Semigroup a => a -> a -> a
<>
      Attr -> Text -> Image'
text' (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
palLabel Palette
pal) (Identifier -> Text
idText Identifier
channel)

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
<>
  (if ((Bool -> Const Bool Bool) -> Window -> Const Bool Window)
-> Window -> Bool
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view (Bool -> Const Bool Bool) -> Window -> Const Bool Window
Lens' Window Bool
winSilent Window
win then Attr -> Text -> Image'
text' (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) Text
" silent" else Image'
forall a. Monoid a => a
mempty)
  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