{-# Language BangPatterns #-}

{-|
Module      : Client.Image.Textbox
Description : Textbox renderer
Copyright   : (c) Eric Mertens, 2016
License     : ISC
Maintainer  : emertens@gmail.com

This module provides the renderer for the client's text box input.

-}

module Client.Image.Textbox
  ( textboxImage
  ) where

import           Client.Configuration
import           Client.Commands
import           Client.Commands.Arguments.Renderer
import           Client.Commands.Arguments.Parser
import           Client.Commands.Interpolation
import           Client.Commands.Recognizer
import           Client.Image.LineWrap (fullLineWrap, terminate)
import           Client.Image.Message
import           Client.Image.MircFormatting
import           Client.Image.PackedImage
import           Client.Image.Palette
import           Client.State
import qualified Client.State.EditBox as Edit
import           Control.Lens
import           Data.HashMap.Strict (HashMap)
import           Data.List
import qualified Data.Text as Text
import           Graphics.Vty.Attributes
import qualified Graphics.Vty.Image as Vty
import           Irc.Identifier

textboxImage :: Int -> Int -> ClientState -> (Int, Int, Int, Vty.Image) -- ^ cursor column, new offset, image
textboxImage :: Int -> Int -> ClientState -> (Int, Int, Int, Image)
textboxImage Int
maxHeight Int
width ClientState
st =
  case Getting EditMode ClientState EditMode -> ClientState -> EditMode
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting EditMode ClientState EditMode
Lens' ClientState EditMode
clientEditMode ClientState
st of
    EditMode
SingleLineEditor -> Int -> Int -> ClientState -> (Int, Int, Int, Image)
singleLineTextboxImage Int
maxHeight Int
width ClientState
st
    EditMode
MultiLineEditor  -> Int -> Int -> ClientState -> (Int, Int, Int, Image)
multiLineTextboxImage  Int
maxHeight Int
width ClientState
st

multiLineTextboxImage :: Int -> Int -> ClientState -> (Int, Int, Int, Vty.Image) -- ^ cursor column, new offset, image
multiLineTextboxImage :: Int -> Int -> ClientState -> (Int, Int, Int, Image)
multiLineTextboxImage Int
_maxHeight Int
width ClientState
st = (Int
cursorRow, Int
cursorCol, Getting Int ClientState Int -> ClientState -> Int
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Int ClientState Int
Lens' ClientState Int
clientTextBoxOffset ClientState
st, Image
output)
  where
  output :: Image
output = [Image] -> Image
Vty.vertCat (Int -> Image -> Image
terminate Int
width (Image -> Image) -> (Image' -> Image) -> Image' -> Image
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Image' -> Image
unpackImage (Image' -> Image) -> [Image'] -> [Image]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Image']
imgs)

  imgs :: [Image']
imgs = [Image']
as [Image'] -> [Image'] -> [Image']
forall a. [a] -> [a] -> [a]
++ [Image']
c [Image'] -> [Image'] -> [Image']
forall a. [a] -> [a] -> [a]
++ [Image']
bs

  content :: Content
content = Getting Content ClientState Content -> ClientState -> Content
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view ((EditBox -> Const Content EditBox)
-> ClientState -> Const Content ClientState
Lens' ClientState EditBox
clientTextBox ((EditBox -> Const Content EditBox)
 -> ClientState -> Const Content ClientState)
-> ((Content -> Const Content Content)
    -> EditBox -> Const Content EditBox)
-> Getting Content ClientState Content
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Content -> Const Content Content)
-> EditBox -> Const Content EditBox
Lens' EditBox Content
Edit.content) ClientState
st

  as :: [Image']
as  = (Image' -> [Image']) -> [Image'] -> [Image']
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (Int -> Image' -> [Image']
fullLineWrap Int
width)
      ([Image'] -> [Image']) -> [Image'] -> [Image']
forall a b. (a -> b) -> a -> b
$ (Image' -> Image') -> [Image'] -> [Image']
forall a. (a -> a) -> [a] -> [a]
mapHead (Image'
beginning Image' -> Image' -> Image'
forall a. Semigroup a => a -> a -> a
<>)
      ([Image'] -> [Image']) -> [Image'] -> [Image']
forall a b. (a -> b) -> a -> b
$ (Image' -> Image') -> [Image'] -> [Image']
forall a b. (a -> b) -> [a] -> [b]
map (Image' -> Image' -> Image'
forall a. Semigroup a => a -> a -> a
<> String -> Image'
plainText String
"\n")
      ([Image'] -> [Image']) -> [Image'] -> [Image']
forall a b. (a -> b) -> a -> b
$ Bool -> String -> Image'
rndr Bool
False (String -> Image') -> [String] -> [Image']
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [String] -> [String]
forall a. [a] -> [a]
reverse (Getting [String] Content [String] -> Content -> [String]
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting [String] Content [String]
Lens' Content [String]
Edit.above Content
content)

  bs :: [Image']
bs  = (Image' -> [Image']) -> [Image'] -> [Image']
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (Int -> Image' -> [Image']
fullLineWrap Int
width)
      ([Image'] -> [Image']) -> [Image'] -> [Image']
forall a b. (a -> b) -> a -> b
$ [Image'] -> [Image']
endAfters
      ([Image'] -> [Image']) -> [Image'] -> [Image']
forall a b. (a -> b) -> a -> b
$ Bool -> String -> Image'
rndr Bool
False (String -> Image') -> [String] -> [Image']
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Getting [String] Content [String] -> Content -> [String]
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting [String] Content [String]
Lens' Content [String]
Edit.below Content
content

  cur :: Line
cur = Getting Line Content Line -> Content -> Line
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Line Content Line
forall c. HasLine c => Lens' c Line
Edit.line Content
content
  curTxt :: String
curTxt  = Getting String Line String -> Line -> String
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting String Line String
forall c. HasLine c => Lens' c String
Edit.text Line
cur

  cursorBase :: Int
cursorBase
    = Image' -> Int
imageWidth (Image' -> Int) -> Image' -> Int
forall a b. (a -> b) -> a -> b
$ Bool -> Palette -> Text -> Image'
parseIrcText' Bool
True Palette
pal
    (Text -> Image') -> Text -> Image'
forall a b. (a -> b) -> a -> b
$ String -> Text
Text.pack
    (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ Int -> String -> String
forall a. Int -> [a] -> [a]
take (Getting Int Line Int -> Line -> Int
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Int Line Int
forall c. HasLine c => Lens' c Int
Edit.pos Line
cur) String
curTxt

  (Int
cursorRow, Int
cursorCol) =
    Int -> [Image'] -> Int -> (Int, Int)
forall t. Num t => t -> [Image'] -> Int -> (t, Int)
calcCol ([Image'] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Image']
c Int -> Int -> Int
forall a. Num a => a -> a -> a
+ [Image'] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Image']
bs) [Image']
c (if [Image'] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Image']
as then Int
1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
cursorBase else Int
cursorBase)

  c :: [Image']
c = Int -> Image' -> [Image']
fullLineWrap Int
width
    (Image' -> [Image']) -> Image' -> [Image']
forall a b. (a -> b) -> a -> b
$ (if [Image'] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Image']
as then Image'
beginning else Image'
forall a. Monoid a => a
mempty)
   Image' -> Image' -> Image'
forall a. Semigroup a => a -> a -> a
<> Bool -> String -> Image'
rndr Bool
True String
curTxt
   Image' -> Image' -> Image'
forall a. Semigroup a => a -> a -> a
<> (if [Image'] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Image']
bs then Image'
ending else String -> Image'
plainText String
"\n")

  rndr :: Bool -> String -> Image'
rndr = ClientState
-> Palette
-> HashMap Identifier Highlight
-> Recognizer MacroSpec
-> Bool
-> String
-> Image'
renderLine ClientState
st Palette
pal HashMap Identifier Highlight
hilites Recognizer MacroSpec
macros
  pal :: Palette
pal = ClientState -> Palette
clientPalette ClientState
st
  hilites :: HashMap Identifier Highlight
hilites = Focus -> ClientState -> HashMap Identifier Highlight
clientHighlightsFocus (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) ClientState
st
  macros :: Recognizer MacroSpec
macros = LensLike'
  (Const (Recognizer MacroSpec)) ClientState (Recognizer Macro)
-> (Recognizer Macro -> Recognizer MacroSpec)
-> ClientState
-> Recognizer MacroSpec
forall s (m :: * -> *) r a.
MonadReader s m =>
LensLike' (Const r) s a -> (a -> r) -> m r
views ((Configuration -> Const (Recognizer MacroSpec) Configuration)
-> ClientState -> Const (Recognizer MacroSpec) ClientState
Lens' ClientState Configuration
clientConfig ((Configuration -> Const (Recognizer MacroSpec) Configuration)
 -> ClientState -> Const (Recognizer MacroSpec) ClientState)
-> ((Recognizer Macro
     -> Const (Recognizer MacroSpec) (Recognizer Macro))
    -> Configuration -> Const (Recognizer MacroSpec) Configuration)
-> LensLike'
     (Const (Recognizer MacroSpec)) ClientState (Recognizer Macro)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Recognizer Macro
 -> Const (Recognizer MacroSpec) (Recognizer Macro))
-> Configuration -> Const (Recognizer MacroSpec) Configuration
Lens' Configuration (Recognizer Macro)
configMacros) ((Macro -> MacroSpec) -> Recognizer Macro -> Recognizer MacroSpec
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Macro -> MacroSpec
macroSpec) ClientState
st

  attr :: Attr
attr      = Getting Attr Palette Attr -> Palette -> Attr
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Attr Palette Attr
Lens' Palette Attr
palTextBox Palette
pal
  beginning :: Image'
beginning = Attr -> Char -> Image'
char Attr
attr Char
'^'
  ending :: Image'
ending    = Attr -> Char -> Image'
char Attr
attr Char
'$'

  endAfters :: [Image'] -> [Image']
endAfters [] = []
  endAfters [Image'
x] = [Image'
x Image' -> Image' -> Image'
forall a. Semigroup a => a -> a -> a
<> Image'
ending]
  endAfters (Image'
x:[Image']
xs) = Image'
x Image' -> Image' -> Image'
forall a. Semigroup a => a -> a -> a
<> String -> Image'
plainText String
"\n" Image' -> [Image'] -> [Image']
forall a. a -> [a] -> [a]
: [Image'] -> [Image']
endAfters [Image']
xs

  -- Using fullLineWrap make calculating the cursor much easier
  -- to switch to word-breaking lineWrap we'll need some extra
  -- logic to count skipped spaces.
  calcCol :: t -> [Image'] -> Int -> (t, Int)
calcCol t
row [] Int
_ = (t
row, Int
0)
  calcCol t
row (Image'
i:[Image']
is) Int
n
    | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
w = (t
row, Int
n)
    | Bool
otherwise = t -> [Image'] -> Int -> (t, Int)
calcCol (t
rowt -> t -> t
forall a. Num a => a -> a -> a
-t
1) [Image']
is (Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
w)
    where
      w :: Int
w = Image' -> Int
imageWidth Image'
i

mapHead :: (a -> a) -> [a] -> [a]
mapHead :: (a -> a) -> [a] -> [a]
mapHead a -> a
f (a
x:[a]
xs) = a -> a
f a
x a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a]
xs
mapHead a -> a
_ []     = []

-- | Compute the UI image for the text input box. This computes
-- the logical cursor position on the screen to compensate for
-- VTY's cursor placement behavior.
singleLineTextboxImage :: Int -> Int -> ClientState -> (Int, Int, Int, Vty.Image) -- ^ cursor column, new offset, image
singleLineTextboxImage :: Int -> Int -> ClientState -> (Int, Int, Int, Image)
singleLineTextboxImage Int
_maxHeight Int
width ClientState
st
  = (Int
1, Int
newPos, Int
newOffset, Image
croppedImage)
  where
  macros :: Recognizer MacroSpec
macros = LensLike'
  (Const (Recognizer MacroSpec)) ClientState (Recognizer Macro)
-> (Recognizer Macro -> Recognizer MacroSpec)
-> ClientState
-> Recognizer MacroSpec
forall s (m :: * -> *) r a.
MonadReader s m =>
LensLike' (Const r) s a -> (a -> r) -> m r
views ((Configuration -> Const (Recognizer MacroSpec) Configuration)
-> ClientState -> Const (Recognizer MacroSpec) ClientState
Lens' ClientState Configuration
clientConfig ((Configuration -> Const (Recognizer MacroSpec) Configuration)
 -> ClientState -> Const (Recognizer MacroSpec) ClientState)
-> ((Recognizer Macro
     -> Const (Recognizer MacroSpec) (Recognizer Macro))
    -> Configuration -> Const (Recognizer MacroSpec) Configuration)
-> LensLike'
     (Const (Recognizer MacroSpec)) ClientState (Recognizer Macro)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Recognizer Macro
 -> Const (Recognizer MacroSpec) (Recognizer Macro))
-> Configuration -> Const (Recognizer MacroSpec) Configuration
Lens' Configuration (Recognizer Macro)
configMacros) ((Macro -> MacroSpec) -> Recognizer Macro -> Recognizer MacroSpec
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Macro -> MacroSpec
macroSpec) ClientState
st
  (Int
txt, Image'
content) =
     ClientState
-> HashMap Identifier Highlight
-> Recognizer MacroSpec
-> Palette
-> Content
-> (Int, Image')
renderContent ClientState
st HashMap Identifier Highlight
hilites Recognizer MacroSpec
macros Palette
pal
       (Getting Content ClientState Content -> ClientState -> Content
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view ((EditBox -> Const Content EditBox)
-> ClientState -> Const Content ClientState
Lens' ClientState EditBox
clientTextBox ((EditBox -> Const Content EditBox)
 -> ClientState -> Const Content ClientState)
-> ((Content -> Const Content Content)
    -> EditBox -> Const Content EditBox)
-> Getting Content ClientState Content
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Content -> Const Content Content)
-> EditBox -> Const Content EditBox
Lens' EditBox Content
Edit.content) ClientState
st)

  lineImage :: Image
lineImage = Image' -> Image
unpackImage (Image'
beginning Image' -> Image' -> Image'
forall a. Semigroup a => a -> a -> a
<> Image'
content Image' -> Image' -> Image'
forall a. Semigroup a => a -> a -> a
<> Image'
ending)

  leftOfCurWidth :: Int
leftOfCurWidth = Int
1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
txt

  croppedImage :: Image
croppedImage = Int -> Image -> Image
Vty.resizeWidth Int
width
               (Image -> Image) -> Image -> Image
forall a b. (a -> b) -> a -> b
$ Int -> Image -> Image
Vty.cropLeft (Image -> Int
Vty.imageWidth Image
lineImage Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
newOffset) Image
lineImage

  cursorAnchor :: Int
cursorAnchor = Int
width Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
3 Int -> Int -> Int
forall a. Integral a => a -> a -> a
`quot` Int
4

  -- previous offset value
  oldOffset :: Int
oldOffset = Getting Int ClientState Int -> ClientState -> Int
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Int ClientState Int
Lens' ClientState Int
clientTextBoxOffset ClientState
st

  -- position based on old offset
  oldPos :: Int
oldPos = Int
leftOfCurWidth Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
oldOffset

  -- new offset (number of columns to trim from left side of text box)
  newOffset :: Int
newOffset
    | Int
0 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
oldPos, Int
oldPos Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
width = Int
oldOffset
    | Bool
otherwise                   = Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
0 (Int
leftOfCurWidth Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
cursorAnchor)

  newPos :: Int
newPos = Int
leftOfCurWidth Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
newOffset

  pal :: Palette
pal       = ClientState -> Palette
clientPalette ClientState
st
  attr :: Attr
attr      = Getting Attr Palette Attr -> Palette -> Attr
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Attr Palette Attr
Lens' Palette Attr
palTextBox Palette
pal
  beginning :: Image'
beginning = Attr -> Char -> Image'
char Attr
attr Char
'^'
  ending :: Image'
ending    = Attr -> Char -> Image'
char Attr
attr Char
'$'

  hilites :: HashMap Identifier Highlight
hilites = Focus -> ClientState -> HashMap Identifier Highlight
clientHighlightsFocus (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) ClientState
st


-- | Renders the whole, uncropped text box as well as the 'String'
-- corresponding to the rendered image which can be used for computing
-- the logical cursor position of the cropped version of the text box.
renderContent ::
  ClientState          {- ^ client state                          -} ->
  HashMap Identifier Highlight {- ^ highlights                    -} ->
  Recognizer MacroSpec {- ^ macro completions                     -} ->
  Palette              {- ^ palette                               -} ->
  Edit.Content         {- ^ content                               -} ->
  (Int, Image')        {- ^ left-of-cursor width, image rendering -}
renderContent :: ClientState
-> HashMap Identifier Highlight
-> Recognizer MacroSpec
-> Palette
-> Content
-> (Int, Image')
renderContent ClientState
st HashMap Identifier Highlight
hilites Recognizer MacroSpec
macros Palette
pal Content
c = (Int
leftLen, Image'
wholeImg)
  where
  as :: [String]
as  = [String] -> [String]
forall a. [a] -> [a]
reverse (Getting [String] Content [String] -> Content -> [String]
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting [String] Content [String]
Lens' Content [String]
Edit.above Content
c)
  bs :: [String]
bs  = Getting [String] Content [String] -> Content -> [String]
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting [String] Content [String]
Lens' Content [String]
Edit.below Content
c
  cur :: Line
cur = Getting Line Content Line -> Content -> Line
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Line Content Line
forall c. HasLine c => Lens' c Line
Edit.line Content
c

  curTxt :: String
curTxt  = Getting String Line String -> Line -> String
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting String Line String
forall c. HasLine c => Lens' c String
Edit.text Line
cur
  leftCur :: String
leftCur = Int -> String -> String
forall a. Int -> [a] -> [a]
take (Getting Int Line Int -> Line -> Int
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Int Line Int
forall c. HasLine c => Lens' c Int
Edit.pos Line
cur) (Getting String Line String -> Line -> String
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting String Line String
forall c. HasLine c => Lens' c String
Edit.text Line
cur)

  -- ["one","two"] "three" --> "two one three"
  leftLen :: Int
leftLen = [Image'] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Image']
leftImgs -- separators
          Int -> Int -> Int
forall a. Num a => a -> a -> a
+ [Int] -> Int
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum ((Image' -> Int) -> [Image'] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map Image' -> Int
imageWidth [Image']
leftImgs)
          Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Image' -> Int
imageWidth (Bool -> Palette -> Text -> Image'
parseIrcText' Bool
True Palette
pal (String -> Text
Text.pack String
leftCur))

  rndr :: Bool -> String -> Image'
rndr = ClientState
-> Palette
-> HashMap Identifier Highlight
-> Recognizer MacroSpec
-> Bool
-> String
-> Image'
renderLine ClientState
st Palette
pal HashMap Identifier Highlight
hilites Recognizer MacroSpec
macros

  leftImgs :: [Image']
leftImgs = (String -> Image') -> [String] -> [Image']
forall a b. (a -> b) -> [a] -> [b]
map (Bool -> String -> Image'
rndr Bool
False) [String]
as

  wholeImg :: Image'
wholeImg = [Image'] -> Image'
forall a. Monoid a => [a] -> a
mconcat
           ([Image'] -> Image') -> [Image'] -> Image'
forall a b. (a -> b) -> a -> b
$ Image' -> [Image'] -> [Image']
forall a. a -> [a] -> [a]
intersperse (String -> Image'
plainText String
"\n")
           ([Image'] -> [Image']) -> [Image'] -> [Image']
forall a b. (a -> b) -> a -> b
$ [Image']
leftImgs
          [Image'] -> [Image'] -> [Image']
forall a. [a] -> [a] -> [a]
++ Bool -> String -> Image'
rndr Bool
True String
curTxt
           Image' -> [Image'] -> [Image']
forall a. a -> [a] -> [a]
: (String -> Image') -> [String] -> [Image']
forall a b. (a -> b) -> [a] -> [b]
map (Bool -> String -> Image'
rndr Bool
False) [String]
bs


-- | Render the active text box line using command highlighting and
-- placeholders, and WYSIWYG mIRC formatting control characters.
renderLine ::
  ClientState ->
  Palette ->
  HashMap Identifier Highlight ->
  Recognizer MacroSpec {- ^ commands     -} ->
  Bool                 {- ^ focused      -} ->
  String               {- ^ input text   -} ->
  Image'               {- ^ output image -}
renderLine :: ClientState
-> Palette
-> HashMap Identifier Highlight
-> Recognizer MacroSpec
-> Bool
-> String
-> Image'
renderLine ClientState
st Palette
pal HashMap Identifier Highlight
hilites Recognizer MacroSpec
macros Bool
focused String
input =

  case (Char -> Bool) -> String -> (String, String)
forall a. (a -> Bool) -> [a] -> ([a], [a])
span (Char
' 'Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
==) String
input of
    (String
spcs, Char
'/':String
xs) -> Attr -> String -> Image'
string Attr
defAttr String
spcs Image' -> Image' -> Image'
forall a. Semigroup a => a -> a -> a
<> Attr -> Char -> Image'
char Attr
defAttr Char
'/'
                   Image' -> Image' -> Image'
forall a. Semigroup a => a -> a -> a
<> Attr -> String -> Image'
string Attr
attr String
cleanCmd Image' -> Image' -> Image'
forall a. Semigroup a => a -> a -> a
<> String -> Image'
continue String
rest
      where
        specAttr :: Args ClientState a -> Attr
specAttr Args ClientState a
spec =
          case ClientState -> Args ClientState a -> String -> Maybe a
forall r a. r -> Args r a -> String -> Maybe a
parse ClientState
st Args ClientState a
spec String
rest of
            Maybe a
Nothing -> Getting Attr Palette Attr -> Palette -> Attr
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Attr Palette Attr
Lens' Palette Attr
palCommand      Palette
pal
            Just{}  -> Getting Attr Palette Attr -> Palette -> Attr
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Attr Palette Attr
Lens' Palette Attr
palCommandReady Palette
pal

        (String
cmd, String
rest) = (Char -> Bool) -> String -> (String, String)
forall a. (a -> Bool) -> [a] -> ([a], [a])
break (Char
' 'Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
==) String
xs
        cleanCmd :: String
cleanCmd = (Char -> Char) -> String -> String
forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
cleanChar String
cmd

        allCommands :: Recognizer (Either MacroSpec Command)
allCommands = (MacroSpec -> Either MacroSpec Command
forall a b. a -> Either a b
Left (MacroSpec -> Either MacroSpec Command)
-> Recognizer MacroSpec -> Recognizer (Either MacroSpec Command)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Recognizer MacroSpec
macros) Recognizer (Either MacroSpec Command)
-> Recognizer (Either MacroSpec Command)
-> Recognizer (Either MacroSpec Command)
forall a. Semigroup a => a -> a -> a
<> (Command -> Either MacroSpec Command
forall a b. b -> Either a b
Right (Command -> Either MacroSpec Command)
-> Recognizer Command -> Recognizer (Either MacroSpec Command)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Recognizer Command
commands)
        (Attr
attr, String -> Image'
continue)
          = case Text
-> Recognizer (Either MacroSpec Command)
-> Recognition (Either MacroSpec Command)
forall a. Text -> Recognizer a -> Recognition a
recognize (Text -> Text
Text.toLower (String -> Text
Text.pack String
cmd)) Recognizer (Either MacroSpec Command)
allCommands of
              Exact (Right Command{cmdArgumentSpec :: ()
cmdArgumentSpec = Args ClientState a
spec}) ->
                ( Args ClientState a -> Attr
forall a. Args ClientState a -> Attr
specAttr Args ClientState a
spec
                , Palette
-> ClientState -> Bool -> Args ClientState a -> String -> Image'
forall r a. Palette -> r -> Bool -> Args r a -> String -> Image'
render Palette
pal ClientState
st Bool
focused Args ClientState a
spec
                )
              Exact (Left (MacroSpec forall r. Args r [String]
spec)) ->
                ( Args ClientState [String] -> Attr
forall a. Args ClientState a -> Attr
specAttr Args ClientState [String]
forall r. Args r [String]
spec
                , Palette
-> ClientState
-> Bool
-> Args ClientState [String]
-> String
-> Image'
forall r a. Palette -> r -> Bool -> Args r a -> String -> Image'
render Palette
pal ClientState
st Bool
focused Args ClientState [String]
forall r. Args r [String]
spec
                )
              Prefix [Text]
_ ->
                ( Getting Attr Palette Attr -> Palette -> Attr
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Attr Palette Attr
Lens' Palette Attr
palCommandPrefix Palette
pal
                , Palette -> HashMap Identifier Highlight -> Bool -> Text -> Image'
parseIrcTextWithNicks Palette
pal HashMap Identifier Highlight
hilites Bool
focused (Text -> Image') -> (String -> Text) -> String -> Image'
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
Text.pack
                )
              Recognition (Either MacroSpec Command)
Invalid ->
                ( Getting Attr Palette Attr -> Palette -> Attr
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Attr Palette Attr
Lens' Palette Attr
palCommandError Palette
pal
                , Palette -> HashMap Identifier Highlight -> Bool -> Text -> Image'
parseIrcTextWithNicks Palette
pal HashMap Identifier Highlight
hilites Bool
focused (Text -> Image') -> (String -> Text) -> String -> Image'
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
Text.pack
                )
    (String, String)
_ -> Palette -> HashMap Identifier Highlight -> Bool -> Text -> Image'
parseIrcTextWithNicks Palette
pal HashMap Identifier Highlight
hilites Bool
focused (String -> Text
Text.pack String
input)