{-# Language OverloadedStrings #-}
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
maskListImages ::
Char ->
Text ->
Identifier ->
Int ->
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