MaskList.hs

{-# 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.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           Data.Time
import           Graphics.Vty.Image
import           Irc.Identifier

-- | Render the lines used in a channel mask list
maskListImages ::
  Char        {- ^ Mask mode -} ->
  Text        {- ^ network   -} ->
  Identifier  {- ^ channel   -} ->
  ClientState -> [Image]
maskListImages mode network channel st =
  case mbEntries of
    Nothing      -> [text' (view palError pal) "Mask list not loaded"]
    Just entries -> maskListImages' entries st

  where
    pal = clientPalette st
    mbEntries = preview
                ( clientConnection network
                . csChannels . ix channel
                . chanLists . ix mode
                ) st

maskListImages' :: HashMap Text MaskListEntry -> ClientState -> [Image]
maskListImages' entries st = countImage : images
  where
    pal = clientPalette st

    countImage = text' (view palLabel pal) "Masks (visible/total): " <|>
                 string defAttr (show (length entryList)) <|>
                 char (view palLabel pal) '/' <|>
                 string defAttr (show (HashMap.size entries))

    matcher = clientMatcher st

    matcher' (mask,entry) = matcher mask || matcher (view maskListSetter entry)

    entryList = sortBy (flip (comparing (view (_2 . maskListTime))))
              $ filter matcher'
              $ HashMap.toList entries

    renderWhen = formatTime defaultTimeLocale " %F %T"

    (masks, whoWhens) = unzip entryList
    maskImages       = text' defAttr <$> masks
    maskColumnWidth  = maximum (imageWidth <$> maskImages) + 1
    paddedMaskImages = resizeWidth maskColumnWidth <$> maskImages
    width            = max 1 (view clientWidth st)

    images = [ cropLine $ mask <|>
                          text' defAttr who <|>
                          string defAttr (renderWhen when)
             | (mask, MaskListEntry who when) <- zip paddedMaskImages whoWhens ]

    cropLine img
      | imageWidth img > width = cropRight width img
      | otherwise              = img