{-# Language BangPatterns #-}
{-|
Module      : Client.View.Mentions
Description : Mentions view
Copyright   : (c) Eric Mertens, 2016
License     : ISC
Maintainer  : emertens@gmail.com

This module provides the lines that have been highlighted
across the client in sorted order.

-}
module Client.View.Mentions
  ( mentionsViewLines
  ) where

import           Client.Configuration (PaddingMode, configNickPadding)
import           Client.Message
import           Client.Image.Message
import           Client.Image.PackedImage
import           Client.Image.Palette (Palette)
import           Client.Image.StatusLine
import           Client.State
import           Client.State.Focus
import           Client.State.Window
import           Control.Lens
import qualified Data.Map as Map
import           Data.Time (UTCTime)

-- | Generate the list of message lines marked important ordered by
-- time. Each run of lines from the same channel will be grouped
-- together. Messages are headed by their window, network, and channel.
mentionsViewLines :: Int -> ClientState -> [Image']
mentionsViewLines :: Int -> ClientState -> [Image']
mentionsViewLines Int
w ClientState
st = Int -> ClientState -> [MentionLine] -> [Image']
addMarkers Int
w ClientState
st [MentionLine]
entries

  where
    detail :: Bool
detail = forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Lens' ClientState Bool
clientDetailView ClientState
st

    padAmt :: PaddingMode
padAmt = forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view (Lens' ClientState Configuration
clientConfig forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' Configuration PaddingMode
configNickPadding) ClientState
st
    palette :: Palette
palette = ClientState -> Palette
clientPalette ClientState
st

    filt :: [WindowLine] -> [WindowLine]
filt
      | ClientState -> Bool
clientIsFiltered ClientState
st = forall a. ClientState -> (a -> Text) -> [a] -> [a]
clientFilter ClientState
st (forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getter WindowLine Text
wlText)
      | Bool
otherwise           = forall a. (a -> Bool) -> [a] -> [a]
filter (\WindowLine
x -> WindowLineImportance
WLImportant forall a. Eq a => a -> a -> Bool
== forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Lens' WindowLine WindowLineImportance
wlImportance WindowLine
x)

    entries :: [MentionLine]
entries = [[MentionLine]] -> [MentionLine]
merge
              [([WindowLine] -> [WindowLine])
-> Palette
-> Int
-> PaddingMode
-> Bool
-> Focus
-> Window
-> [MentionLine]
windowEntries [WindowLine] -> [WindowLine]
filt Palette
palette Int
w PaddingMode
padAmt Bool
detail Focus
focus Window
v
              | (Focus
focus, Window
v) <- forall k a. Map k a -> [(k, a)]
Map.toList (forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Lens' ClientState (Map Focus Window)
clientWindows ClientState
st) ]


data MentionLine = MentionLine
  { MentionLine -> UTCTime
mlTimestamp  :: UTCTime  -- ^ message timestamp for sorting
  , MentionLine -> Focus
mlFocus      :: Focus    -- ^ associated window
  , MentionLine -> [Image']
mlImage      :: [Image'] -- ^ wrapped rendered lines
  }

-- | Insert channel name markers between messages from different channels
addMarkers ::
  Int           {- ^ draw width                        -} ->
  ClientState   {- ^ client state                      -} ->
  [MentionLine] {- ^ list of mentions in time order    -} ->
  [Image']      {- ^ mention images and channel labels -}
addMarkers :: Int -> ClientState -> [MentionLine] -> [Image']
addMarkers Int
_ ClientState
_ [] = []
addMarkers Int
w !ClientState
st (!MentionLine
ml : [MentionLine]
xs)
  = Focus -> Subfocus -> Int -> Bool -> ClientState -> Image'
minorStatusLineImage (MentionLine -> Focus
mlFocus MentionLine
ml) Subfocus
FocusMessages Int
w Bool
False ClientState
st
  forall a. a -> [a] -> [a]
: forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap MentionLine -> [Image']
mlImage (MentionLine
mlforall a. a -> [a] -> [a]
:[MentionLine]
same)
 forall a. [a] -> [a] -> [a]
++ Int -> ClientState -> [MentionLine] -> [Image']
addMarkers Int
w ClientState
st [MentionLine]
rest
  where
    isSame :: MentionLine -> Bool
isSame MentionLine
ml' = MentionLine -> Focus
mlFocus MentionLine
ml forall a. Eq a => a -> a -> Bool
== MentionLine -> Focus
mlFocus MentionLine
ml'

    ([MentionLine]
same,[MentionLine]
rest) = forall a. (a -> Bool) -> [a] -> ([a], [a])
span MentionLine -> Bool
isSame [MentionLine]
xs

windowEntries ::
  ([WindowLine] -> [WindowLine])
              {- ^ filter        -} ->
  Palette     {- ^ palette       -} ->
  Int         {- ^ draw columns  -} ->
  PaddingMode {- ^ nick padding  -} ->
  Bool        {- ^ detailed view -} ->
  Focus       {- ^ window focus  -} ->
  Window      {- ^ window        -} ->
  [MentionLine]
windowEntries :: ([WindowLine] -> [WindowLine])
-> Palette
-> Int
-> PaddingMode
-> Bool
-> Focus
-> Window
-> [MentionLine]
windowEntries [WindowLine] -> [WindowLine]
filt Palette
palette Int
w PaddingMode
padAmt Bool
detailed Focus
focus Window
win =
  [ MentionLine
      { mlTimestamp :: UTCTime
mlTimestamp  = forall s (m :: * -> *) r a.
MonadReader s m =>
LensLike' (Const r) s a -> (a -> r) -> m r
views Lens' WindowLine PackedTime
wlTimestamp PackedTime -> UTCTime
unpackUTCTime WindowLine
l
      , mlFocus :: Focus
mlFocus      = Focus
focus
      , mlImage :: [Image']
mlImage      = case Palette
-> IrcSummary -> Maybe (Image', Identifier, Maybe Identifier)
metadataImg Palette
palette (forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Lens' WindowLine IrcSummary
wlSummary WindowLine
l) of
                         Maybe (Image', Identifier, Maybe Identifier)
_ | Bool
detailed     -> [forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Lens' WindowLine Image'
wlFullImage WindowLine
l]
                         Just (Image'
img, Identifier
_, Maybe Identifier
_) -> [Image'
img]
                         Maybe (Image', Identifier, Maybe Identifier)
Nothing          -> Palette -> Int -> PaddingMode -> WindowLine -> [Image']
drawWindowLine Palette
palette Int
w PaddingMode
padAmt WindowLine
l
      }
  | WindowLine
l <- [WindowLine] -> [WindowLine]
filt forall a b. (a -> b) -> a -> b
$ [WindowLine] -> [WindowLine]
prefilt forall a b. (a -> b) -> a -> b
$ forall a s. Getting (Endo [a]) s a -> s -> [a]
toListOf (Lens' Window WindowLines
winMessages forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s t a b. Each s t a b => Traversal s t a b
each) Window
win
  ]
  where
    prefilt :: [WindowLine] -> [WindowLine]
prefilt
      | Bool
detailed  = forall a. a -> a
id
      | Bool
otherwise = forall a. (a -> Bool) -> [a] -> [a]
filter WindowLine -> Bool
isChat

    isChat :: WindowLine -> Bool
isChat WindowLine
msg =
      case forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Lens' WindowLine IrcSummary
wlSummary WindowLine
msg of
        ChatSummary{} -> Bool
True
        IrcSummary
_             -> Bool
False


-- | Merge a list of sorted lists of mention lines into a single sorted list
-- in descending order.
merge :: [[MentionLine]] -> [MentionLine]
merge :: [[MentionLine]] -> [MentionLine]
merge []  = []
merge [[MentionLine]
x] = [MentionLine]
x
merge [[MentionLine]]
xss = [[MentionLine]] -> [MentionLine]
merge ([[MentionLine]] -> [[MentionLine]]
merge2s [[MentionLine]]
xss)

merge2s :: [[MentionLine]] -> [[MentionLine]]
merge2s :: [[MentionLine]] -> [[MentionLine]]
merge2s ([MentionLine]
x:[MentionLine]
y:[[MentionLine]]
z) = [MentionLine] -> [MentionLine] -> [MentionLine]
merge2 [MentionLine]
x [MentionLine]
y forall a. a -> [a] -> [a]
: [[MentionLine]] -> [[MentionLine]]
merge2s [[MentionLine]]
z
merge2s [[MentionLine]]
xs      = [[MentionLine]]
xs

merge2 :: [MentionLine] -> [MentionLine] -> [MentionLine]
merge2 :: [MentionLine] -> [MentionLine] -> [MentionLine]
merge2 [] [MentionLine]
ys = [MentionLine]
ys
merge2 [MentionLine]
xs [] = [MentionLine]
xs
merge2 xxs :: [MentionLine]
xxs@(MentionLine
x:[MentionLine]
xs) yys :: [MentionLine]
yys@(MentionLine
y:[MentionLine]
ys)
  | MentionLine -> UTCTime
mlTimestamp MentionLine
x forall a. Ord a => a -> a -> Bool
>= MentionLine -> UTCTime
mlTimestamp MentionLine
y = MentionLine
x forall a. a -> [a] -> [a]
: [MentionLine] -> [MentionLine] -> [MentionLine]
merge2 [MentionLine]
xs [MentionLine]
yys
  | Bool
otherwise                      = MentionLine
y forall a. a -> [a] -> [a]
: [MentionLine] -> [MentionLine] -> [MentionLine]
merge2 [MentionLine]
xxs [MentionLine]
ys