Hish 0.0.1 → 0.1.0

raw patch · 6 files changed

+239/−112 lines, 6 filesdep +regex-tdfaPVP ok

version bump matches the API change (PVP)

Dependencies added: regex-tdfa

API changes (from Hackage documentation)

Files

• Hish.cabal +11/−9
• README.md +15/−8
• hackage-docs.sh +47/−0
• src/Hish/ANSICode.hs +30/−28
• src/Hish/SysInfo.hs +89/−49
• src/hish.hs +47/−18

@@ -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

@@ -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

@@ -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"

@@ -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 = ""

@@ -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

@@ -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