{-# 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.Message
import           Client.State
import           Client.State.Focus
import           Client.State.Window
import           Control.Lens
import           Data.HashMap.Strict (HashMap)
import           Data.Text (Text)
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 -> (Maybe Identifier, Text) -> [Image'])
-> [Int] -> [(Maybe Identifier, Text)] -> [[Image']]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (Int
-> HashMap Identifier Highlight
-> Palette
-> PaddingMode
-> Int
-> Int
-> (Maybe Identifier, Text)
-> [Image']
draw Int
w HashMap Identifier Highlight
hilites Palette
pal PaddingMode
padding Int
selected) [Int
1..] (Getting
  (Endo [(Maybe Identifier, Text)])
  ClientState
  (Maybe Identifier, Text)
-> ClientState -> [(Maybe Identifier, Text)]
forall a s. Getting (Endo [a]) s a -> s -> [a]
toListOf Getting
  (Endo [(Maybe Identifier, Text)])
  ClientState
  (Maybe Identifier, Text)
urled ClientState
st)
  where
    urled :: Getting
  (Endo [(Maybe Identifier, Text)])
  ClientState
  (Maybe Identifier, Text)
urled = (Map Focus Window
 -> Const (Endo [(Maybe Identifier, Text)]) (Map Focus Window))
-> ClientState
-> Const (Endo [(Maybe Identifier, Text)]) ClientState
Lens' ClientState (Map Focus Window)
clientWindows ((Map Focus Window
  -> Const (Endo [(Maybe Identifier, Text)]) (Map Focus Window))
 -> ClientState
 -> Const (Endo [(Maybe Identifier, Text)]) ClientState)
-> (((Maybe Identifier, Text)
     -> Const
          (Endo [(Maybe Identifier, Text)]) (Maybe Identifier, Text))
    -> Map Focus Window
    -> Const (Endo [(Maybe Identifier, Text)]) (Map Focus Window))
-> Getting
     (Endo [(Maybe Identifier, Text)])
     ClientState
     (Maybe Identifier, Text)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Index (Map Focus Window)
-> Traversal' (Map Focus Window) (IxValue (Map Focus Window))
forall m. Ixed m => Index m -> Traversal' m (IxValue m)
ix Index (Map Focus Window)
Focus
focus
          ((Window -> Const (Endo [(Maybe Identifier, Text)]) Window)
 -> Map Focus Window
 -> Const (Endo [(Maybe Identifier, Text)]) (Map Focus Window))
-> (((Maybe Identifier, Text)
     -> Const
          (Endo [(Maybe Identifier, Text)]) (Maybe Identifier, Text))
    -> Window -> Const (Endo [(Maybe Identifier, Text)]) Window)
-> ((Maybe Identifier, Text)
    -> Const
         (Endo [(Maybe Identifier, Text)]) (Maybe Identifier, Text))
-> Map Focus Window
-> Const (Endo [(Maybe Identifier, Text)]) (Map Focus Window)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (WindowLines
 -> Const (Endo [(Maybe Identifier, Text)]) WindowLines)
-> Window -> Const (Endo [(Maybe Identifier, Text)]) Window
Lens' Window WindowLines
winMessages   ((WindowLines
  -> Const (Endo [(Maybe Identifier, Text)]) WindowLines)
 -> Window -> Const (Endo [(Maybe Identifier, Text)]) Window)
-> (((Maybe Identifier, Text)
     -> Const
          (Endo [(Maybe Identifier, Text)]) (Maybe Identifier, Text))
    -> WindowLines
    -> Const (Endo [(Maybe Identifier, Text)]) WindowLines)
-> ((Maybe Identifier, Text)
    -> Const
         (Endo [(Maybe Identifier, Text)]) (Maybe Identifier, Text))
-> Window
-> Const (Endo [(Maybe Identifier, Text)]) Window
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (WindowLine -> Const (Endo [(Maybe Identifier, Text)]) WindowLine)
-> WindowLines
-> Const (Endo [(Maybe Identifier, Text)]) WindowLines
forall s t a b. Each s t a b => Traversal s t a b
each
          ((WindowLine -> Const (Endo [(Maybe Identifier, Text)]) WindowLine)
 -> WindowLines
 -> Const (Endo [(Maybe Identifier, Text)]) WindowLines)
-> (((Maybe Identifier, Text)
     -> Const
          (Endo [(Maybe Identifier, Text)]) (Maybe Identifier, Text))
    -> WindowLine
    -> Const (Endo [(Maybe Identifier, Text)]) WindowLine)
-> ((Maybe Identifier, Text)
    -> Const
         (Endo [(Maybe Identifier, Text)]) (Maybe Identifier, Text))
-> WindowLines
-> Const (Endo [(Maybe Identifier, Text)]) WindowLines
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (WindowLine -> [(Maybe Identifier, Text)])
-> Fold WindowLine (Maybe Identifier, Text)
forall (f :: * -> *) s a. Foldable f => (s -> f a) -> Fold s a
folding WindowLine -> [(Maybe Identifier, Text)]
matches

    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
    padding :: PaddingMode
padding = Getting PaddingMode Configuration PaddingMode
-> Configuration -> PaddingMode
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting PaddingMode Configuration PaddingMode
Lens' Configuration PaddingMode
configNickPadding Configuration
cfg
    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


matches :: WindowLine -> [(Maybe Identifier, Text)]
matches :: WindowLine -> [(Maybe Identifier, Text)]
matches WindowLine
wl = [ (LensLike' (Const (Maybe Identifier)) WindowLine IrcSummary
-> (IrcSummary -> Maybe Identifier)
-> WindowLine
-> Maybe Identifier
forall s (m :: * -> *) r a.
MonadReader s m =>
LensLike' (Const r) s a -> (a -> r) -> m r
views LensLike' (Const (Maybe Identifier)) WindowLine IrcSummary
Lens' WindowLine IrcSummary
wlSummary IrcSummary -> Maybe Identifier
summaryActor WindowLine
wl, Text
url) | Text
url <- LensLike' (Const [Text]) WindowLine Text
-> (Text -> [Text]) -> WindowLine -> [Text]
forall s (m :: * -> *) r a.
MonadReader s m =>
LensLike' (Const r) s a -> (a -> r) -> m r
views LensLike' (Const [Text]) WindowLine Text
Getter WindowLine Text
wlText Text -> [Text]
urlMatches WindowLine
wl ]


-- | Render one line of the url list
draw ::
  Int                       {- ^ rendered width            -} ->
  HashMap Identifier Highlight {- ^ highlights             -} ->
  Palette                   {- ^ palette                   -} ->
  PaddingMode               {- ^ nick render padding       -} ->
  Int                       {- ^ selected index            -} ->
  Int                       {- ^ url index                 -} ->
  (Maybe Identifier, Text)  {- ^ sender and url text       -} ->
  [Image']                  {- ^ rendered lines            -}
draw :: Int
-> HashMap Identifier Highlight
-> Palette
-> PaddingMode
-> Int
-> Int
-> (Maybe Identifier, Text)
-> [Image']
draw Int
w HashMap Identifier Highlight
hilites Palette
pal PaddingMode
padding Int
selected Int
i (Maybe Identifier
who,Text
url)
  = [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
". ") Image' -> Image' -> Image'
forall a. Semigroup a => a -> a -> a
<>
       PaddingMode -> Image' -> Image'
nickPad PaddingMode
padding
         ((Identifier -> Image') -> Maybe Identifier -> Image'
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (Palette
-> IdentifierColorMode
-> HashMap Identifier Highlight
-> Identifier
-> Image'
coloredIdentifier Palette
pal IdentifierColorMode
NormalIdentifier HashMap Identifier Highlight
hilites) Maybe Identifier
who) Image' -> Image' -> Image'
forall a. Semigroup a => a -> a -> a
<> Image'
": ")
      (Attr -> Text -> Image'
text' Attr
attr (Text -> Text
cleanText Text
url))
  where
    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