diff --git a/.gitignore b/.gitignore index a6d30c82..d54c0a71 100644 --- a/.gitignore +++ b/.gitignore @@ -4,6 +4,7 @@ # Directories src/.bin .cache/ +**/.hpc **/__pycache__ .pytest_cache **/.stack-work diff --git a/.travis.yml b/.travis.yml index e698f721..08cad287 100644 --- a/.travis.yml +++ b/.travis.yml @@ -22,15 +22,7 @@ matrix: # You could also do things like change flags or # use --stack-yaml to point to a different file. - env: ARGS="" - python: "2.7" - - env: ARGS="--resolver lts-2" - python: "2.7" - - env: ARGS="--resolver lts-3" - python: "2.7" - - env: ARGS="--resolver lts" - python: "2.7" - - env: ARGS="--resolver nightly" - python: "2.7" + ghc: "8.2.2" # # GHC depends on GMP. You can add other dependencies here as well. addons: @@ -40,6 +32,9 @@ addons: # Download and unpack the stack executable for haskell, else pip deps. install: + - sudo add-apt-repository ppa:duggan/bats --yes + - sudo apt-get update -qq + - sudo apt-get install -qq bats - if [ "$ARGS" = "python" ]; then pip install tox; else @@ -55,7 +50,10 @@ script: - if [ "$ARGS" = "python" ]; then tox; else - stack $ARGS --no-terminal --install-ghc test --haddock; + stack $ARGS --no-terminal --install-ghc test --haddock --coverage; + export PATH=/home/travis/build/madnight/zsh-git-prompt/src/.bin:$PATH; + stack install; + bats src/test/test.sh; fi # Caching so the next build will be fast too. diff --git a/src/app/Main.hs b/src/app/Main.hs index 1a9fbcea..395db9cf 100644 --- a/src/app/Main.hs +++ b/src/app/Main.hs @@ -1,37 +1,111 @@ -import System.Process (readProcessWithExitCode) -import System.Exit (ExitCode(ExitSuccess)) -import System.IO.Unsafe (unsafeInterleaveIO) +import Utils (safeRun, stringsFromStatus, readHandler, + fromBool, strip, Hash(MkHash)) -import Utils (stringsFromStatus, Hash(MkHash)) +import Control.Monad (when) +import Data.Git.Ref() +import Data.Git.Storage (findRepoMaybe) +import Data.List (isInfixOf, isPrefixOf) +import Data.List.Split (splitOn) import Data.Maybe (fromMaybe) +import Filesystem.Path.CurrentOS (encodeString) +import System.Directory (doesFileExist) +import System.Environment (lookupEnv) +import System.FilePath (()) +import System.IO.Unsafe (unsafeInterleaveIO) +import System.Posix.IO (stdInput) +import System.Posix.Terminal (queryTerminal) +import System.Exit (exitSuccess) -{- Git commands -} +import qualified Control.Exception.Base as E -successOrNothing :: (ExitCode, a, b) -> Maybe a -successOrNothing (exitCode, output, _) = - if exitCode == ExitSuccess then Just output else Nothing +gitrevparse :: IO (Maybe Hash) +gitrevparse = do + mresult <- safeRun "git" ["rev-parse", "--short", "HEAD"] + return $ MkHash . init <$> mresult -safeRun :: String -> [String] -> IO (Maybe String) -safeRun command arguments = - do -- IO - output <- readProcessWithExitCode command arguments "" - return (successOrNothing output) +getStashCount :: FilePath -> IO Int +getStashCount repo = + countLinesInFile $ repo "logs" "refs" "stash" + where + countLinesInFile :: String -> IO Int + countLinesInFile f = length . lines <$> E.catch (readFile f) readHandler -gitrevparse :: IO (Maybe Hash) -gitrevparse = do -- IO - mresult <- safeRun "git" ["rev-parse", "--short", "HEAD"] - let rev = do -- Maybe - result <- mresult - return (MkHash (init result)) - return rev +-- | Determine the rebase status of this repostitory and return it. +-- | Args: git root +-- | Returns: +-- | - "0": No active rebase +-- | - "1/4": Rebase in progress, commit 1 of 4 +rebaseProgess :: FilePath -> IO String +rebaseProgess repo = do + let readRebase = readFile . ((repo "rebase-apply") ) + next <- E.catch (readRebase "next") readHandler + last' <- E.catch (readRebase "last") readHandler + if length (last' ++ next) < 1 + then pure "0" + else pure $ strip next ++ "/" ++ strip last' + +isMergeInProgess :: FilePath -> IO Bool +isMergeInProgess = doesFileExist . ( "MERGE_HEAD") + +parseBranch :: String -> FilePath -> IO (String, String, Int) +parseBranch status repo + | "..." `isInfixOf` status = do + let getBranch = splitOn "..." . head . tail $ words status + let branch = head getBranch + let upstream = last getBranch + pure (branch, upstream, 0) + | "no branch" `isInfixOf` status = do + let readHead = readFile $ repo "HEAD" + head' <- E.catch readHead readHandler + let hashPrefixEnv = "ZSH_THEME_GIT_PROMPT_HASH_PREFIX" + sym_prehash <- fromMaybe ":" <$> lookupEnv hashPrefixEnv + pure (sym_prehash ++ take 7 head', "..", 0) + | "Initial Commit" `isPrefixOf` status + || isPrefixOf "No commits yet" status = do + let branch = last $ words status + pure (branch, "..", 1) + | otherwise = pure (head . tail $ words status, "..", 1) + +parse :: String -> IO () +parse status = do + maybeRepo <- (fmap . fmap) encodeString findRepoMaybe + let repo = fromMaybe mempty maybeRepo + when (null repo) $ exitSuccess + stashCount <- getStashCount repo + merge <- isMergeInProgess repo + rebase <- rebaseProgess repo + mhash <- unsafeInterleaveIO gitrevparse + (_, upstream, local) <- parseBranch status repo + let parseStatus = maybe mempty unwords . stringsFromStatus mhash + let echo = putStr . (' ' :) -{- main -} + -- 0. The branch. + -- 1. If branch is tracked upstream, number of commits behind. + -- 2. If branch is tracked upstream, number of commits ahead. + -- 3. The number of staged files. + -- 4. The number of conflict files (i.e. unmerged). + -- 5. The number of changed files (i.e. tracked and edited) + -- 6. The number of untracked files (does not include ignored). + putStr $ parseStatus status -- e.g. master 0 0 0 0 0 0 + -- 7. The number of stashes on the current repository. + echo $ show stashCount + -- 8. 1 iff we are on a branch and that branch has no upstream tracking set. + echo $ show local + -- 9. The name of the upstream remote/branch set to track, e.g. origin/master + echo upstream + -- 10. 1 iff engaged in a merge operation. 0 otherwise. + echo . show $ fromBool merge + -- 11. rebase indicator, format m/n, m is the current commit we are checked + -- out on to resolve / n is the total no of commits to, 0 otherwise. + echo rebase main :: IO () -main = do -- IO - status <- getContents - mhash <- unsafeInterleaveIO gitrevparse -- defer the execution until we know we need the hash - let result = do -- Maybe - strings <- stringsFromStatus mhash status - return (unwords strings) - putStr (fromMaybe "" result) +main = do + isTTY <- queryTerminal stdInput + if isTTY + then do -- run status command + status <- safeRun "git" ["status", "--porcelain", "--branch"] + case status of + Nothing -> exitSuccess + Just s -> parse s + else getContents >>= parse -- get status from stdin diff --git a/src/default.nix b/src/default.nix new file mode 100644 index 00000000..52b10522 --- /dev/null +++ b/src/default.nix @@ -0,0 +1,40 @@ +{ nixpkgs ? import {}, compiler ? "default", doBenchmark ? false }: + +let + + inherit (nixpkgs) pkgs; + + f = { mkDerivation, base, directory, filepath, git, HUnit, parsec + , process, QuickCheck, split, stdenv, system-filepath, unix + }: + mkDerivation { + pname = "git-prompt"; + version = "0.1.0.0"; + src = ./.; + isLibrary = true; + isExecutable = true; + libraryHaskellDepends = [ + base directory filepath git parsec process QuickCheck split + system-filepath unix + ]; + executableHaskellDepends = [ + base directory filepath git parsec process QuickCheck split + system-filepath unix + ]; + testHaskellDepends = [ base HUnit parsec process QuickCheck ]; + homepage = "http://github.com/olivierverdier/zsh-git-prompt#readme"; + description = "Informative git prompt for zsh"; + license = stdenv.lib.licenses.mit; + }; + + haskellPackages = if compiler == "default" + then pkgs.haskellPackages + else pkgs.haskell.packages.${compiler}; + + variant = if doBenchmark then pkgs.haskell.lib.doBenchmark else pkgs.lib.id; + + drv = variant (haskellPackages.callPackage f {}); + +in + + if pkgs.lib.inNixShell then drv.env else drv diff --git a/src/git-prompt.cabal b/src/git-prompt.cabal index 9e3d2112..9bd60a42 100644 --- a/src/git-prompt.cabal +++ b/src/git-prompt.cabal @@ -15,19 +15,18 @@ cabal-version: >=1.10 library hs-source-dirs: src exposed-modules: Utils, BranchParse, StatusParse - build-depends: base, parsec >=3.1, process>=1.1.0.2, QuickCheck + build-depends: base, parsec >=3.1, process>=1.1.0.2, QuickCheck, git, unix, system-filepath, directory, filepath, split default-language: Haskell2010 - ghc-options: -Wall -O2 -fno-warn-tabs -fno-warn-unused-do-bind - cc-options: -O3 + ghc-options: -Wall -O2 -funfolding-use-threshold=16 + cc-options: -Ofast executable gitstatus hs-source-dirs: app main-is: Main.hs - ghc-options: -threaded -rtsopts -with-rtsopts=-N - build-depends: base, git-prompt, parsec >=3.1, process>=1.1.0.2, QuickCheck + build-depends: base, git-prompt, parsec >=3.1, process>=1.1.0.2, QuickCheck, git, unix, system-filepath, directory, filepath, split default-language: Haskell2010 - ghc-options: -Wall -O2 -fno-warn-tabs -fno-warn-unused-do-bind - cc-options: -O3 + ghc-options: -Wall -O2 -funfolding-use-threshold=16 + cc-options: -Ofast test-suite tests-branch @@ -35,7 +34,7 @@ test-suite tests-branch hs-source-dirs: test main-is: TestBranchParse.hs build-depends: base, git-prompt, parsec >=3.1, process>=1.1.0.2, QuickCheck, HUnit >= 1.2 - ghc-options: -Wall -O2 -fno-warn-tabs -fno-warn-unused-do-bind + ghc-options: -Wall -O2 -funfolding-use-threshold=16 default-language: Haskell2010 test-suite tests-functional @@ -43,7 +42,7 @@ test-suite tests-functional hs-source-dirs: test main-is: TestFunctional.hs build-depends: base, git-prompt, parsec >=3.1, process>=1.1.0.2, QuickCheck, HUnit >= 1.2 - ghc-options: -Wall -O2 -fno-warn-tabs -fno-warn-unused-do-bind + ghc-options: -Wall -O2 -funfolding-use-threshold=16 default-language: Haskell2010 source-repository head diff --git a/src/src/BranchParse.hs b/src/src/BranchParse.hs index 83fb5025..057a9627 100644 --- a/src/src/BranchParse.hs +++ b/src/src/BranchParse.hs @@ -2,56 +2,55 @@ module BranchParse where import Control.Applicative (liftA, liftA2) import Text.Parsec (digit, string, char, eof, anyChar, - many, many1, manyTill, noneOf, between, - parse, ParseError, (<|>), try) + many, many1, manyTill, noneOf, between, + parse, ParseError, (<|>), try) import Text.Parsec.String (Parser) import Test.QuickCheck (Arbitrary(arbitrary), oneof, getPositive, suchThat) import Data.List (isPrefixOf, isSuffixOf, isInfixOf) +import Control.Monad (void) {- The idea is to parse the first line of the git status command. Such a line may look like: - ## master + ## master or - ## master...origin/master + ## master...origin/master or - ## master...origin/master [ahead 3, behind 4] + ## master...origin/master [ahead 3, behind 4] -} data Distance = Ahead Int | Behind Int | AheadBehind Int Int deriving (Eq) instance Show Distance where - show (Ahead i) = "[ahead " ++ show i ++ "]" - show (Behind i) = "[behind " ++ show i ++ "]" - show (AheadBehind i j) ="[ahead " ++ show i ++ ", behind " ++ show j ++ "]" + show (Ahead i) = "[ahead " ++ show i ++ "]" + show (Behind i) = "[behind " ++ show i ++ "]" + show (AheadBehind i j) ="[ahead " ++ show i ++ ", behind " ++ show j ++ "]" instance Arbitrary Distance where - arbitrary = oneof [ - liftA Ahead pos, - liftA Behind pos, - liftA2 AheadBehind pos pos] - where - pos = liftA getPositive arbitrary + arbitrary = oneof [ + liftA Ahead pos, + liftA Behind pos, + liftA2 AheadBehind pos pos] + where + pos = liftA getPositive arbitrary {- Branch type -} newtype Branch = MkBranch String deriving (Eq) instance Show Branch where - show (MkBranch b) = b + show (MkBranch b) = b isValidBranch :: String -> Bool isValidBranch b = not (or (isForbidden b)) where - isForbidden s = do -- List - forbidden <- [null, (' ' `elem`), (".." `isInfixOf`), ("." `isPrefixOf`), ("." `isSuffixOf`)] - return (forbidden s) + isForbidden s = do -- List + forbidden <- [null, (' ' `elem`), (".." `isInfixOf`), ("." `isPrefixOf`), ("." `isSuffixOf`)] + return (forbidden s) instance Arbitrary Branch where - arbitrary = - do -- Gen - branch <- arbitrary `suchThat` isValidBranch - return (MkBranch branch) + arbitrary = + MkBranch <$> arbitrary `suchThat` isValidBranch data Remote = MkRemote Branch (Maybe Distance) deriving (Eq, Show) @@ -63,89 +62,74 @@ data BranchInfo = MkBranchInfo Branch (Maybe Remote) deriving (Eq, Show) type MBranchInfo = Maybe BranchInfo newRepo :: Parser MBranchInfo -newRepo = - do -- Parsec - string "Initial commit on " - branchOnly +newRepo = string "Initial commit on " >> branchOnly noBranch :: Parser MBranchInfo noBranch = - do -- Parsec - manyTill anyChar (try (string " (no branch)")) - eof - return Nothing + manyTill anyChar (try (string " (no branch)")) >> eof >> pure Nothing trackedBranch :: Parser Branch -trackedBranch = - do -- Parsec - b <- manyTill anyChar (try (string "...")) - return (MkBranch b) +trackedBranch = MkBranch <$> manyTill anyChar (try (string "...")) branchRemoteTracking :: Parser MBranchInfo -branchRemoteTracking = - do -- Parsec - branch <- trackedBranch - tracking <- many (noneOf " ") - char ' ' - behead <- inBrackets - let remote = MkRemote (MkBranch tracking) (Just behead) - let bi = MkBranchInfo branch (Just remote) - return (Just bi) +branchRemoteTracking = do + branch <- trackedBranch + tracking <- many (noneOf " ") + void $ char ' ' + behead <- inBrackets + let remote = MkRemote (MkBranch tracking) (Just behead) + let bi = MkBranchInfo branch (Just remote) + return (Just bi) branchRemote :: Parser MBranchInfo -branchRemote = - do -- Parsec - branch <- trackedBranch - tracking <- many (noneOf " ") - eof - let remote = MkRemote (MkBranch tracking) Nothing - let bi = MkBranchInfo branch (Just remote) - return (Just bi) +branchRemote = do + branch <- trackedBranch + tracking <- many (noneOf " ") + eof + let remote = MkRemote (MkBranch tracking) Nothing + let bi = MkBranchInfo branch (Just remote) + return (Just bi) branchOnly :: Parser MBranchInfo -branchOnly = - do -- Parsec - branch <- many (noneOf " ") - eof - let bi = MkBranchInfo (MkBranch branch) Nothing - return (Just bi) +branchOnly = do + branch <- many $ noneOf " " + eof + let bi = MkBranchInfo (MkBranch branch) Nothing + return (Just bi) branchParser :: Parser MBranchInfo -branchParser = - try noBranch - <|> try newRepo - <|> try branchRemoteTracking - <|> try branchRemote - <|> branchOnly +branchParser = try noBranch + <|> try newRepo + <|> try branchRemoteTracking + <|> try branchRemote + <|> branchOnly branchParser' :: Parser MBranchInfo -branchParser' = - do -- Parsec - string "## " - branchParser +branchParser' = string "## " >> branchParser inBrackets :: Parser Distance -inBrackets = between (char '[') (char ']') (behind <|> try aheadBehind <|> ahead) +inBrackets = + between (char '[') (char ']') $ behind <|> try aheadBehind <|> ahead makeAheadBehind :: String -> (Int -> Distance) -> Parser Distance -makeAheadBehind name constructor = - do -- Parsec - string (name ++ " ") - dist <- many1 digit - return (constructor (read dist)) +makeAheadBehind name constructor = do + void $ string (name ++ " ") + dist <- many1 digit + return (constructor (read dist)) ahead :: Parser Distance ahead = makeAheadBehind "ahead" Ahead + behind :: Parser Distance behind = makeAheadBehind "behind" Behind + aheadBehind :: Parser Distance -aheadBehind = - do -- Parsec - Ahead aheadBy <- ahead - string ", " - Behind behindBy <- behind - return (AheadBehind aheadBy behindBy) +aheadBehind = do + Ahead aheadBy <- ahead + void $ string ", " + Behind behindBy <- behind + return (AheadBehind aheadBy behindBy) branchInfo :: String -> Either ParseError MBranchInfo branchInfo = parse branchParser' "" diff --git a/src/src/StatusParse.hs b/src/src/StatusParse.hs index cb26d39a..c737aec6 100644 --- a/src/src/StatusParse.hs +++ b/src/src/StatusParse.hs @@ -5,10 +5,10 @@ import Data.Traversable (for) {- Full status information -} data Status a = MakeStatus { - staged :: a, - conflict :: a, - changed :: a, - untracked :: a} deriving (Eq, Show) + staged :: a, + conflict :: a, + changed :: a, + untracked :: a} deriving (Eq, Show) {- The two characters starting a git status line: -} data MiniStatus = MkMiniStatus Char Char @@ -16,31 +16,31 @@ data MiniStatus = MkMiniStatus Char Char {- Interpretation of mini status -} isChanged :: MiniStatus -> Bool isChanged (MkMiniStatus index work) = - work == 'M' || (work == 'D' && index /= 'D') + work == 'M' || (work == 'D' && index /= 'D') isStaged :: MiniStatus -> Bool isStaged (MkMiniStatus index work) = - (index `elem` "MRC") || (index == 'D' && work /= 'D') || (index == 'A' && work /= 'A') + (index `elem` "MRC") || (index == 'D' && work /= 'D') || (index == 'A' && work /= 'A') isConflict :: MiniStatus -> Bool isConflict (MkMiniStatus index work) = - index == 'U' || work == 'U' || (index == 'A' && work == 'A') || (index == 'D' && work == 'D') + index == 'U' || work == 'U' || (index == 'A' && work == 'A') || (index == 'D' && work == 'D') isUntracked :: MiniStatus -> Bool isUntracked (MkMiniStatus index _) = - index == '?' + index == '?' countByType :: (MiniStatus -> Bool) -> [MiniStatus] -> Int countByType isType = length . filter isType countStatus :: [MiniStatus] -> Status Int countStatus l = MakeStatus - { - staged=countByType isStaged l, - conflict=countByType isConflict l, - changed=countByType isChanged l, - untracked=countByType isUntracked l - } + { + staged=countByType isStaged l, + conflict=countByType isConflict l, + changed=countByType isChanged l, + untracked=countByType isUntracked l + } extractMiniStatus :: String -> Maybe MiniStatus extractMiniStatus [] = Nothing @@ -49,7 +49,7 @@ extractMiniStatus (index:work:_) = Just (MkMiniStatus index work) processStatus :: [String] -> Maybe (Status Int) processStatus statLines = - do -- Maybe - statList <- for statLines extractMiniStatus - return (countStatus statList) + do -- Maybe + statList <- for statLines extractMiniStatus + return (countStatus statList) diff --git a/src/src/Utils.hs b/src/src/Utils.hs index eb06d41e..5aeb21bd 100644 --- a/src/src/Utils.hs +++ b/src/src/Utils.hs @@ -1,16 +1,36 @@ module Utils where -import Data.Maybe (fromMaybe) import BranchParse (Branch(MkBranch), MBranchInfo, BranchInfo(MkBranchInfo), branchInfo, getDistance, pairFromDistance, Remote) import StatusParse (Status(MakeStatus), processStatus) +import System.Process (readProcessWithExitCode) +import System.Exit (ExitCode(ExitSuccess)) +import Data.Char (isSpace) + {- Type aliases -} newtype Hash = MkHash {getHash :: String} data GitInfo = MkGitInfo MBranchInfo (Status Int) -{- Combining branch and status parsing -} +fromBool :: Bool -> Integer +fromBool False = 0 +fromBool True = 1 + +readHandler :: IOError -> IO String +readHandler _ = pure mempty + +strip :: String -> String +strip = reverse . dropWhile isSpace . reverse + +successOrNothing :: (ExitCode, a, b) -> Maybe a +successOrNothing (exitCode, output, _) + | exitCode == ExitSuccess = Just output + | otherwise = Nothing + +safeRun :: String -> [String] -> IO (Maybe String) +safeRun cmd args = + successOrNothing <$> readProcessWithExitCode cmd args mempty rightOrNothing :: Either a b -> Maybe b rightOrNothing = either (const Nothing) Just @@ -20,50 +40,42 @@ processBranch = rightOrNothing . branchInfo processGitStatus :: [String] -> Maybe GitInfo processGitStatus [] = Nothing -processGitStatus (branchLine:statusLines) = - do -- Maybe - mbranch <- processBranch branchLine - status <- processStatus statusLines - return (MkGitInfo mbranch status) +processGitStatus (branchLine:statusLines) = do + mbranch <- processBranch branchLine + status <- processStatus statusLines + return (MkGitInfo mbranch status) showStatusNumbers :: Status Int -> [String] -showStatusNumbers (MakeStatus s x c t) = - do -- List - nb <- [s, x, c, t] - return (show nb) +showStatusNumbers (MakeStatus s x c t) = show <$> [s, x, c, t] showRemoteNumbers :: Maybe Remote -> [String] -showRemoteNumbers mremote = - do -- List - ab <- [ahead, behind] - return (show ab) - where - (ahead, behind) = fromMaybe (0,0) distance -- the script needs some value, (0,0) means no display - distance = do -- Maybe - remote <- mremote - dist <- getDistance remote - return (pairFromDistance dist) +showRemoteNumbers mremote = show <$> [ahead, behind] + where -- the script needs some value, (0,0) means no display + (ahead, behind) = + maybe (0, 0) pairFromDistance (getDistance =<< mremote) + showBranchInfo :: BranchInfo -> [String] -showBranchInfo (MkBranchInfo branch mremote) = show branch : showRemoteNumbers mremote +showBranchInfo (MkBranchInfo branch mremote) = + show branch : showRemoteNumbers mremote {- Combine status info, branch info and hash -} branchOrHashWith :: Char -> Maybe Hash -> Maybe BranchInfo -> BranchInfo branchOrHashWith _ _ (Just bi) = bi -branchOrHashWith c (Just hash) Nothing = MkBranchInfo (MkBranch (c : getHash hash)) Nothing +branchOrHashWith c (Just hash) Nothing = + MkBranchInfo (MkBranch (c : getHash hash)) Nothing branchOrHashWith _ Nothing _ = MkBranchInfo (MkBranch "") Nothing showGitInfo :: Maybe Hash - -> GitInfo - -> [String] -showGitInfo mhash (MkGitInfo bi stat) = branchInfoString ++ showStatusNumbers stat - where - branchInfoString = showBranchInfo (branchOrHashWith ':' mhash bi) + -> GitInfo + -> [String] +showGitInfo mhash (MkGitInfo bi stat) = + branchInfoString ++ showStatusNumbers stat + where + branchInfoString = showBranchInfo (branchOrHashWith ':' mhash bi) stringsFromStatus :: Maybe Hash - -> String -- status - -> Maybe [String] -stringsFromStatus h status = do -- List - processed <- processGitStatus (lines status) - return (showGitInfo h processed) + -> String -- status + -> Maybe [String] +stringsFromStatus hash = (showGitInfo hash <$>) . processGitStatus . lines diff --git a/src/test/TestBranchParse.hs b/src/test/TestBranchParse.hs index 91fb8a68..04a110d6 100644 --- a/src/test/TestBranchParse.hs +++ b/src/test/TestBranchParse.hs @@ -9,10 +9,10 @@ import Control.Monad (forM, unless) checkRight :: MBranchInfo -> String -> Bool checkRight b s = expectRight b (branchInfo ("## " ++ s)) - where - expectRight expected computed = case computed of - Left _ -> False - Right res -> res == expected + where + expectRight expected computed = case computed of + Left _ -> False + Right res -> res == expected -- gitRep :: BranchInfo -> String -- gitRep (MkBranchInfo (MkBranch branch) Nothing) = branch @@ -23,54 +23,54 @@ checkRight b s = expectRight b (branchInfo ("## " ++ s)) propNoBranch :: Branch -> Bool propNoBranch b = - checkRight - Nothing - (show b ++ " (no branch)") + checkRight + Nothing + (show b ++ " (no branch)") propNewRepo :: Branch -> Bool propNewRepo b = - checkRight - (Just (MkBranchInfo b Nothing)) - ("Initial commit on " ++ show b) + checkRight + (Just (MkBranchInfo b Nothing)) + ("Initial commit on " ++ show b) propBranchOnly :: Branch -> Bool propBranchOnly b = - checkRight - (Just (MkBranchInfo b Nothing)) - (show b) + checkRight + (Just (MkBranchInfo b Nothing)) + (show b) propBranchRemote :: Branch -> Branch -> Bool propBranchRemote b t = - checkRight - (Just (MkBranchInfo b remote)) - (show b ++"..." ++ show t) - where - remote = Just (MkRemote t Nothing) + checkRight + (Just (MkBranchInfo b remote)) + (show b ++"..." ++ show t) + where + remote = Just (MkRemote t Nothing) propBranchRemoteTracking :: Branch -> Branch -> Distance -> Bool propBranchRemoteTracking b t distance = - checkRight - (Just (MkBranchInfo b remote)) - (show b ++ "..." ++ show t ++ " " ++ show distance) - where - remote = Just (MkRemote t (Just distance)) + checkRight + (Just (MkBranchInfo b remote)) + (show b ++ "..." ++ show t ++ " " ++ show distance) + where + remote = Just (MkRemote t (Just distance)) allTests :: [Property] allTests = [ - property propNoBranch, - property propNewRepo, - property propBranchOnly, - property propBranchRemote, - property propBranchRemoteTracking - ] + property propNoBranch, + property propNewRepo, + property propBranchOnly, + property propBranchRemote, + property propBranchRemoteTracking + ] runTests :: IO [Result] runTests = forM allTests runTest - where - runTest = quickCheckWithResult stdArgs { maxSuccess = 256 } + where + runTest = quickCheckWithResult stdArgs { maxSuccess = 256 } main :: IO() main = do -- IO - results <- runTests - unless (all isSuccess results) exitFailure + results <- runTests + unless (all isSuccess results) exitFailure diff --git a/src/test/TestFunctional.hs b/src/test/TestFunctional.hs index 0ede425a..7dc79473 100644 --- a/src/test/TestFunctional.hs +++ b/src/test/TestFunctional.hs @@ -7,28 +7,28 @@ type TestData = (String, String, [Int]) tests :: [TestData] tests = [ - ("## master...ori/master [ahead 3]\n M", "master", [3,0,0,0,1,0]) - , - ("## stat\nM ", "stat", [0,0,1,0,0,0]) - , - ("## exp...o/exp [ahead 3, behind 2]\n", "exp", [3,2,0,0,0,0]) - , - ("## master\nU \nU \nM \nM \nM ", "master", [0,0,3,2,0,0]) - , - ("## HEAD (no branch)\n", ":hash", [0,0,0,0,0,0]) - , - ("## master\n M\n M\n M\n??\n", "master", [0,0,0,0,3,1]) - , - ("## dev...o/dev [ahead 4, behind 5]\nM \n M\n??\n", "dev", [4,5,1,0,1,1]) - , - ("## dev...origin/master [ahead 4, behind 5]\nMM foo\n?? bar\n", "dev", [4,5,1,0,1,1]) - ] + ("## master...ori/master [ahead 3]\n M", "master", [3,0,0,0,1,0]) + , + ("## stat\nM ", "stat", [0,0,1,0,0,0]) + , + ("## exp...o/exp [ahead 3, behind 2]\n", "exp", [3,2,0,0,0,0]) + , + ("## master\nU \nU \nM \nM \nM ", "master", [0,0,3,2,0,0]) + , + ("## HEAD (no branch)\n", ":hash", [0,0,0,0,0,0]) + , + ("## master\n M\n M\n M\n??\n", "master", [0,0,0,0,3,1]) + , + ("## dev...o/dev [ahead 4, behind 5]\nM \n M\n??\n", "dev", [4,5,1,0,1,1]) + , + ("## dev...origin/master [ahead 4, behind 5]\nMM foo\n?? bar\n", "dev", [4,5,1,0,1,1]) + ] makeTest :: TestData -> Test makeTest (input, branch, numbers) = Just (branch : fmap show numbers) ~=? stringsFromStatus (Just (MkHash "hash")) input main :: IO () main = do -- IO - testResult <- (runTestTT . TestList . fmap makeTest) tests - let some accessor = accessor testResult /= 0 in - when (some errors || some failures) exitFailure + testResult <- (runTestTT . TestList . fmap makeTest) tests + let some accessor = accessor testResult /= 0 in + when (some errors || some failures) exitFailure diff --git a/src/test/test.sh b/src/test/test.sh new file mode 100755 index 00000000..2198096b --- /dev/null +++ b/src/test/test.sh @@ -0,0 +1,247 @@ +#!/usr/bin/env bats +# NB: BATS will fail any test if any command within returns a non-zero exit +# To surpress for commands EXPECTED to fail do: +# cmd_fails || true +BATS_IN=/tmp/bats_in +BATS_OUT=/tmp/bats_out +TEST_D=/tmp/zsh-git-bats +TEST_DUP=/tmp/zsh-git-bats_upstream + +# This is the absolution path to gitstatus binary to test, override with BATS_IN +EXE="$(dirname $BATS_TEST_DIRNAME)/.bin/gitstatus" +if [ -f $BATS_IN ]; then + . "$BATS_IN" +fi + +# Inside tests, STDOUT/ERR captured. Use this to print for later inspection +bats_out() { + echo "$@" >> "$BATS_OUT" +} + +add_commit () { + echo "Hello world" >> "$1" + git add "$1" + git commit -m "$1 commit" +} + +add_commit_text () { + echo "$2" >> "$1" + git add "$1" + git commit -m "$2 commit" +} + +setup() { + command rm -rf "$TEST_D" "$TEST_DUP" + command mkdir -p "$TEST_D" + command cd "$TEST_D" + git init + git config user.email 'you@example.com' + git config user.name 'Your Name' +} + +teardown() { + command rm -rf "$TEST_D" "$TEST_DUP" +} + +@test "Nullify output" { + echo "" > "$BATS_OUT" +} + +@test "Empty directory" { + rm -rf .git + + run $EXE + [ "$status" -eq 0 ] + [ "$output" = "" ] +} + +# disable for now until fixed in Hask +# @test "Initial repo" { +# run $EXE +# [ "$status" -eq 0 ] +# [ "$output" == "master 0 0 0 0 0 0 0 1 .. 0 0" ] +# } + +@test "Local branch indicator" { + add_commit "first" + + run $EXE + [ "$status" -eq 0 ] + [ "$output" == "master 0 0 0 0 0 0 0 1 .. 0 0" ] +} + +@test "Detached HEAD, on hash" { + add_commit "first" + add_commit "second" + git checkout HEAD~1 + local actual_hash="$(git rev-parse --short HEAD)" + + run $EXE + [ "$status" -eq 0 ] + [ "$output" == ":$actual_hash 0 0 0 0 0 0 0 0 .. 0 0" ] +} + +@test "Basic stats, NO conflicts" { + add_commit "first" + echo "first line" >> first + git stash + + echo "first line" >> first + echo "second line" >> second + echo "third line" >> third + touch untracked1 untracked2 + git add first second third + + echo "first line" >> first + cp -r "$TEST_D" "$TEST_DUP" + git remote add -f up "$TEST_DUP" + git branch --set-upstream-to=up/master + + run $EXE + [ "$status" -eq 0 ] + [ "$output" == "master 0 0 3 0 1 2 1 0 up/master 0 0" ] +} + +@test "Basic stats, ONLY conflicts" { + add_commit "first" + git branch dev + git checkout dev + add_commit "first" + + git checkout master + echo "A different line" >> first + git add first + git commit -m "A different line" + git merge dev || true + + run $EXE + [ "$status" -eq 0 ] + [ "$output" == "master 0 0 0 1 0 0 0 1 .. 1 0" ] +} + +@test "Remote branch, 1 ahead" { + add_commit "first" + add_commit "first" + + cp -r "$TEST_D" "$TEST_DUP" + git remote add -f up "$TEST_DUP" + git branch --set-upstream-to=up/master + + add_commit_text "first" "Local text 1" + + run $EXE + [ "$status" -eq 0 ] + [ "$output" == "master 1 0 0 0 0 0 0 0 up/master 0 0" ] +} + +@test "Remote branch, 2 behind" { + add_commit "first" + add_commit "first" + add_commit_text "first" "Remote text 1" + add_commit_text "first" "Remote text 2" + + cp -r "$TEST_D" "$TEST_DUP" + git remote add -f up "$TEST_DUP" + git branch --set-upstream-to=up/master + + git reset --hard HEAD~2 + + run $EXE + [ "$status" -eq 0 ] + [ "$output" == "master 0 2 0 0 0 0 0 0 up/master 0 0" ] +} + +@test "Remote branch, 1 ahead & 2 behind" { + add_commit "first" + add_commit "first" + add_commit_text "first" "Remote text 1" + add_commit_text "first" "Remote text 2" + + cp -r "$TEST_D" "$TEST_DUP" + git remote add -f up "$TEST_DUP" + git branch --set-upstream-to=up/master + + git reset --hard HEAD~2 + add_commit_text "first" "Local text 1" + + run $EXE + [ "$status" -eq 0 ] + [ "$output" == "master 1 2 0 0 0 0 0 0 up/master 0 0" ] +} + +@test "Remote branch, gone" { + skip "Fails for Haskell at this time." + add_commit "first" + add_commit_text "first" "second line" + + cp -r "$TEST_D" "$TEST_DUP" + git remote add -f up "$TEST_DUP" + + git branch dev + git checkout dev + git push -u up dev + git fetch up + git push up :dev + + run $EXE + [ "$status" -eq 0 ] + [ "$output" == "dev 0 0 0 0 0 0 0 0 up/dev 0 0" ] +} + +@test "Read from STDIN" { + add_commit "first" + echo "first line" >> first + git stash + + echo "first line" >> first + echo "second line" >> second + echo "third line" >> third + touch untracked1 untracked2 + git add first second third + + echo "first line" >> first + cp -r "$TEST_D" "$TEST_DUP" + git remote add -f up "$TEST_DUP" + git branch --set-upstream-to=up/master + + [ "$(git status --branch --porcelain | "$EXE")" == "master 0 0 3 0 1 2 1 0 up/master 0 0" ] +} + +@test "Merge in progress" { + add_commit "first" + + git branch dev + git checkout dev + add_commit_text "first" "commit on dev" + + git checkout master + add_commit_text "first" "commit on master" + + git checkout dev + git merge master || true + + run $EXE + [ "$status" -eq 0 ] + [ "$output" == "dev 0 0 0 1 0 0 0 1 .. 1 0" ] +} + +@test "Rebase in progress" { + add_commit "first" + + git branch dev + git checkout dev + add_commit_text "first" "only on dev 1" + add_commit_text "first" "only on dev 2" + + git checkout master + add_commit_text "first" "only on master 1" + add_commit_text "first" "only on master 2" + + git checkout dev + git rebase master || true + + run $EXE + [ "$status" -eq 0 ] + local actual_hash="$(git rev-parse --short HEAD)" + [ "$output" == ":$actual_hash 0 0 0 1 0 0 0 0 .. 0 1/2" ] +} diff --git a/stack.yaml b/stack.yaml index 2c34af57..221053f0 100644 --- a/stack.yaml +++ b/stack.yaml @@ -8,7 +8,12 @@ packages: - 'src' # Packages to be pulled from upstream that are not in the resolver (e.g., acme-missiles-0.3) -extra-deps: [] +extra-deps: +- cryptonite-0.25 +- memory-0.14.16 +- basement-0.0.7 +- foundation-0.0.20 +- git-0.2.1 # Override default flag values for local packages and extra-deps flags: {}