content: {-# Language OverloadedStrings, BangPatterns #-}
  {-|
  Module      : Client.Image.StatusLine
  Description : Renderer for status line
  Copyright   : (c) Eric Mertens, 2016
  License     : ISC
  Maintainer  : emertens@gmail.com
  
  This module provides image renderers used to construct
  the status image that sits between text input and the message
  window.
  
  -}
  module Client.Image.StatusLine
    ( statusLineImage
    , minorStatusLineImage
    , clientTitle
    ) where
  
  import Client.Image.Focus
  import Client.Image.Message (cleanChar, cleanText, modesImage)
  import Client.Image.PackedImage
  import Client.Image.Palette
  import Client.State
  import Client.State.Focus (focusNetwork, Focus(..), Subfocus(..), WindowsFilter(..))
  import Client.State.Help (hsQuery, HelpQuery (..))
  import Client.State.Network
  import Client.State.Window
  import Control.Lens (view, orOf, preview, views, _Just, Ixed(ix))
  import Data.Foldable (for_)
  import Data.Map.Strict qualified as Map
  import Data.Maybe (mapMaybe, maybeToList)
  import Data.Text (Text)
  import qualified Data.Text as Text
  import Data.Text.Lazy qualified as LText
  import Graphics.Vty.Attributes (Attr, defAttr, bold, withForeColor, withStyle, red)
  import Graphics.Vty.Image qualified as Vty
  import Irc.Identifier (idText, mkId)
  import Numeric (showFFloat)
  import Client.WhoReply (whoQuery)
  
  clientTitle :: ClientState -> String
  clientTitle st
    = map cleanChar
    $ LText.unpack
    $ "glirc - " <> imageText (currentViewImage False st (view clientSubfocus st) (view clientFocus st))
  
  bar :: Image'
  bar = char (withStyle defAttr bold) '─'
  
  
  -- | Renders the status line between messages and the textbox.
  statusLineImage ::
    Int         {- ^ draw width   -} ->
    ClientState {- ^ client state -} ->
    Vty.Image   {- ^ status bar   -}
  statusLineImage w st =
    makeLines w (common : activity ++ errorImgs)
    where
      focus = view clientFocus st
      common = Vty.horizCat $
        myNickImage st :
        map unpackImage
        [ infoBubble $ currentViewImage True st (view clientSubfocus st) focus
        , detailImage st
        , nometaImage focus st
        , scrollImage st
        , filterImage st
        , lockImage st
        , latency
        ]
  
      latency
        | view clientShowPing st = latencyImage st
        | otherwise              = mempty
  
      activity
        | view clientActivityBar st = activityBarImages st
        | otherwise                 = [activitySummary st]
  
      errorImgs =
        transientErrorImage <$> maybeToList (view clientErrorMsg st)
  
  
  -- Generates an error message notification image.
  transientErrorImage ::
    Text  {- ^ @error-message@           -} ->
    Vty.Image {- ^ @─[error: error-message]@ -}
  transientErrorImage txt =
    Vty.text' defAttr "─[" Vty.<|>
    Vty.text' (withForeColor defAttr red) "error: " Vty.<|>
    Vty.text' defAttr (cleanText txt) Vty.<|>
    Vty.text' defAttr "]"
  
  
  -- | The minor status line is used when rendering the @/splits@ and
  -- @/mentions@ views to show the associated window name.
  minorStatusLineImage ::
    Focus       {- ^ window name          -} ->
    Subfocus    {- ^ subfocus             -} ->
    Int         {- ^ draw width           -} ->
    Bool        {- ^ show hidemeta status -} ->
    ClientState {- ^ client state -} ->
    Image'
  minorStatusLineImage focus subfocus w showHideMeta st =
    content <> mconcat (replicate fillSize bar)
    where
      nometaImage' = if showHideMeta then nometaImage focus st else mempty
      content = infoBubble $ (currentViewImage True st subfocus focus <> nometaImage')
      fillSize = max 0 (w - imageWidth content)
  
  
  -- | Indicate when the client is scrolling and old messages are being shown.
  scrollImage :: ClientState -> Image'
  scrollImage st
    | 0 == view clientScroll st = mempty
    | otherwise = infoBubble (string attr "scroll")
    where
      pal  = clientPalette st
      attr = view palError pal
  
  
  -- | Indicate when the client is potentially showing a subset of the
  -- available chat messages.
  filterImage :: ClientState -> Image'
  filterImage st
    | clientIsFiltered st = infoBubble (string attr "filtered")
    | otherwise           = mempty
    where
      pal  = clientPalette st
      attr = view palError pal
  
  -- | Indicate when the client editor is locked
  lockImage :: ClientState -> Image'
  lockImage st
    | view clientEditLock st = infoBubble (string attr "locked")
    | otherwise              = mempty
    where
      pal  = clientPalette st
      attr = view palError pal
  
  
  -- | Indicate the current connection health. This will either indicate
  -- that the connection is being established or that a ping has been
  -- sent or long the previous ping round-trip was.
  latencyImage :: ClientState -> Image'
  latencyImage st = either id id $
  
    do network <- -- no network -> no image
         case views clientFocus focusNetwork st of
           Nothing  -> Left mempty
           Just net -> Right net
  
       cs <- -- detect when offline
         case preview (clientConnection network) st of
           Nothing -> Left (infoBubble (string (view palError pal) "offline"))
           Just cs -> Right cs
  
       -- render latency if one is stored
       for_ (view csLatency cs) $ \latency ->
         Left (latencyBubble (showFFloat (Just 2) (realToFrac latency :: Double) "s"))
  
       Right $ case view csPingStatus cs of
  
         PingSent {} -> latencyBubble "wait"
  
         PingConnecting n _ _ ->
           infoBubble (string (view palLatency pal) "connecting" <> retryImage n)
  
         PingNone -> mempty -- just connected no ping sent yet
  
    where
      pal           = clientPalette st
      latencyBubble = infoBubble . string (view palLatency pal)
  
      retryImage n
        | n > 0     = ": " <> string (view palLabel pal) ("retry " ++ show n)
        | otherwise = mempty
  
  
  -- | Wrap some text in parentheses to make it suitable for inclusion in the
  -- status line.
  infoBubble :: Image' -> Image'
  infoBubble img = bar <> "(" <> img <> ")"
  
  
  -- | Indicate that the client is in the /detailed/ view.
  detailImage :: ClientState -> Image'
  detailImage st
    | view clientDetailView st = infoBubble (string attr "detail")
    | otherwise = mempty
    where
      pal  = clientPalette st
      attr = view palLabel pal
  
  
  -- | Indicate that the client isn't showing the metadata lines in /normal/
  -- view.
  nometaImage :: Focus -> ClientState -> Image'
  nometaImage focus st
    | metaHidden = infoBubble (string attr "nometa")
    | otherwise  = mempty
    where
      pal        = clientPalette st
      attr       = view palLabel pal
      metaHidden = orOf (clientWindows . ix focus . winHideMeta) st
  
  -- | Image for little box with active window names:
  --
  -- @-[15p]@
  activitySummary :: ClientState -> Vty.Image
  activitySummary st
    | null indicators && anon == 0 = Vty.emptyImage
    | otherwise = unpackImage bar Vty.<|>
                  Vty.string defAttr "[" Vty.<|>
                  Vty.horizCat indicators Vty.<|>
                  anonImage Vty.<|>
                  Vty.string defAttr "]"
      where
        pal = clientPalette st
        (indicators, impanon, anon) = foldr aux ([], 0, 0) windows
        spacer
          | null indicators = Vty.string defAttr "+"
          | otherwise       = Vty.string defAttr " +"
        anonImage
          | anon == 0 = Vty.emptyImage
          | impanon == 0 = spacer Vty.<|>
                           Vty.string (view palActivity pal) (show anon)
          | otherwise = spacer Vty.<|>
                        Vty.string (view palMention pal) (show impanon) Vty.<|>
                        Vty.string defAttr "/" Vty.<|>
                        Vty.string (view palActivity pal) (show anon)
        windows    = views clientWindows Map.elems st
  
        aux :: Window -> ([Vty.Image], Int, Int) -> ([Vty.Image], Int, Int)
        aux w (indicators', impanon', anon') = case (view winName w, view winMention w) of
            (Nothing, WLImportant)   -> (indicators', impanon'+1, anon'+1)
            (Nothing, WLNormal)      -> (indicators', impanon', anon'+1)
            (Just name, WLImportant) -> (Vty.char (view palMention pal) name : indicators', impanon', anon')
            (Just name, WLNormal)    -> (Vty.char (view palActivity pal) name : indicators', impanon', anon')
            _                        -> (indicators', impanon', anon')
  
  -- | Multi-line activity information enabled by F3
  activityBarImages :: ClientState -> [Vty.Image]
  activityBarImages st
    = mapMaybe baraux
    $ Map.toAscList
    $ view clientWindows st
    where
      baraux pair@(_,w)
        | view winActivityFilter w == AFSilent = Nothing
        | n == 0 = Nothing -- todo: make configurable
        | otherwise = Just $
          unpackImage bar Vty.<|>
          Vty.char defAttr '[' Vty.<|>
          unpackImage (windowLabel' pair) Vty.<|>
          Vty.char defAttr ']'
        where
          windowLabel' = windowLabel st
          n = view winUnread w
  
  -- | Pack a list of images into a single image spanning possibly many lines.
  -- The images will stack upward with the first element of the list being in
  -- the bottom left corner of the image. Each line will have at least one
  -- of the component images in it, which might truncate that image in extreme
  -- cases.
  makeLines ::
    Int     {- ^ window width       -} ->
    [Vty.Image] {- ^ components to pack -} ->
    Vty.Image
  makeLines _ [] = Vty.emptyImage
  makeLines w (x:xs) = go x xs
    where
      go acc (y:ys)
        | let acc' = acc Vty.<|> y
        , Vty.imageWidth acc' <= w
        = go acc' ys
  
      go acc ys = makeLines w ys
          Vty.<-> Vty.cropRight w acc
          Vty.<|> unpackImage (mconcat (replicate fillsize bar))
        where
          fillsize = max 0 (w - Vty.imageWidth acc)
  
  myNickImage :: ClientState -> Vty.Image
  myNickImage st =
    case view clientFocus st of
      NetworkFocus network      -> nickPart network
      ChannelFocus network _    -> nickPart network
      Unfocused                 -> Vty.emptyImage
    where
      pal = clientPalette st
      netpal = clientNetworkPalette st
      nickPart network =
        case preview (clientConnection network) st of
          Nothing -> Vty.emptyImage
          Just cs -> Vty.text' attr (cleanText (idText nick))
             Vty.<|> parens defAttr
                       (unpackImage $
                        modesImage (view palModes pal) (view palUModes netpal) ('+':view csModes cs) <>
                        snomaskImage)
            where
              attr
                | view csAway cs = view palAway pal
                | otherwise      = defAttr
  
              nick = view csNick cs
  
              snomaskImage
                | null (view csSnomask cs) = ""
                | otherwise                = " " <>
                  modesImage (view palModes pal) (view palSnomask netpal) ('+':view csSnomask cs)
  
  parens :: Attr -> Vty.Image -> Vty.Image
  parens attr i = Vty.char attr '(' Vty.<|> i Vty.<|> Vty.char attr ')'
  
  currentViewImage :: Bool -> ClientState -> Subfocus -> Focus -> Image'
  currentViewImage showFull st subfocus focus =
    case subfocus of
      FocusMessages         -> windowName <> focusLabel labelType st focus
      FocusWindows filt     -> string defAttr "windows" <> opt (windowFilterName filt)
      FocusInfo net chan    -> string defAttr "info" <> ctxLabel (ChannelFocus net chan)
      FocusUsers net chan   -> string defAttr "names" <> ctxLabel (ChannelFocus net chan)
      FocusMentions         -> string defAttr "mentions"
      FocusPalette          -> string defAttr "palette"
      FocusDigraphs         -> string defAttr "digraphs"
      FocusKeyMap           -> string defAttr "keymap"
      FocusHelp             -> string defAttr "help" <> helpQuery
      FocusIgnoreList       -> string defAttr "ignores"
      FocusRtsStats         -> string defAttr "rtsstats"
      FocusCert{}           -> string defAttr "cert"
      FocusChanList net _ _ -> string defAttr "channels" <> ctxLabel (NetworkFocus net)
      FocusWho net          -> string defAttr "who" <> whoTarget net
      FocusMasks net chan m -> string defAttr "masks" <> maskLabel m <> ctxLabel (ChannelFocus net chan)
    where
      labelType = if showFull then FocusLabelLong else FocusLabelShort
      !pal = clientPalette st
      ctxLabel focus' = char defAttr ' ' <> focusLabel FocusLabelShort st focus'
      maskLabel m = char defAttr ' ' <> char (view palLabel pal) m
      opt = foldMap (\cmd -> char defAttr ' ' <>
                             text' (view palLabel pal) cmd)
      windowName
        | showFull = case preview (clientWindows . ix focus . winName . _Just) st of
            Just n -> char (view palWindowName pal) n <> ":"
            _      -> mempty
        | otherwise = mempty
      whoTarget net = case preview (clientConnection net . csWhoReply . whoQuery) st of
        Just (query, _) | Text.null query -> ctxLabel (NetworkFocus net)
        Just (query, _) -> ctxLabel (ChannelFocus net $ mkId query)
        _ -> mempty
      helpQuery = case view (clientHelp . hsQuery) st of
        HelpList ->
          mempty
        HelpCmd txt ->
          char defAttr ' ' <> text' defAttr txt
        HelpNet net txt ->
          char defAttr ' ' <> text' (view palLabel pal) (cleanText net) <> char defAttr ':' <> text' defAttr txt
        HelpNetPartial net txt _ ->
          char defAttr ' ' <> text' (view palLabel pal) (cleanText net) <> char defAttr ':' <> text' defAttr txt
  
  windowFilterName :: WindowsFilter -> Maybe Text
  windowFilterName x =
    case x of
      AllWindows     -> Nothing
      NetworkWindows -> Just "networks"
      ChannelWindows -> Just "channels"
      UserWindows    -> Just "users"
  