{-# 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' (forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view 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 = 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
network
                forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' NetworkState (HashMap Identifier ChannelState)
csChannels forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall m. Ixed m => Index m -> Traversal' m (IxValue m)
ix Identifier
channel
                forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' ChannelState (Map Char (HashMap Text MaskListEntry))
chanLists forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall m. Ixed m => Index m -> Traversal' m (IxValue m)
ix Char
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 forall a. a -> [a] -> [a]
: [Image']
images
  where
    pal :: Palette
pal = ClientState -> Palette
clientPalette ClientState
st

    countImage :: Image'
countImage = 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
"Masks (visible/total): " forall a. Semigroup a => a -> a -> a
<>
                 Attr -> String -> Image'
string Attr
defAttr (forall a. Show a => a -> String
show (forall (t :: * -> *) a. Foldable t => t a -> Int
length [(Text, MaskListEntry)]
entryList)) forall a. Semigroup a => a -> a -> a
<>
                 Attr -> Char -> Image'
char (forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Lens' Palette Attr
palLabel Palette
pal) Char
'/' forall a. Semigroup a => a -> a -> a
<>
                 Attr -> String -> Image'
string Attr
defAttr (forall a. Show a => a -> String
show (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
" ", forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Lens' MaskListEntry Text
maskListSetter MaskListEntry
entry]

    entryList :: [(Text, MaskListEntry)]
entryList = forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy (forall a b c. (a -> b -> c) -> b -> a -> c
flip (forall a b. Ord a => (b -> a) -> b -> b -> Ordering
comparing (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' MaskListEntry UTCTime
maskListTime))))
              forall a b. (a -> b) -> a -> b
$ forall a. ClientState -> (a -> Text) -> [a] -> [a]
clientFilter ClientState
st (Text, MaskListEntry) -> Text
filterOn
              forall a b. (a -> b) -> a -> b
$ forall k v. HashMap k v -> [(k, v)]
HashMap.toList HashMap Text MaskListEntry
entries

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

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

    images :: [Image']
images = [ Image' -> Image'
cropLine forall a b. (a -> b) -> a -> b
$ Image'
mask forall a. Semigroup a => a -> a -> a
<>
                          Attr -> Text -> Image'
text' Attr
defAttr Text
who 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) <- forall a b. [a] -> [b] -> [(a, b)]
zip [Image']
paddedMaskImages [MaskListEntry]
whoWhens ]

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