{-# Language GADTs #-}
module Client.Image.Arguments
( argumentsImage
) where
import Client.Commands.Arguments
import Client.Image.MircFormatting
import Client.Image.Palette
import Control.Lens
import qualified Data.Text as Text
import Graphics.Vty.Attributes
import Graphics.Vty.Image
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 palCommandPlaceholder pal) n
<|> mkPlaceholders pal a
OptTokenArg n a -> leader
<|> string (view palCommandPlaceholder pal) (n ++ "?")
<|> mkPlaceholders pal a
RemainingArg n -> leader
<|> string (view palCommandPlaceholder pal) (n ++ "…")
where
leader = char defAttr ' '