{-# Language OverloadedStrings #-}
{-|
Module      : Client.View.MaskList
Description : Line renderers for channel mask list view
Copyright   : (c) Eric Mertens, 2016
License     : ISC
Maintainer  : emertens@gmail.com

This module renders the lines used in the channel mask list. A mask list
can show channel bans, quiets, invites, and exceptions.
-}
module Client.View.MaskList
  ( maskListImages
  ) where

import           Client.Image.PackedImage
import           Client.Image.Palette
import           Client.State
import           Client.State.Channel
import           Client.State.Network
import           Control.Lens
import           Data.HashMap.Strict (HashMap)
import qualified Data.HashMap.Strict as HashMap
import           Data.List
import           Data.Ord
import           Data.Text (Text)
import qualified Data.Text.Lazy as LText
import           Data.Time
import           Graphics.Vty.Attributes
import           Irc.Identifier

-- | Render the lines used in a channel mask list
maskListImages ::
  Char        {- ^ Mask mode  -} ->
  Text        {- ^ network    -} ->
  Identifier  {- ^ channel    -} ->
  Int         {- ^ draw width -} ->
  ClientState -> [Image']
maskListImages :: Char -> Text -> Identifier -> Int -> ClientState -> [Image']
maskListImages Char
mode Text
network Identifier
channel Int
w ClientState
st =
  case Maybe (HashMap Text MaskListEntry)
mbEntries of
    Maybe (HashMap Text MaskListEntry)
Nothing      -> [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
palError Palette
pal) Text
"Mask list not loaded"]
    Just HashMap Text MaskListEntry
entries -> HashMap Text MaskListEntry -> Int -> ClientState -> [Image']
maskListImages' HashMap Text MaskListEntry
entries Int
w ClientState
st

  where
    pal :: Palette
pal = ClientState -> Palette
clientPalette ClientState
st
    mbEntries :: Maybe (HashMap Text MaskListEntry)
mbEntries = Getting
  (First (HashMap Text MaskListEntry))
  ClientState
  (HashMap Text MaskListEntry)
-> ClientState -> Maybe (HashMap Text MaskListEntry)
forall s (m :: * -> *) a.
MonadReader s m =>
Getting (First a) s a -> m (Maybe a)
preview
                ( Text
-> LensLike'
     (Const (First (HashMap Text MaskListEntry)))
     ClientState
     NetworkState
forall (f :: * -> *).
Applicative f =>
Text -> LensLike' f ClientState NetworkState
clientConnection Text
network
                LensLike'
  (Const (First (HashMap Text MaskListEntry)))
  ClientState
  NetworkState
-> ((HashMap Text MaskListEntry
     -> Const
          (First (HashMap Text MaskListEntry)) (HashMap Text MaskListEntry))
    -> NetworkState
    -> Const (First (HashMap Text MaskListEntry)) NetworkState)
-> Getting
     (First (HashMap Text MaskListEntry))
     ClientState
     (HashMap Text MaskListEntry)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (HashMap Identifier ChannelState
 -> Const
      (First (HashMap Text MaskListEntry))
      (HashMap Identifier ChannelState))
-> NetworkState
-> Const (First (HashMap Text MaskListEntry)) NetworkState
Lens' NetworkState (HashMap Identifier ChannelState)
csChannels ((HashMap Identifier ChannelState
  -> Const
       (First (HashMap Text MaskListEntry))
       (HashMap Identifier ChannelState))
 -> NetworkState
 -> Const (First (HashMap Text MaskListEntry)) NetworkState)
-> ((HashMap Text MaskListEntry
     -> Const
          (First (HashMap Text MaskListEntry)) (HashMap Text MaskListEntry))
    -> HashMap Identifier ChannelState
    -> Const
         (First (HashMap Text MaskListEntry))
         (HashMap Identifier ChannelState))
-> (HashMap Text MaskListEntry
    -> Const
         (First (HashMap Text MaskListEntry)) (HashMap Text MaskListEntry))
-> NetworkState
-> Const (First (HashMap Text MaskListEntry)) NetworkState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Index (HashMap Identifier ChannelState)
-> Traversal'
     (HashMap Identifier ChannelState)
     (IxValue (HashMap Identifier ChannelState))
forall m. Ixed m => Index m -> Traversal' m (IxValue m)
ix Identifier
Index (HashMap Identifier ChannelState)
channel
                ((ChannelState
  -> Const (First (HashMap Text MaskListEntry)) ChannelState)
 -> HashMap Identifier ChannelState
 -> Const
      (First (HashMap Text MaskListEntry))
      (HashMap Identifier ChannelState))
-> ((HashMap Text MaskListEntry
     -> Const
          (First (HashMap Text MaskListEntry)) (HashMap Text MaskListEntry))
    -> ChannelState
    -> Const (First (HashMap Text MaskListEntry)) ChannelState)
-> (HashMap Text MaskListEntry
    -> Const
         (First (HashMap Text MaskListEntry)) (HashMap Text MaskListEntry))
-> HashMap Identifier ChannelState
-> Const
     (First (HashMap Text MaskListEntry))
     (HashMap Identifier ChannelState)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Map Char (HashMap Text MaskListEntry)
 -> Const
      (First (HashMap Text MaskListEntry))
      (Map Char (HashMap Text MaskListEntry)))
-> ChannelState
-> Const (First (HashMap Text MaskListEntry)) ChannelState
Lens' ChannelState (Map Char (HashMap Text MaskListEntry))
chanLists ((Map Char (HashMap Text MaskListEntry)
  -> Const
       (First (HashMap Text MaskListEntry))
       (Map Char (HashMap Text MaskListEntry)))
 -> ChannelState
 -> Const (First (HashMap Text MaskListEntry)) ChannelState)
-> ((HashMap Text MaskListEntry
     -> Const
          (First (HashMap Text MaskListEntry)) (HashMap Text MaskListEntry))
    -> Map Char (HashMap Text MaskListEntry)
    -> Const
         (First (HashMap Text MaskListEntry))
         (Map Char (HashMap Text MaskListEntry)))
-> (HashMap Text MaskListEntry
    -> Const
         (First (HashMap Text MaskListEntry)) (HashMap Text MaskListEntry))
-> ChannelState
-> Const (First (HashMap Text MaskListEntry)) ChannelState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Index (Map Char (HashMap Text MaskListEntry))
-> Traversal'
     (Map Char (HashMap Text MaskListEntry))
     (IxValue (Map Char (HashMap Text MaskListEntry)))
forall m. Ixed m => Index m -> Traversal' m (IxValue m)
ix Char
Index (Map Char (HashMap Text MaskListEntry))
mode
                ) ClientState
st

maskListImages' :: HashMap Text MaskListEntry -> Int -> ClientState -> [Image']
maskListImages' :: HashMap Text MaskListEntry -> Int -> ClientState -> [Image']
maskListImages' HashMap Text MaskListEntry
entries Int
w ClientState
st = Image'
countImage Image' -> [Image'] -> [Image']
forall a. a -> [a] -> [a]
: [Image']
images
  where
    pal :: Palette
pal = ClientState -> Palette
clientPalette ClientState
st

    countImage :: Image'
countImage = 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
"Masks (visible/total): " Image' -> Image' -> Image'
forall a. Semigroup a => a -> a -> a
<>
                 Attr -> String -> Image'
string Attr
defAttr (Int -> String
forall a. Show a => a -> String
show ([(Text, MaskListEntry)] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [(Text, MaskListEntry)]
entryList)) Image' -> Image' -> Image'
forall a. Semigroup a => a -> a -> a
<>
                 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
palLabel Palette
pal) Char
'/' Image' -> Image' -> Image'
forall a. Semigroup a => a -> a -> a
<>
                 Attr -> String -> Image'
string Attr
defAttr (Int -> String
forall a. Show a => a -> String
show (HashMap Text MaskListEntry -> Int
forall k v. HashMap k v -> Int
HashMap.size HashMap Text MaskListEntry
entries))

    filterOn :: (Text, MaskListEntry) -> Text
filterOn (Text
mask,MaskListEntry
entry) = [Text] -> Text
LText.fromChunks [Text
mask, Text
" ", Getting Text MaskListEntry Text -> MaskListEntry -> Text
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Text MaskListEntry Text
Lens' MaskListEntry Text
maskListSetter MaskListEntry
entry]

    entryList :: [(Text, MaskListEntry)]
entryList = ((Text, MaskListEntry) -> (Text, MaskListEntry) -> Ordering)
-> [(Text, MaskListEntry)] -> [(Text, MaskListEntry)]
forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy (((Text, MaskListEntry) -> (Text, MaskListEntry) -> Ordering)
-> (Text, MaskListEntry) -> (Text, MaskListEntry) -> Ordering
forall a b c. (a -> b -> c) -> b -> a -> c
flip (((Text, MaskListEntry) -> UTCTime)
-> (Text, MaskListEntry) -> (Text, MaskListEntry) -> Ordering
forall a b. Ord a => (b -> a) -> b -> b -> Ordering
comparing (Getting UTCTime (Text, MaskListEntry) UTCTime
-> (Text, MaskListEntry) -> UTCTime
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view ((MaskListEntry -> Const UTCTime MaskListEntry)
-> (Text, MaskListEntry) -> Const UTCTime (Text, MaskListEntry)
forall s t a b. Field2 s t a b => Lens s t a b
_2 ((MaskListEntry -> Const UTCTime MaskListEntry)
 -> (Text, MaskListEntry) -> Const UTCTime (Text, MaskListEntry))
-> ((UTCTime -> Const UTCTime UTCTime)
    -> MaskListEntry -> Const UTCTime MaskListEntry)
-> Getting UTCTime (Text, MaskListEntry) UTCTime
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (UTCTime -> Const UTCTime UTCTime)
-> MaskListEntry -> Const UTCTime MaskListEntry
Lens' MaskListEntry UTCTime
maskListTime))))
              ([(Text, MaskListEntry)] -> [(Text, MaskListEntry)])
-> [(Text, MaskListEntry)] -> [(Text, MaskListEntry)]
forall a b. (a -> b) -> a -> b
$ ClientState
-> ((Text, MaskListEntry) -> Text)
-> [(Text, MaskListEntry)]
-> [(Text, MaskListEntry)]
forall a. ClientState -> (a -> Text) -> [a] -> [a]
clientFilter ClientState
st (Text, MaskListEntry) -> Text
filterOn
              ([(Text, MaskListEntry)] -> [(Text, MaskListEntry)])
-> [(Text, MaskListEntry)] -> [(Text, MaskListEntry)]
forall a b. (a -> b) -> a -> b
$ HashMap Text MaskListEntry -> [(Text, MaskListEntry)]
forall k v. HashMap k v -> [(k, v)]
HashMap.toList HashMap Text MaskListEntry
entries

    renderWhen :: UTCTime -> String
renderWhen = TimeLocale -> String -> UTCTime -> String
forall t. FormatTime t => TimeLocale -> String -> t -> String
formatTime TimeLocale
defaultTimeLocale String
" %F %T"

    ([Text]
masks, [MaskListEntry]
whoWhens) = [(Text, MaskListEntry)] -> ([Text], [MaskListEntry])
forall a b. [(a, b)] -> ([a], [b])
unzip [(Text, MaskListEntry)]
entryList
    maskImages :: [Image']
maskImages       = Attr -> Text -> Image'
text' Attr
defAttr (Text -> Image') -> [Text] -> [Image']
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Text]
masks
    maskColumnWidth :: Int
maskColumnWidth  = [Int] -> Int
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum (Image' -> Int
imageWidth (Image' -> Int) -> [Image'] -> [Int]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Image']
maskImages) Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1
    paddedMaskImages :: [Image']
paddedMaskImages = Int -> Image' -> Image'
resizeImage Int
maskColumnWidth (Image' -> Image') -> [Image'] -> [Image']
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Image']
maskImages
    width :: Int
width            = Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
1 Int
w

    images :: [Image']
images = [ Image' -> Image'
cropLine (Image' -> Image') -> Image' -> Image'
forall a b. (a -> b) -> a -> b
$ Image'
mask Image' -> Image' -> Image'
forall a. Semigroup a => a -> a -> a
<>
                          Attr -> Text -> Image'
text' Attr
defAttr Text
who Image' -> Image' -> Image'
forall a. Semigroup a => a -> a -> a
<>
                          Attr -> String -> Image'
string Attr
defAttr (UTCTime -> String
renderWhen UTCTime
when)
             | (Image'
mask, MaskListEntry Text
who UTCTime
when) <- [Image'] -> [MaskListEntry] -> [(Image', MaskListEntry)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Image']
paddedMaskImages [MaskListEntry]
whoWhens ]

    cropLine :: Image' -> Image'
cropLine Image'
img
      | Image' -> Int
imageWidth Image'
img Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
width = Int -> Image' -> Image'
resizeImage Int
width Image'
img
      | Bool
otherwise              = Image'
img