module GitHUD.Terminal.Base (
  tellStringInColor
  , applyShellMarkers
  , terminalStartCode
  , endColorMarker
  ) where

import Control.Monad.Writer (tell)
import Data.Monoid (mappend)

import GitHUD.Types
import GitHUD.Terminal.Types

tellStringInColor :: Color               -- ^ The terminal color to use
                  -> ColorIntensity      -- ^ The intensity to use
                  -> String              -- ^ The string to output
                  -> ShellOutput
tellStringInColor :: Color -> ColorIntensity -> String -> ShellOutput
tellStringInColor Color
color ColorIntensity
intensity String
str = do
  Shell
shell <- WriterT String (Reader OutputConfig) Shell
forall (m :: * -> *). MonadReader OutputConfig m => m Shell
askShell
  String -> ShellOutput
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell (String -> ShellOutput) -> String -> ShellOutput
forall a b. (a -> b) -> a -> b
$ Color -> ColorIntensity -> Shell -> String
startColorMarker Color
color ColorIntensity
intensity Shell
shell
  String -> ShellOutput
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell (String -> ShellOutput) -> String -> ShellOutput
forall a b. (a -> b) -> a -> b
$ String
str
  String -> ShellOutput
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell (String -> ShellOutput) -> String -> ShellOutput
forall a b. (a -> b) -> a -> b
$ Shell -> String
endColorMarker Shell
shell

startColorMarker :: Color
                 -> ColorIntensity
                 -> Shell
                 -> String
startColorMarker :: Color -> ColorIntensity -> Shell -> String
startColorMarker Color
color ColorIntensity
intensity Shell
shell
  | Shell
shell Shell -> Shell -> Bool
forall a. Eq a => a -> a -> Bool
== Shell
TMUX = Color -> ColorIntensity -> String
tmuxStartCode Color
color ColorIntensity
intensity
  | Shell
shell Shell -> Shell -> Bool
forall a. Eq a => a -> a -> Bool
== Shell
NONE = String
""
  | Bool
