{-# Language GADTs #-}
module Client.Image.Arguments
( argumentsImage
, plainText
) where
import Client.Commands.Arguments
import Client.Image.MircFormatting
import Client.Image.Palette
import Control.Lens
import Data.Char
import qualified Data.Text as Text
import Graphics.Vty.Image
plainText :: String -> Image
plainText "" = emptyImage
plainText xs =
case break isControl xs of
(first, "" ) -> string defAttr first
(first, cntl:rest) -> string defAttr first <|>
controlImage cntl <|>
plainText rest
argumentsImage :: Palette -> ArgumentSpec a -> String -> Image
argumentsImage pal spec xs
| all (==' ') xs = placeholders
<|> string defAttr (drop (imageWidth placeholders) xs)
| otherwise =
case spec of
NoArg -> plainText xs
ReqTokenArg _ a -> plainText token <|> argumentsImage pal a xs'
OptTokenArg _ a -> plainText token <|> argumentsImage pal a xs'
RemainingArg _ -> parseIrcTextExplicit (Text.pack xs)
where
token = token1 ++ token2
(token1,(token2,xs')) =
break (==' ') <$> span (==' ') xs
placeholders = mkPlaceholders pal spec
mkPlaceholders :: Palette -> ArgumentSpec a -> Image
mkPlaceholders pal arg =
case arg of
NoArg -> emptyImage
ReqTokenArg n a -> leader
<|> string (view palCommandRequired pal) n
<|> mkPlaceholders pal a
OptTokenArg n a -> leader
<|> string (view palCommandOptional pal) n
<|> mkPlaceholders pal a
RemainingArg n -> leader
<|> string (view palCommandRemaining pal) n
where
leader = char defAttr ' '