packages feed

Hish 0.1.2.2 → 0.1.2.3

raw patch · 5 files changed

+104/−221 lines, 5 filesPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

API changes (from Hackage documentation)

- Hish.SysInfo: branch :: VCS a => a -> IO (Maybe String)
- Hish.SysInfo: isRepo :: VCS a => a -> IO Bool
- Hish.SysInfo: status :: VCS a => a -> IO (Maybe String, Maybe String, Maybe String)
- Hish.VCS: Darcs :: Darcs
- Hish.VCS: Git :: Git
- Hish.VCS: data Darcs
- Hish.VCS: data Git
- Hish.VCS: instance GHC.Show.Show Hish.VCS.Darcs
- Hish.VCS: instance GHC.Show.Show Hish.VCS.Git
- Hish.VCS: instance Hish.VCS.VCS Hish.VCS.Darcs
- Hish.VCS: instance Hish.VCS.VCS Hish.VCS.Git
- Hish.VCS: vcsAhead :: VCS a => a -> String -> Maybe String
- Hish.VCS: vcsBehind :: VCS a => a -> String -> Maybe String
- Hish.VCS: vcsCleanliness :: VCS a => a -> String -> Maybe String
- Hish.VCS: vcsCurrentBranch :: VCS a => a -> String -> Maybe String
+ Hish.VCS: getAhead :: VCS a => a -> String -> Maybe String
+ Hish.VCS: getBehind :: VCS a => a -> String -> Maybe String
+ Hish.VCS: getBranch :: VCS a => a -> IO (Maybe String)
+ Hish.VCS: getCleanliness :: VCS a => a -> String -> Maybe String
+ Hish.VCS: getStatus :: VCS a => a -> IO (Maybe String, Maybe String, Maybe String)
+ Hish.VCS: isRepo :: VCS a => a -> IO Bool
+ Hish.VCS: repoName :: VCS a => a -> String

Files

ChangeLog.md view
@@ -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
Hish.cabal view
@@ -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
src/Hish/SysInfo.hs view
@@ -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
src/Hish/VCS.hs view
@@ -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
src/hish.hs view
@@ -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