module Hish.VCS ( -- * 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 branchArgs :: a -> [String] -- | get command for revealing status statusCmd :: a -> String -- | get arguments for revealing status statusArgs :: a -> [String] -- | 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