otherwise = Shell -> String -> String
applyShellMarkers Shell
shell (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ Color -> ColorIntensity -> String
terminalStartCode Color
color ColorIntensity
intensity

endColorMarker :: Shell
               -> String
endColorMarker :: Shell -> String
endColorMarker Shell
shell
  | Shell
shell Shell -> Shell -> Bool
forall a. Eq a => a -> a -> Bool
== Shell
TMUX = String
tmuxEndCode
  | Shell
shell Shell -> Shell -> Bool
forall a. Eq a => a -> a -> Bool
== Shell
NONE = String
""
  | Bool
otherwise = Shell -> String -> String
applyShellMarkers Shell
shell (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ String
terminalEndCode

applyShellMarkers :: Shell
                  -> String
                  -> String
applyShellMarkers :: Shell -> String -> String
applyShellMarkers Shell
ZSH = String -> String
zshMarkZeroWidth
applyShellMarkers Shell
BASH = String -> String
bashMarkZeroWidth
applyShellMarkers Shell
_ = String -> String
forall a. a -> a
id

zshMarkZeroWidth :: String
                 -> String
zshMarkZeroWidth :: String -> String
zshMarkZeroWidth String
str = String
"%{" String -> String -> String
forall a. Monoid a => a -> a -> a
`mappend` String
str String -> String -> String
forall a. Monoid a => a -> a -> a
`mappend` String
"%}"

bashMarkZeroWidth :: String
                 -> String
bashMarkZeroWidth :: String -> String
bashMarkZeroWidth String
str = String
"\001" String -> String -> String
forall a. Monoid a => a -> a -> a
`mappend` String
str String -> String -> String
forall a. Monoid a => a -> a -> a
`mappend` String
"\002"

terminalStartCode :: Color
                  -> ColorIntensity
                  -> String
terminalStartCode :: Color -> ColorIntensity -> String
terminalStartCode  Color
Black    ColorIntensity
Vivid  = String
"\x1b[1;30m"
terminalStartCode  Color
Red      ColorIntensity
Vivid  = String
"\x1b[1;31m"
terminalStartCode  Color
Green    ColorIntensity
Vivid  = String
"\x1b[1;32m"
terminalStartCode  Color
Yellow   ColorIntensity
Vivid  = String
"\x1b[1;33m"
terminalStartCode  Color
Blue     ColorIntensity
Vivid  = String
"\x1b[1;34m"
terminalStartCode  Color
Magenta  ColorIntensity
Vivid  = String
"\x1b[1;35m"
terminalStartCode  Color
Cyan     ColorIntensity
Vivid  = String
"\x1b[1;36m"
terminalStartCode  Color
White    ColorIntensity
Vivid  = String
"\x1b[1;37m"
terminalStartCode  Color
Black    ColorIntensity
Dull   = String
"\x1b[30m"
terminalStartCode  Color
Red      ColorIntensity
Dull   = String
"\x1b[31m"
terminalStartCode  Color
Green    ColorIntensity
Dull   = String
"\x1b[32m"
terminalStartCode  Color
Yellow   ColorIntensity
Dull   = String
"\x1b[33m"
terminalStartCode  Color
Blue     ColorIntensity
Dull   = String
"\x1b[34m"
terminalStartCode  Color
Magenta  ColorIntensity
Dull   = String
"\x1b[35m"
terminalStartCode  Color
Cyan     ColorIntensity
Dull   = String
"\x1b[36m"
terminalStartCode  Color
White    ColorIntensity
Dull   = String
"\x1b[37m"
terminalStartCode  Color
NoColor  ColorIntensity
_      = String
terminalEndCode

terminalEndCode :: String
terminalEndCode :: String
terminalEndCode = String
"\x1b[0;39m"

tmuxStartCode :: Color
              -> ColorIntensity
              -> String
tmuxStartCode :: Color -> ColorIntensity -> String
tmuxStartCode  Color
Black    ColorIntensity
Vivid  = String
"#[fg=brightblack]"
tmuxStartCode  Color
Red      ColorIntensity
Vivid  = String
"#[fg=brightred]"
tmuxStartCode  Color
Green    ColorIntensity
Vivid  = String
"#[fg=brightgreen]"
tmuxStartCode  Color
Yellow   ColorIntensity
Vivid  = String
"#[fg=brightyellow]"
tmuxStartCode  Color
Blue     ColorIntensity
Vivid  = String
"#[fg=brightblue]"
tmuxStartCode  Color
Magenta  ColorIntensity
Vivid  = String
"#[fg=brightmagenta]"
tmuxStartCode  Color
Cyan     ColorIntensity
Vivid  = String
"#[fg=brightcyan]"
tmuxStartCode  Color
White    ColorIntensity
Vivid  = String
"#[fg=brightwhite]"
tmuxStartCode  Color
Black    ColorIntensity
Dull   = String
"#[fg=black]"
tmuxStartCode  Color
Red      ColorIntensity
Dull   = String
"#[fg=red]"
tmuxStartCode  Color
Green    ColorIntensity
Dull   = String
"#[fg=green]"
tmuxStartCode  Color
Yellow   ColorIntensity
Dull   = String
"#[fg=yellow]"
tmuxStartCode  Color
Blue     ColorIntensity
Dull   = String
"#[fg=blue]"
tmuxStartCode  Color
Magenta  ColorIntensity
Dull   = String
"#[fg=magenta]"
tmuxStartCode  Color
Cyan     ColorIntensity
Dull   = String
"#[fg=cyan]"
tmuxStartCode  Color
White    ColorIntensity
Dull   = String
"#[fg=white]"
tmuxStartCode  Color
NoColor  ColorIntensity
_      = String
tmuxEndCode

tmuxEndCode :: String
tmuxEndCode :: String
tmuxEndCode = String
"#[fg=default]"