module Util.Terminal
( esc

, clearAll
, clearEol
, clear   

, move
, moveUp     
, moveDown   
, moveBack   
, moveForward

, save
, load

, clr
, fg
, bg

, normal   
, bold     
, faint    
, standout 
, underline
, blink    
, inverse  
, invisible

, Color (..)

, reset
, black  
, red    
, green  
, yellow 
, blue   
, magenta
, cyan   
, white  

, blackBold  
, redBold    
, greenBold  
, yellowBold 
, blueBold   
, magentaBold
, cyanBold   
, whiteBold  

, blackBg  
, redBg    
, greenBg  
, yellowBg 
, blueBg   
, magentaBg
, cyanBg   
, whiteBg  
, resetBg  

, width
, height
, geometry
)
where

import Control.Applicative
import Data.List (intercalate)
import System.Environment (getEnvironment)

-- Ansi escape sequence generation.

-- Generic function for producing ANSI escape sequences.
esc :: String -> [String] -> String -> String
esc a args b = concat ["\ESC[", a, intercalate ";" $ args, b]

-- Clear screen and end-of-line
clearAll, clearEol, clear :: String
clearAll = esc "2J" [] ""
clearEol = esc "K"  [] "" 
clear    = clearAll ++ move 1 1

-- Move the cursor to the specified row and column.
move :: Int -> Int -> String
move row col = esc "" [show col, show row] "H"

-- Relative cursor movements.
moveUp, moveDown, moveBack, moveForward :: Int -> String

moveUp      rs = esc "" [show rs] "A"
moveDown    rs = esc "" [show rs] "B"
moveBack    cs = esc "" [show cs] "D"
moveForward cs = esc "" [show cs] "C"

-- Load and store the current cursor position.
save :: String
save = esc "s" [] ""

load :: String
load = esc "u" [] ""

-- Generic function for creating (foreground) color sequences.
clr :: [String] -> String
clr codes = esc "" codes "m"

-- Create foreground and background colors.
fg :: Color -> [String]
fg c = [show ((num c :: Int) + 30)]

bg :: Color -> [String]
bg c = [show ((num c :: Int) + 40)]

-- Style modifiers.
normal, bold, faint, standout, underline, blink, inverse, invisible
  :: [String] -> [String]

normal    = ("0":)
bold      = ("1":)
faint     = ("2":)
standout  = ("3":)
underline = ("4":)
blink     = ("5":)
inverse   = ("7":)
invisible = ("8":)

-- Ansi color listing.

data Color =
    Black
  | Red
  | Green
  | Yellow
  | Blue
  | Magenta
  | Cyan
  | White
  | Reset
  deriving (Show, Eq)

-- Ansi codes offsets for color values.
num :: Num a => Color -> a
num Black   = 0
num Red     = 1
num Green   = 2
num Yellow  = 3
num Blue    = 4
num Magenta = 5
num Cyan    = 6
num White   = 7
num Reset   = 9

-- Shortcut functions for common actions.

-- Reset all color and style information.
reset :: String
reset = esc "" ["0", "39", "49"] "m"

-- Shortcut for setting foreground colors.
black, red, green, yellow, blue,
  magenta, cyan, white :: String

black   = clr $ fg Black
red     = clr $ fg Red
green   = clr $ fg Green
yellow  = clr $ fg Yellow
blue    = clr $ fg Blue
magenta = clr $ fg Magenta
cyan    = clr $ fg Cyan
white   = clr $ fg White

-- Shortcut for setting bold foreground colors.
blackBold, redBold, greenBold, yellowBold, blueBold,
  magentaBold, cyanBold, whiteBold :: String

blackBold   = clr $ bold $ fg Black
redBold     = clr $ bold $ fg Red
greenBold   = clr $ bold $ fg Green
yellowBold  = clr $ bold $ fg Yellow
blueBold    = clr $ bold $ fg Blue
magentaBold = clr $ bold $ fg Magenta
cyanBold    = clr $ bold $ fg Cyan
whiteBold   = clr $ bold $ fg White

-- Shortcut for setting background colors.
blackBg, redBg, greenBg, yellowBg, blueBg,
  magentaBg, cyanBg, whiteBg, resetBg :: String

blackBg   = clr $ bg Black
redBg     = clr $ bg Red
greenBg   = clr $ bg Green
yellowBg  = clr $ bg Yellow
blueBg    = clr $ bg Blue
magentaBg = clr $ bg Magenta
cyanBg    = clr $ bg Cyan
whiteBg   = clr $ bg White
resetBg   = clr $ bg Reset

-- Terminal geometry.

-- Try to read terminal width from environment variable.
width :: IO Int
width = (maybe 80 read . lookup "COLUMNS") <$> getEnvironment

-- Try to read terminal height from environment variable.
height :: IO Int
height = (maybe 24 read . lookup "LINES") <$> getEnvironment

-- Try to read terminal width and height from environment variables.
geometry :: IO (Int, Int)
geometry = (,) <$> width <*> height