nptools-0.2.2: git-prompt.hs

import System.Console.ANSI
import System.Exit
import HSH
import Control.Monad
import Control.Applicative
import Data.Char
import Data.Maybe

-- tell Zsh to not count the contents for the length
noLength :: String -> String
noLength = ("%{"++) . (++"%}")

color :: Color -> String
color c
  = noLength $ setSGRCode [ SetConsoleIntensity BoldIntensity
                          , SetColor Foreground Dull c]

-- I didn't found how to generate sgr0 from Sys.Console.ANSI
sgr0 :: String
sgr0 = "\SI"

blue, magenta, green, red, noColor :: String
blue     = color Blue
magenta  = color Magenta
green    = color Green
red      = color Red
noColor  = noLength $ setSGRCode [] ++ sgr0

statsInfo :: IO String
statsInfo = do
  gitstat <-  fmap lines . run $ "git status 2> /dev/null"
         -|-  egrep "(# Untracked|# Changes|# Changed but not updated:|# Your branch)"
  let f msg   = listToMaybe . map digits $ egrep msg gitstat
      digits  = reverse . takeWhile isDigit . dropWhile (not . isDigit) . reverse
      ahead   = f "# Your branch is ahead of "
      behind  = f "# Your branch is behind "
  return . concat $
    [green
    ,['!' | "# Changes to be committed:"  `elem` gitstat]
    ,['?' | "# Untracked files:"          `elem` gitstat
         || "# Changed but not updated:"  `elem` gitstat]
    ,maybe "" ((blue++":"++green++"-")++) behind
    ,maybe "" ((blue++":"++green++"+")++) ahead
    ]

isBareRepo :: IO Bool
isBareRepo = readbool =<< run "git config core.bare"
  where readbool "false\n"  = return False
        readbool "true\n"   = return True
        readbool s          = fail ("Unexpected result: " ++ show s)

cond :: a -> a -> Bool -> a
cond x y b = if b then x else y

main :: IO ()
main = do
  ref <- head . lines <$> run "git symbolic-ref HEAD 2> /dev/null"
  when (null ref) exitFailure
  stats <- catch statsInfo . const $
             ((blue++":")++) . cond (green ++ "bare") (red ++ "ERR")
               <$> isBareRepo
  putStrLn . concat $
    ["±"
    ,blue,":",magenta,drop (length "refs/heads/") ref
    ,stats
    ,noColor]