{-# Language BangPatterns #-}
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)
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)
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
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
_ [] = []
singleLineTextboxImage :: Int -> Int -> ClientState -> (Int, Int, Int, Vty.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
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
oldPos :: Int
oldPos = Int
leftOfCurWidth Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
oldOffset
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
renderContent ::
ClientState ->
HashMap Identifier Highlight ->
Recognizer MacroSpec ->
Palette ->
Edit.Content ->
(Int, Image')
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)
leftLen :: Int
leftLen = [Image'] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Image']
leftImgs
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
renderLine ::
ClientState ->
Palette ->
HashMap Identifier Highlight ->
Recognizer MacroSpec ->
Bool ->
String ->
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)