diff --git a/Hish.cabal b/Hish.cabal --- a/Hish.cabal +++ b/Hish.cabal @@ -1,16 +1,16 @@ Name: Hish -Version: 0.0.1 +Version: 0.1.0 Author: Yun-Yan Chi Maintainer: jaiyalas@gmail.com License: BSD3 License-File: LICENSE -- Synopsis: -Description: Prompt program for Fish shell written in Haskell +Description: Generating a beautiful and useful prompt. Homepage: https://github.com/jaiyalas/Hish Bug-reports: https://github.com/jaiyalas/Hish/issues Cabal-Version: >= 1.12 Build-Type: Simple -Extra-Source-Files: README.md, ChangeLog.md +Extra-Source-Files: README.md, ChangeLog.md, hackage-docs.sh category: Command Line, Console, Shell -- @@ -20,9 +20,10 @@ default-language: Haskell2010 hs-source-dirs: src ghc-options: -w - build-depends: base >= 4 && < 5 - , MissingH >= 1.2 - , process >= 1.2 + build-depends: base >= 4 && < 5 + , MissingH >= 1.2 + , process >= 1.2 + , regex-tdfa >= 1.2 exposed-modules: Hish.ANSICode Hish.SysInfo @@ -33,9 +34,10 @@ hs-source-dirs: src main-is: hish.hs ghc-options: -w - build-depends: base >= 4 && < 5 - , MissingH >= 1.2 - , process >= 1.2 + build-depends: base >= 4 && < 5 + , MissingH >= 1.2 + , process >= 1.2 + , regex-tdfa >= 1.2 -- Source-Repository head Type: git diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -4,22 +4,29 @@ [![MIT](http://b.repl.ca/v1/license-BSD3-blue.png)](https://en.wikipedia.org/wiki/BSD_licenses) [![Haskell](http://b.repl.ca/v1/language-haskell-orange.png)](http://haskell.org) -Prompt program for Fish shell written in Haskell +Generating a beautiful and useful prompt. ## Features ### Done -+ show **git status** - + "#" for *clean* - + "\*" for *dirty* -+ show **git branch** -+ show **working directory** - + be shortened if too long ++ [X] show **user name** ++ [X] show **host name** ++ [X] show **working directory** + + will be shortened if too long ++ [X] show **branch name (git only)** ++ [X] show **index/tree status (git only)** + + *\** - dirty + + *?* - clean *but still having untracked files* + + *#* - clean ++ [X] show **tracking status (git only)** + + *+n* - branch is *ahead* by n + + *-n* - branch is *behind* by n ++ [X] Basic ANSI color ### Todo -+ [ ] distinguish the cases of *clean* and *up-to-date* ++ [ ] support *darcs* + [ ] show *time* + [ ] implement *color theme* + [ ] show *SSH* info diff --git a/hackage-docs.sh b/hackage-docs.sh new file mode 100644 --- /dev/null +++ b/hackage-docs.sh @@ -0,0 +1,47 @@ +#!/bin/bash +set -e + +if [ "$#" -ne 1 ]; then + echo "Usage: hackage-docs.sh HACKAGE_USER" + exit 1 +fi + +user=$1 + +cabal_file=$(find . -maxdepth 1 -name "*.cabal" -print -quit) +if [ ! -f "$cabal_file" ]; then + echo "Run this script in the top-level package directory" + exit 1 +fi + +pkg=$(awk -F ":[[:space:]]*" 'tolower($1)=="name" { print $2 }' < "$cabal_file") +ver=$(awk -F ":[[:space:]]*" 'tolower($1)=="version" { print $2 }' < "$cabal_file") + +if [ -z "$pkg" ]; then + echo "Unable to determine package name" + exit 1 +fi + +if [ -z "$ver" ]; then + echo "Unable to determine package version" + exit 1 +fi + +echo "Detected package: $pkg-$ver" + +dir=$(mktemp -d build-docs.XXXXXX) + +trap 'rm -Rf "$dir"' EXIT + +cabal haddock --hoogle --hyperlink-source --html-location='/package/$pkg-$version/docs' --contents-location='/package/$pkg-$version' + +cp -R dist/doc/html/$pkg/ $dir/$pkg-$ver-docs + +tar cvz -C $dir --format=ustar -f $dir/$pkg-$ver-docs.tar.gz $pkg-$ver-docs + +curl -X PUT \ + -H 'Content-Type: application/x-tar' \ + -H 'Content-Encoding: gzip' \ + -u "$user" \ + --data-binary "@$dir/$pkg-$ver-docs.tar.gz" \ + "https://hackage.haskell.org/package/$pkg-$ver/docs" diff --git a/src/Hish/ANSICode.hs b/src/Hish/ANSICode.hs --- a/src/Hish/ANSICode.hs +++ b/src/Hish/ANSICode.hs @@ -1,9 +1,10 @@ module Hish.ANSICode - ( ANSICode (..) - , esc - , (<>) + ( + -- * The ANSICode + ANSICode (..) + -- ** Utilities , applyANSI - -- + -- ** Preset colors , fgBlack , fgRed , fgGreen @@ -41,19 +42,23 @@ , bgWhiteL ) where +import Data.Monoid (mempty,(<>)) + -- | Encoding ANSI-code data ANSICode = ESC_Bold | ESC_Underline | ESC_Reverse | ESC_Reset - | ESC_Fg {fg :: Int} - | ESC_Bg {bg :: Int} + | ESC_Fg + { -- | foreground color + fg :: Int} + | ESC_Bg + { -- | background color + bg :: Int} | ESC_Setup - { -- | (foreground, background, other) - body :: (Int,Int,Int) - } - deriving Show - + { -- | (foreground, background, other) + body :: (Int,Int,Int)} + deriving (Show,Eq) instance Monoid ANSICode where mempty = ESC_Setup (0,0,0) @@ -64,25 +69,22 @@ mappend (ESC_Fg fc) (ESC_Setup (f,b,i)) = ESC_Setup (fc,b,0) mappend (ESC_Bg bc) (ESC_Setup (f,b,i)) = ESC_Setup (f,bc,0) --- | alias of mempty -esc :: ANSICode -esc = mempty - --- | alias of mappend -(<>) :: ANSICode -> ANSICode -> ANSICode -x <> y = mappend x y -infixr 6 <> - --- | apply ANSI setting onto a given string -applyANSI :: String -- ^ content +-- | apply ANSI setting onto the given string. +-- For example, +-- +-- >>> applyANSI "haskell" (fgCyanL <> ESC_Bold <> mempty) +-- "\ESC[96;1m\STXhaskell\ESC[0m\STX" +-- +applyANSI :: String -- ^ input string -> ANSICode -- ^ ANSI setting -> String -applyANSI s (ESC_Setup (f,b,i)) | f == 0, b == 0, i == 0 = "\ESC[0m\STX"++s - | f == 0, b == 0, i == 1 = "\ESC[1m\STX"++s++"\ESC[0m\STX" - | f == 0, b == 0, i == 4 = "\ESC[4m\STX"++s++"\ESC[0m\STX" - | i == 0 = "\ESC["++(showC f)++(showC b)++"m\STX"++s++"\ESC[0m\STX" - | i == 1 = "\ESC["++(showC f)++(showC b)++"1m\STX"++s++"\ESC[0m\STX" - | i == 4 = "\ESC["++(showC f)++(showC b)++"4m\STX"++s++"\ESC[0m\STX" +applyANSI s (ESC_Setup (f,b,i)) + | f == 0, b == 0, i == 0 = "\ESC[0m\STX"++s + | f == 0, b == 0, i == 1 = "\ESC[1m\STX"++s++"\ESC[0m\STX" + | f == 0, b == 0, i == 4 = "\ESC[4m\STX"++s++"\ESC[0m\STX" + | i == 0 = "\ESC["++(showC f)++(showC b)++"m\STX"++s++"\ESC[0m\STX" + | i == 1 = "\ESC["++(showC f)++(showC b)++"1m\STX"++s++"\ESC[0m\STX" + | i == 4 = "\ESC["++(showC f)++(showC b)++"4m\STX"++s++"\ESC[0m\STX" showC :: Int -> String showC 0 = "" diff --git a/src/Hish/SysInfo.hs b/src/Hish/SysInfo.hs --- a/src/Hish/SysInfo.hs +++ b/src/Hish/SysInfo.hs @@ -1,65 +1,105 @@ module Hish.SysInfo - ( status - , branch + ( + -- * Get basic information + uid + , hostname , pwd - , uid - )where + , shortDir + -- * Get VCS-related information + , status + , branch + -- * Primitive functions + , simpleCmd + , argedCmd + ) where -import System.Process -import System.Exit +import qualified System.Process as SP +import System.Exit (ExitCode (..)) import Data.List (lines,unlines) import Data.Char (isSpace) import qualified Data.String.Utils as S (split,replace,join) --- | Obtain current git-status. --- Returning "#" for clean working directory. --- Returning "*" for dirty working directory. -status :: IO String -status = do - (code,out,_) <- readProcessWithExitCode "git" ["status","--porcelain"] "" - case code of - ExitFailure _ -> return "" - ExitSuccess -> return $ - ((\b->if b then "#" else "*") - .null - .map head.lines - ) out --- | Obtain current name of git-branch -branch :: IO String -branch = do - (code,out,_) <- readProcessWithExitCode "git" ["branch"] "" - case code of - ExitFailure _ -> return "" - ExitSuccess -> return $ - (drop 1 - .head.takeWhile (('*'==).head) -- take current br - .lines.filter (/=' ') -- rm ' ';split by '\n' - ) out --- | Obtain current working directory +import Hish.VCS + +-- | return username +uid :: IO (Maybe String) +uid = simpleCmd (Just . init) "whoami" + +-- | return hostname +hostname :: IO (Maybe String) +hostname = argedCmd (Just . init) "hostname" ["-s"] + +-- | return current working directory pwd :: Int -- ^ threshold of shortening - -> IO String + -> IO (Maybe String) pwd width = do - (code,out,_) <- readProcessWithExitCode "pwd" [] "" - name <- uid - case code of - ExitFailure _ -> return "" - ExitSuccess -> return $ + (code,out,_) <- exeCmd "pwd" [] "" + mName <- uid + case (code, mName) of + (ExitSuccess, Just name) -> return $ return $ ( (\str -> if (head str) == '~' then str else '/':str ) . (\str -> if (length str) > width - then pwdShorten $ S.split "/" str + then shortDir $ S.split "/" str else str) . S.replace ("/Users/"++name) "~" . filter (/='\n') ) $ out + otherwise -> return Nothing + +-- | concating the given list of name into a path. +-- Notice that, this function will __NOT__ add root, __/__, or home, __~__, +-- to the leftmost position. For example, -- -pwdShorten :: [String] -> String -pwdShorten [] = "" -pwdShorten [l] = l -pwdShorten (x:xs) = (head x) : '/' : pwdShorten xs --- | Obtain username -uid :: IO String -uid = do - (code,name,_) <- readProcessWithExitCode "whoami" [] "" - case code of - ExitFailure _ -> return "" - ExitSuccess -> return $ filter (/='\n') $ name +-- >>> pwdShorten ["A","B","C"] +-- "A/B/C" +-- +shortDir :: [String] -- ^ a list of folder name + -> String +shortDir [] = "" +shortDir [l] = l +shortDir (x:xs) = (head x) : '/' : shortDir xs + +-- | get current status. +status :: VCS a => a -- ^ version control system + -> IO (Maybe String, + Maybe String, + Maybe String) -- ^ (cleanliness, ahead, behind) +status vcs = do + maybeText <- argedCmd (Just . id) "git" ["status","--porcelain","-sb"] + case maybeText of + Nothing -> return + ( Nothing + , Nothing + , Nothing ) + (Just text) -> return + ( vcsCleanliness vcs text + , vcsAhead vcs text + , vcsBehind vcs text ) + +-- | get current name of git-branch +branch :: VCS a => a -- ^ version control system + -> IO (Maybe String) -- ^ current branch name +branch vcs = argedCmd (vcsCurrentBranch vcs) "git" ["branch"] + +exeCmd :: String + -> [String] + -> String + -> IO (ExitCode, String, String) +exeCmd = SP.readProcessWithExitCode + +-- | execute command with text handler but without args +simpleCmd :: (String -> Maybe String) -- ^ translate raw text to information + -> String -- ^ console command + -> IO (Maybe String) +simpleCmd handler cmd = argedCmd handler cmd [] + +-- | execute command with text handler and args +argedCmd :: (String -> Maybe String) -- ^ translate raw text to information + -> String -- ^ console command + -> [String] -- ^ command arguments + -> IO (Maybe String) +argedCmd handler cmd args = do + (code,stdout,_) <- exeCmd cmd args "" + case code of + ExitFailure _ -> return Nothing + ExitSuccess -> return $ (Just stdout) >>= handler diff --git a/src/hish.hs b/src/hish.hs --- a/src/hish.hs +++ b/src/hish.hs @@ -1,28 +1,57 @@ module Main where import Hish.ANSICode -import Hish.SysInfo +import qualified Hish.SysInfo as HS +import qualified Hish.VCS as VCS +import Data.Monoid (mempty,(<>)) + -- _prompt_symbol = ">" _pwdWidth = 60 main :: IO () main = do - st <- status - br <- branch - wd <- pwd _pwdWidth - -- show GIT BRANCH - putStr $ applyANSI wd $ fgGreen <> esc - case br of - "" -> putStr "" - _ -> do - putStr " " - putStr $ applyANSI br $ fgBlueL <> esc - -- show GIT STATUS - case st of - "*" -> putStr $ applyANSI st $ ESC_Bold <> fgRedL <> esc - "#" -> putStr $ applyANSI st $ ESC_Bold <> fgGreen <> esc - _ -> putStr "" - -- show PROMPT SYMBOL - putStr $ applyANSI (_prompt_symbol++" ") $ fgWhiteL <> esc + _un <- HS.uid + case _un of + Nothing -> return () + Just un -> putStr $ applyANSI un $ fgBlackL <> mempty + -- + _hn <- HS.hostname + case _hn of + Nothing -> return () + Just hn -> putStr $ applyANSI ("@"++hn) $ fgBlackL <> mempty + -- + putStr " " + _wd <- HS.pwd _pwdWidth + case _wd of + Nothing -> return () + Just wd -> putStr $ applyANSI wd $ fgGreen <> mempty + -- + putStr " " + -- + putStr "[" + -- + _br <- HS.branch VCS.Git + case _br of + Nothing -> return () + Just br -> putStr $ applyANSI br $ fgWhiteL <> ESC_Bold <> mempty + (_st, _ah, _bh) <- HS.status VCS.Git + -- + case _st of + Just "*" -> putStr $ applyANSI "*" $ ESC_Bold <> fgRed <> mempty + Just "?" -> putStr $ applyANSI "?" $ ESC_Bold <> fgYellow <> mempty + Just "#" -> putStr $ applyANSI "#" $ ESC_Bold <> fgGreen <> mempty + _ -> putStr "" + -- + case _ah of + Nothing -> return () + Just ah -> putStr $ applyANSI ("+"++ah) $ fgRedL <> mempty + -- + case _ah of + Nothing -> return () + Just ah -> putStr $ applyANSI ("-"++ah) $ fgGreenL <> mempty + -- + putStr "]" + -- + putStr $ applyANSI (_prompt_symbol++" ") $ mempty