diff --git a/ChangeLog.md b/ChangeLog.md --- a/ChangeLog.md +++ b/ChangeLog.md @@ -38,3 +38,10 @@ ## 0.1.2.2 -- 2015-10-22 * [m] bug fixed + +## 0.1.2.3 -- 2016-03-26 + +* [m] bug fixed +* [m] change the verifying method for git-status +* [+] new framework for VCS +* [+] separated dracs-related functions diff --git a/Hish.cabal b/Hish.cabal --- a/Hish.cabal +++ b/Hish.cabal @@ -1,5 +1,5 @@ Name: Hish -Version: 0.1.2.2 +Version: 0.1.2.3 Author: Yun-Yan Chi Maintainer: jaiyalas@gmail.com License: BSD3 @@ -45,5 +45,5 @@ , directory >= 1.2.2 && < 1.3 -- Source-Repository head - Type: git - location: https://github.com/jaiyalas/Hish.git + Type: git + location: https://github.com/jaiyalas/Hish.git diff --git a/src/Hish/SysInfo.hs b/src/Hish/SysInfo.hs --- a/src/Hish/SysInfo.hs +++ b/src/Hish/SysInfo.hs @@ -9,24 +9,21 @@ -- ** time and date , time , date - -- ** version control system - , status - , branch - , isRepo -- * Primitive functions , simpleCmd , argedCmd ) where - +-- import qualified System.Process as SP import System.Exit (ExitCode (..)) +-- import System.Directory (doesDirectoryExist) import Data.List (lines) +import Text.Regex.TDFA ((=~)) import qualified Data.String.Utils as S (split,replace) -- import qualified Data.Time.LocalTime as LT (getZonedTime) import Data.Time.Format as TF (formatTime, defaultTimeLocale) -- -import Hish.VCS -- | return username uid :: IO (Maybe String) @@ -42,36 +39,29 @@ pwd :: Int -- ^ threshold of shortening -> IO (Maybe String) pwd width = do - (code,out,_) <- exeCmd "pwd" [] "" + (code,out,_) <- SP.readProcessWithExitCode "pwd" [] "" mName <- uid case (code, mName) of (ExitSuccess, Just name) -> return $ return $ - ( (\str -> case head str of - '~' -> str - '/' -> str - _ -> '/':str ) - . (\str -> if (length str) > width - then shortDir $ S.split "/" str - else str) + ( (\str -> if (length str) > width + then shortenDir "" $ 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 ["A","B","C"] --- "A/B/C" --- -shortDir :: [String] -- ^ a list of folder name +-- | concating the given list of name into a path +shortenDir :: String -- ^ acc parameter + -> [String] -- ^ a list of folder name -> String -shortDir [] = "" -shortDir [l] = l -shortDir ("":xs) = shortDir xs -shortDir (('.':s):xs) = '.' : (head s) : '/' : shortDir xs -shortDir (x:xs) = (head x) : '/' : shortDir xs +shortenDir rs [] = "/" +shortenDir rs [l] = rs ++ ('/' : l) +shortenDir rs ("":xs) = shortenDir rs xs +shortenDir rs (x:xs) = + if (x =~ "\\`[A-Za-z0-9]" :: Bool) + then shortenDir (rs ++ '/' : take 1 x) xs + else shortenDir (rs ++ '/' : take 2 x) xs {- ========================================== -} @@ -94,44 +84,6 @@ {- ========================================== -} --- | 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) (statusCmd vcs) (statusArgs vcs) - 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) (branchCmd vcs) (branchArgs vcs) - --- | using status to verifying the existence of repository -isRepo :: VCS a => a -> IO Bool -isRepo vcs = do - (code,_,_) <- exeCmd (statusCmd vcs) (statusArgs vcs) "" - case code of - ExitFailure _ -> return False - ExitSuccess -> return True - -{- ========================================== -} - -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 @@ -144,7 +96,7 @@ -> [String] -- ^ command arguments -> IO (Maybe String) argedCmd handler cmd args = do - (code,stdout,_) <- exeCmd cmd args "" + (code,stdout,_) <- SP.readProcessWithExitCode cmd args "" case code of ExitFailure _ -> return Nothing ExitSuccess -> return $ (Just stdout) >>= handler diff --git a/src/Hish/VCS.hs b/src/Hish/VCS.hs --- a/src/Hish/VCS.hs +++ b/src/Hish/VCS.hs @@ -2,32 +2,11 @@ ( -- * Version Control System VCS (..) - -- ** Git - , Git (..) - -- ** Darcs - , Darcs (..) ) where - -import Text.Regex.TDFA ((=~)) -import qualified Data.String.Utils as S (replace) -import qualified Data.List as DL (lines) -import System.Directory (findExecutable) - +-- -- | Every version control system provides functions as follows -- class VCS a where - -- | tracking ahead - vcsAhead :: a -> String -> Maybe String - -- | tracking behind - vcsBehind :: a -> String -> Maybe String - -- | determining the cleanliness of working-tree - -- - -- * __' '__ - /clean/ - -- * __'?'__ - /clean/ (exists untracked file) - -- * __'#'__ - /dirty/ (non-empty index; ready for commit..) - -- * __'*'__ - /dirty/ (empty index) - vcsCleanliness :: a -> String -> Maybe String - vcsCurrentBranch :: a -> String -> Maybe String -- | get command for revealing branch branchCmd :: a -> String -- | get arguments for revealing branch @@ -36,83 +15,25 @@ statusCmd :: a -> String -- | get arguments for revealing status statusArgs :: a -> [String] + -- | get name of repository folder + repoName :: a -> String + -- | tracking ahead + getAhead :: a -> String -> Maybe String + -- | tracking behind + getBehind :: a -> String -> Maybe String + -- | determining the cleanliness of working-tree + -- * __' '__ - /clean/ + -- * __'?'__ - /clean/ (exists untracked file) + -- * __'#'__ - /dirty/ (non-empty index; ready for commit..) + -- * __'*'__ - /dirty/ (empty index) + getCleanliness :: a -> String -> Maybe String + -- | get current status + getStatus :: a -> IO (Maybe String, + Maybe String, + Maybe String) -- ^ (cleanliness, ahead, behind) + -- | get current name of git-branch + getBranch :: a -> IO (Maybe String) -- ^ current branch name + -- | using status to verifying the existence of repository + isRepo :: a -> IO Bool -- | is this vcs installed (= executable) installed :: a -> IO Bool - --- | Unit type for presenting Git. -data Git = Git - -instance Show Git where - show Git = "G" - -instance VCS Git where - vcsAhead _ s = - case (s =~ "ahead [0-9]+" :: String) of - [] -> Nothing - ahead -> Just $ S.replace "ahead " "" ahead - vcsBehind _ s = - case (s =~ "behind [0-9]+" :: String) of - [] -> Nothing - behind -> Just $ S.replace "behind " "" behind - vcsCleanliness _ s = let body = tail $ DL.lines s in - case body of - [] -> Just "" - _ -> let (index,tree) = unzip $ map ((\ (a:b:_)->(a,b)).take 2) body in case (filter (/=' ') index, filter (/=' ')tree) of - -- index == tree == " " - ("","") -> Just "" - -- every changes are in index - (_,"") -> Just "#" - -- none change is inindex - ("",_) -> Just "*" - (idx,tre) -> if ("" == (filter (/='?') (idx++tre))) - -- left only untracked file - then Just "?" - -- mix situiation - else Just "#" - vcsCurrentBranch _ = Just - . drop 2 - . head - . filter ((=='*').head) - . lines - -- - branchCmd _ = "git" - branchArgs _ = ["branch"] - statusCmd _ = "git" - statusArgs _ = ["status","--porcelain","-sb"] - -- - installed _ = do - ext <- findExecutable "git" - case ext of - Nothing -> return False - Just _ -> return True - --- | Unit type for presenting Darcs. --- /UN-IMPLEMENTED/! -data Darcs = Darcs - -instance Show Darcs where - show Darcs = "D" - -instance VCS Darcs where - vcsCleanliness _ ("No changes!") = Just "#" - vcsCleanliness _ s = let body = map head $ DL.lines s in - if ((filter (/='a') body)=="") then Just "?" else Just "*" - -- darcs is so hard to find ahead/behind - vcsAhead _ s = do - return "" - vcsBehind _ s = do - return "" - vcsCurrentBranch _ s = - -- darcs has no the concept of branch - return "" - -- - branchCmd Darcs = "darcs" - branchArgs Darcs = ["whatsnew"] - statusCmd Darcs = "darcs" - statusArgs Darcs = ["whatsnew","-l"] - -- - installed _ = do - ext <- findExecutable "darcs" - case ext of - Nothing -> return False - Just _ -> return True diff --git a/src/hish.hs b/src/hish.hs --- a/src/hish.hs +++ b/src/hish.hs @@ -1,78 +1,81 @@ +{-# LANGUAGE BangPatterns #-} module Main where - +-- import Hish.ANSICode -import qualified Hish.SysInfo as HS -import qualified Hish.VCS as VCS --- for manipulating ANSI code +import Hish.VCS +import Hish.VCS.Git +-- import Hish.VCS.Darcs +import qualified Hish.SysInfo as SysInfo +import qualified System.Process as SP +-- import Data.Monoid (mempty,(<>)) - +-- _prompt_symbol = ">" -_pwdWidth = 60 - +_pwdWidth = 45 +-- main :: IO () main = do - printUserInfo + -- printSTime + -- printUID + -- printHostname putStr " " printWorkingTree putStr " " -- - safePrintVCS VCS.Git - -- safePrintVCS VCS.Darcs + !b1 <- installed Git + !b2 <- isRepo Git + if (b1 && b2) then printVCSInfo Git else return () -- putStr $ applyANSI (_prompt_symbol++" ") $ mempty - -- -printUserInfo :: IO () -printUserInfo = do - _ts <- HS.time "%H:%M" - putStr $ applyANSI (_ts) $ fgBlackL <> mempty - -- putStr $ applyANSI "(" $ fgBlackL <> mempty - -- _un <- HS.uid - -- case _un of - -- Nothing -> return () - -- Just un -> putStr $ applyANSI (un) $ mempty - -- putStr $ applyANSI ")" $ fgBlackL <> mempty - -- _hn <- HS.hostname - -- case _hn of - -- Nothing -> return () - -- Just hn -> putStr $ applyANSI ("@"++hn) $ fgBlackL <> mempty -- -printWorkingTree :: IO () -printWorkingTree = do - _wd <- HS.pwd _pwdWidth - case _wd of - Nothing -> return () - Just wd -> putStr $ applyANSI wd $ fgGreen <> mempty --- -printVCSInfo :: (Show a, VCS.VCS a) => a -> IO () +printVCSInfo :: (Show a, VCS a) => a -> IO () printVCSInfo vcs = do - _br <- HS.branch vcs - (_st, _ah, _bh) <- HS.status vcs - --putStr $ show vcs - -- putStr "[" - case _br of - Just br -> putStr $ applyANSI br $ fgWhiteL <> ESC_Bold <> mempty - Nothing -> return () - case _st of + _br <- getBranch vcs + case _br of + Just br -> putStr $ applyANSI br $ ESC_Bold <> fgWhiteL <> mempty + Nothing -> return () + (_st, _ah, _bh) <- getStatus vcs + case _st of Just "*" -> putStr $ applyANSI "*" $ ESC_Bold <> fgYellowL <> mempty Just "?" -> putStr $ applyANSI "?" $ ESC_Bold <> fgMagentaL <> mempty Just "#" -> putStr $ applyANSI "#" $ ESC_Bold <> fgBlueL <> mempty _ -> putStr "" - case _ah of + case _ah of Nothing -> return () Just ah -> putStr $ applyANSI (if ah=="" then "" else "+"++ah) $ fgRedL <> mempty - case _bh of + case _bh of Nothing -> return () Just bh -> putStr $ applyANSI (if bh=="" then "" else "-"++bh) $ fgGreenL <> mempty - -- putStr "]" -- -safePrintVCS :: (Show a, VCS.VCS a) => a -> IO () -safePrintVCS vcs = do - b1 <- VCS.installed vcs - case b1 of - True -> do - b2 <- HS.isRepo vcs - if b2 then printVCSInfo vcs else return () - False -> return () +printSTime :: IO () +printSTime = do + _ts <- SysInfo.time "%H:%M" + putStr $ applyANSI (_ts) $ fgBlackL <> mempty + +-- +printUID :: IO () +printUID = do + _un <- SysInfo.uid + case _un of + Nothing -> return () + Just un -> do + putStr $ applyANSI "(" $ fgBlackL <> mempty + putStr $ applyANSI (un) $ mempty + putStr $ applyANSI ")" $ fgBlackL <> mempty +-- +printHostname :: IO () +printHostname = do + _hn <- SysInfo.hostname + case _hn of + Nothing -> return () + Just hn -> putStr $ applyANSI ("@"++hn) $ fgBlackL <> mempty +-- +printWorkingTree :: IO () +printWorkingTree = do + _wd <- SysInfo.pwd _pwdWidth + case _wd of + Nothing -> return () + Just wd -> putStr $ applyANSI wd $ fgGreen <> mempty