{-# 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 = Getting Bool ClientState Bool -> ClientState -> Bool
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Bool ClientState Bool
Lens' ClientState Bool
clientDetailView ClientState
st

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

    filt :: [WindowLine] -> [WindowLine]
filt
      | ClientState -> Bool
clientIsFiltered ClientState
st = ClientState -> (WindowLine -> Text) -> [WindowLine] -> [WindowLine]
forall a. ClientState -> (a -> Text) -> [a] -> [a]
clientFilter ClientState
st (Getting Text WindowLine Text -> WindowLine -> Text
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Text WindowLine Text
Getter WindowLine Text
wlText)
      | Bool
otherwise           = (WindowLine -> Bool) -> [WindowLine] -> [WindowLine]
forall a. (a -> Bool) -> [a] -> [a]
filter (\WindowLine
x -> WindowLineImportance
WLImportant WindowLineImportance -> WindowLineImportance -> Bool
forall a. Eq a => a -> a -> Bool
== Getting WindowLineImportance WindowLine WindowLineImportance
-> WindowLine -> WindowLineImportance
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting WindowLineImportance WindowLine WindowLineImportance
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) <- Map Focus Window -> [(Focus, Window)]
forall k a. Map k a -> [(k, a)]
Map.toList (Getting (Map Focus Window) ClientState (Map Focus Window)
-> ClientState -> Map Focus Window
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting (Map Focus Window) ClientState (Map Focus Window)
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
  Image' -> [Image'] -> [Image']
forall a. a -> [a] -> [a]
: (MentionLine -> [Image']) -> [MentionLine] -> [Image']
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap MentionLine -> [Image']
mlImage (MentionLine
mlMentionLine -> [MentionLine] -> [MentionLine]
forall a. a -> [a] -> [a]
:[MentionLine]
same)
 [Image'] -> [Image'] -> [Image']
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 Focus -> Focus -> Bool
forall a. Eq a => a -> a -> Bool
== MentionLine -> Focus
mlFocus MentionLine
ml'

    ([MentionLine]
same,[MentionLine]
rest) = (MentionLine -> Bool)
-> [MentionLine] -> ([MentionLine], [MentionLine])
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 :: UTCTime -> Focus -> [Image'] -> MentionLine
MentionLine
      { mlTimestamp :: UTCTime
mlTimestamp  = LensLike' (Const UTCTime) WindowLine PackedTime
-> (PackedTime -> UTCTime) -> WindowLine -> UTCTime
forall s (m :: * -> *) r a.
MonadReader s m =>
LensLike' (Const r) s a -> (a -> r) -> m r
views LensLike' (Const UTCTime) WindowLine PackedTime
Lens' WindowLine PackedTime
wlTimestamp PackedTime -> UTCTime
unpackUTCTime WindowLine
l
      , mlFocus :: Focus
mlFocus      = Focus
focus
      , mlImage :: [Image']
mlImage      = case IrcSummary -> Maybe (Image', Identifier, Maybe Identifier)
metadataImg (Getting IrcSummary WindowLine IrcSummary
-> WindowLine -> IrcSummary
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting IrcSummary WindowLine IrcSummary
Lens' WindowLine IrcSummary
wlSummary WindowLine
l) of
                         Maybe (Image', Identifier, Maybe Identifier)
_ | Bool
detailed     -> [Getting Image' WindowLine Image' -> WindowLine -> Image'
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Image' WindowLine Image'
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 ([WindowLine] -> [WindowLine]) -> [WindowLine] -> [WindowLine]
forall a b. (a -> b) -> a -> b
$ [WindowLine] -> [WindowLine]
prefilt ([WindowLine] -> [WindowLine]) -> [WindowLine] -> [WindowLine]
forall a b. (a -> b) -> a -> b
$ Getting (Endo [WindowLine]) Window WindowLine
-> Window -> [WindowLine]
forall a s. Getting (Endo [a]) s a -> s -> [a]
toListOf ((WindowLines -> Const (Endo [WindowLine]) WindowLines)
-> Window -> Const (Endo [WindowLine]) Window
Lens' Window WindowLines
winMessages ((WindowLines -> Const (Endo [WindowLine]) WindowLines)
 -> Window -> Const (Endo [WindowLine]) Window)
-> ((WindowLine -> Const (Endo [WindowLine]) WindowLine)
    -> WindowLines -> Const (Endo [WindowLine]) WindowLines)
-> Getting (Endo [WindowLine]) Window WindowLine
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (WindowLine -> Const (Endo [WindowLine]) WindowLine)
-> WindowLines -> Const (Endo [WindowLine]) WindowLines
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  = [WindowLine] -> [WindowLine]
forall a. a -> a
id
      | Bool
otherwise = (WindowLine -> Bool) -> [WindowLine] -> [WindowLine]
forall a. (a -> Bool) -> [a] -> [a]
filter WindowLine -> Bool
isChat

    isChat :: WindowLine -> Bool
isChat WindowLine
msg =
      case Getting IrcSummary WindowLine IrcSummary
-> WindowLine -> IrcSummary
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting IrcSummary WindowLine IrcSummary
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 [MentionLine] -> [[MentionLine]] -> [[MentionLine]]
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 UTCTime -> UTCTime -> Bool
forall a. Ord a => a -> a -> Bool
>= MentionLine -> UTCTime
mlTimestamp MentionLine
y = MentionLine
x MentionLine -> [MentionLine] -> [MentionLine]
forall a. a -> [a] -> [a]
: [MentionLine] -> [MentionLine] -> [MentionLine]
merge2 [MentionLine]
xs [MentionLine]
yys
  | Bool
otherwise                      = MentionLine
y MentionLine -> [MentionLine] -> [MentionLine]
forall a. a -> [a] -> [a]
: [MentionLine] -> [MentionLine] -> [MentionLine]
merge2 [MentionLine]
xxs [MentionLine]
ys