{-# Language OverloadedStrings #-}
{-|
Module      : Client.View.UrlSelection
Description : URL selection module
Copyright   : (c) Eric Mertens, 2016
License     : ISC
Maintainer  : emertens@gmail.com

This module provides a list of the URLs found in the current message
window in order to assist in selecting one to open with @/url@

-}
module Client.View.UrlSelection
  ( urlSelectionView
  ) where

import           Client.Configuration
import           Client.Image.Message
import           Client.Image.PackedImage
import           Client.Image.Palette
import           Client.Image.LineWrap
import           Client.State
import           Client.State.Focus
import           Client.State.Url
import           Control.Lens
import           Data.HashMap.Strict (HashMap)
import           Data.List (intersperse, foldl1')
import           Graphics.Vty.Attributes
import           Irc.Identifier
import           Text.Read (readMaybe)

-- | Generate the lines used for the view when typing @/url@
urlSelectionView ::
  Int         {- ^ render width        -} ->
  Focus       {- ^ window to search    -} ->
  String      {- ^ argument to command -} ->
  ClientState {- ^ client state        -} ->
  [Image']    {- ^ image lines         -}
urlSelectionView :: Int -> Focus -> String -> ClientState -> [Image']
urlSelectionView Int
w Focus
focus String
arg ClientState
st
  = [[Image']] -> [Image']
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
  ([[Image']] -> [Image']) -> [[Image']] -> [Image']
forall a b. (a -> b) -> a -> b
$ (Int -> UrlPair -> [Image']) -> [Int] -> [UrlPair] -> [[Image']]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (Int
-> HashMap Identifier Highlight
-> Palette
-> Int
-> Int
-> UrlPair
-> [Image']
draw Int
w HashMap Identifier Highlight
hilites Palette
pal Int
selected) [Int
1..] (ClientState -> [UrlPair]
urlList ClientState
st)
  where
    focused :: Bool
focused = Focus
focus Focus -> Focus -> Bool
forall a. Eq a => a -> a -> Bool
== Getting Focus ClientState Focus -> ClientState -> Focus
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Focus ClientState Focus
Lens' ClientState Focus
clientFocus ClientState
st

    selected :: Int
selected
      | Bool -> Bool
not Bool
focused             = Int
0
      | (Char -> Bool) -> String -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
==Char
' ') String
arg         = Int
1
      | Just Int
i <- String -> Maybe Int
forall a. Read a => String -> Maybe a
readMaybe String
arg = Int
i
      | Bool
otherwise               = Int
0 -- won't match

    cfg :: Configuration
cfg     = Getting Configuration ClientState Configuration
-> ClientState -> Configuration
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Configuration ClientState Configuration
Lens' ClientState Configuration
clientConfig ClientState
st
    pal :: Palette
pal     = Getting Palette Configuration Palette -> Configuration -> Palette
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Palette Configuration Palette
Lens' Configuration Palette
configPalette Configuration
cfg

    hilites :: HashMap Identifier Highlight
hilites = Focus -> ClientState -> HashMap Identifier Highlight
clientHighlightsFocus Focus
focus ClientState
st

-- | Render one line of the url list
draw ::
  Int                       {- ^ rendered width            -} ->
  HashMap Identifier Highlight {- ^ highlights             -} ->
  Palette                   {- ^ palette                   -} ->
  Int                       {- ^ selected index            -} ->
  Int                       {- ^ url index                 -} ->
  UrlPair                   {- ^ sender and url text       -} ->
  [Image']                  {- ^ rendered lines            -}
draw :: Int
-> HashMap Identifier Highlight
-> Palette
-> Int
-> Int
-> UrlPair
-> [Image']
draw Int
w HashMap Identifier Highlight
hilites Palette
pal Int
selected Int
i (Text
url, [Identifier]
who)
  = [Image'] -> [Image']
forall a. [a] -> [a]
reverse
  ([Image'] -> [Image']) -> [Image'] -> [Image']
forall a b. (a -> b) -> a -> b
$ Int -> Image' -> Image' -> [Image']
lineWrapPrefix Int
w
      (Attr -> String -> Image'
string Attr
defAttr (Int -> ShowS
forall a. Show a => a -> ShowS
shows Int
i String
"."))
      (Attr -> Text -> Image'
text' Attr
attr (Text -> Text
cleanText Text
url) Image' -> Image' -> Image'
forall a. Semigroup a => a -> a -> a
<> Image'
who')
  where
    who' :: Image'
who'
      | [Identifier] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Identifier]
who = Image'
forall a. Monoid a => a
mempty
      | Bool
otherwise = Image'
" (" Image' -> Image' -> Image'
forall a. Semigroup a => a -> a -> a
<> Image'
imgIds Image' -> Image' -> Image'
forall a. Semigroup a => a -> a -> a
<> Image'
")"
    imgIds :: Image'
imgIds = (Image' -> Image' -> Image') -> [Image'] -> Image'
forall a. HasCallStack => (a -> a -> a) -> [a] -> a
foldl1' Image' -> Image' -> Image'
forall a. Semigroup a => a -> a -> a
(<>) ([Image'] -> Image') -> [Image'] -> Image'
forall a b. (a -> b) -> a -> b
$ Image' -> [Image'] -> [Image']
forall a. a -> [a] -> [a]
intersperse Image'
", " ([Image'] -> [Image']) -> [Image'] -> [Image']
forall a b. (a -> b) -> a -> b
$ (Identifier -> Image') -> [Identifier] -> [Image']
forall a b. (a -> b) -> [a] -> [b]
map Identifier -> Image'
idImg [Identifier]
who
    idImg :: Identifier -> Image'
idImg Identifier
id' = Palette
-> IdentifierColorMode
-> HashMap Identifier Highlight
-> Identifier
-> Image'
coloredIdentifier Palette
pal IdentifierColorMode
NormalIdentifier HashMap Identifier Highlight
hilites Identifier
id'
    attr :: Attr
attr | Int
selected Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
i = Attr -> Style -> Attr
withStyle Attr
defAttr Style
reverseVideo
         | Bool
otherwise     = Attr
defAttr