packages feed

gitHUD (empty) → 1.0.0.0

raw patch · 18 files changed

+962/−0 lines, 18 filesdep +basedep +gitHUDdep +mtlsetup-changed

Dependencies added: base, gitHUD, mtl, parsec, process, tasty, tasty-hunit, tasty-quickcheck, tasty-smallcheck

Files

+ LICENSE view
@@ -0,0 +1,30 @@+Copyright Grégory Bataille (c) 2015++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++    * Redistributions of source code must retain the above copyright+      notice, this list of conditions and the following disclaimer.++    * Redistributions in binary form must reproduce the above+      copyright notice, this list of conditions and the following+      disclaimer in the documentation and/or other materials provided+      with the distribution.++    * Neither the name of Grégory Bataille nor the names of other+      contributors may be used to endorse or promote products derived+      from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ app/Main.hs view
@@ -0,0 +1,6 @@+module Main where++import GitHUD++main :: IO ()+main = githud
+ gitHUD.cabal view
@@ -0,0 +1,61 @@+name:                gitHUD+version:             1.0.0.0+synopsis:            More efficient replacement to the great git-radar+description:         Please see README.md+homepage:            http://github.com/gbataille/gitHUD#readme+license:             BSD3+license-file:        LICENSE+author:              Grégory Bataille+maintainer:          gbataille.dev@gmail.com+copyright:           Grégory Bataille 2015+category:            Development+build-type:          Simple+-- extra-source-files:+cabal-version:       >=1.10++library+  hs-source-dirs:     src+  exposed-modules:    GitHUD+                    , GitHUD.Process+                    , GitHUD.Git.Types+                    , GitHUD.Git.Common+                    , GitHUD.Git.Command+                    , GitHUD.Git.Parse.Base+                    , GitHUD.Git.Parse.Status+                    , GitHUD.Git.Parse.Branch+                    , GitHUD.Git.Parse.Count+                    , GitHUD.Terminal.Base+                    , GitHUD.Terminal.Types+  build-depends:      base >= 4.7 && < 5+                    , process+                    , parsec >= 3.1.9 && < 4+                    , mtl >= 2.2.1 && < 3+  default-language:   Haskell2010++executable gitHUD+  hs-source-dirs:     app+  main-is:            Main.hs+  ghc-options:        -threaded -rtsopts -with-rtsopts=-N -Wall -fno-warn-unused-do-bind+  build-depends:      base+                    , gitHUD+  default-language:   Haskell2010++test-suite gitHUD-test+  type:               exitcode-stdio-1.0+  hs-source-dirs:     test+  main-is:            Spec.hs+  build-depends:      base+                    , tasty >= 0.10 && < 0.12+                    , tasty-hunit >= 0.9 && < 0.10+                    , tasty-smallcheck >= 0.8 && < 0.9+                    , tasty-quickcheck >= 0.8 && < 0.9+                    , gitHUD+  ghc-options:        -threaded -rtsopts -with-rtsopts=-N+  default-language:   Haskell2010+  Other-modules:      Test.GitHUD.Git.Parse.Status+                    , Test.GitHUD.Git.Parse.Branch+  Ghc-Options:        -rtsopts -Wall -fno-warn-unused-do-bind -threaded++source-repository head+  type:     git+  location: https://github.com/gbataille/gitHUD
+ src/GitHUD.hs view
@@ -0,0 +1,177 @@+module GitHUD (+    githud+    ) where++import Control.Monad.Reader+import System.Environment (getArgs)++import GitHUD.Terminal.Types+import GitHUD.Terminal.Base+import GitHUD.Git.Types+import GitHUD.Git.Parse.Base+import GitHUD.Git.Command++githud :: IO ()+githud = do+  shell <- processArguments getArgs++  isGit <- checkInGitDirectory+  when isGit $ do+    repoState <- getGitRepoState+    runReaderT (buildOutput repoState) shell+    -- Necessary to properly terminate the output+    putStrLn ""++processArguments :: IO [String]+                 -> IO Shell+processArguments args = do+  arguments <- args+  if (not (null arguments)) && ((head arguments) == "zsh")+    then return ZSH+    else return Other++buildOutput :: GitRepoState+            -> ShellOutput+buildOutput repoState = do+  outputGitRepoIndicator+  outputUpstreamAbsence (gitRemoteTrackingBranch repoState)+  outputRCommits (gitRemoteCommitsToPull repoState) (gitRemoteCommitsToPush repoState)+  outputLocalBranchName (gitLocalBranch repoState) (gitCommitShortSHA repoState)+  outputCommitsToPullPush (gitCommitsToPull repoState) (gitCommitsToPush repoState)+  outputRepoState (gitLocalRepoChanges repoState)+  outputStashCount (gitStashCount repoState)++-- | Requires patched fonts for Powerline (Monaco Powerline)+outputGitRepoIndicator :: ShellOutput+outputGitRepoIndicator = do+  liftIO $ do+    putChar '\57504'+    putChar ' '++outputUpstreamAbsence :: String -> ShellOutput+outputUpstreamAbsence remoteTrackingBranch =+  when (remoteTrackingBranch == "") $ do+    liftIO . putStr $ "upstream "+    showStrInColor Red Vivid "\9889"+    liftIO . putChar $ ' '++outputLocalBranchName :: String       -- ^ the local branch name+                      -> String         -- ^ the HEAD commit short sha+                      -> ShellOutput+outputLocalBranchName localBranchName commitSHA = do+  if (localBranchName /= "")+    then liftIO $ do+      putStr "["+      mapM_ putStr (lines localBranchName)+      putStr "]"+      putStr " "+    else do+      liftIO . putStr $ "["+      showStrInColor Yellow Vivid "detached@"+      showStrInColor Yellow Vivid commitSHA+      liftIO . putStr $ "]"+      liftIO . putStr $ " "++outputcommitsToPush :: Int+                    -> ShellOutput+outputcommitsToPush commitCount = do+  when (commitCount > 0) $ do+    liftIO . putStr . show $ commitCount+    showStrInColor Green Vivid "\8593"++outputcommitsToPull :: Int+                    -> ShellOutput+outputcommitsToPull commitCount = do+  when (commitCount > 0) $ do+    liftIO . putStr . show $ commitCount+    showStrInColor Red Vivid "\8595"++outputRCommits :: Int          -- ^ commits to pull+               -> Int          -- ^ commits to push+               -> ShellOutput+outputRCommits pull push = do+  if (pull > 0) && (push > 0)+    then do+      liftIO . putStr $ "\120366 "+      liftIO . putStr . show $ pull+      showStrInColor Green Vivid "\8644"+      liftIO . putStr . show $ push+    else (+      if (pull > 0)+        then do+          liftIO . putStr $ "\120366 "+          showStrInColor Green Vivid "\8594"+          liftIO . putStr $ " "+          liftIO . putStr . show $ pull+        else (+          when (push > 0) $ do+            liftIO . putStr $ "\120366 "+            showStrInColor Green Vivid "\8592"+            liftIO . putStr $ " "+            liftIO . putStr . show $ push+        )+    )++  when ((pull > 0) || (push > 0)) . liftIO . putStr $ " "++outputCommitsToPullPush :: Int          -- ^ commits to pull+                        -> Int          -- ^ commits to push+                        -> ShellOutput+outputCommitsToPullPush pull push = do+  if (pull > 0) && (push > 0)+    then do+      liftIO . putStr . show $ pull+      showStrInColor Green Vivid "\8645"+      liftIO . putStr . show $ push+    else+      if (pull > 0)+        then outputcommitsToPull pull+        else+          when (push > 0) $ outputcommitsToPush push++  when ((pull > 0) || (push > 0)) . liftIO . putStr $ " "++outputStashCount :: Int+                 -> ShellOutput+outputStashCount stashCount = do+  when (stashCount /= 0) $ do+    liftIO . putStr . show $ stashCount+    showStrInColor Green Vivid "≡ "++outputRepoState :: GitLocalRepoChanges+                -> ShellOutput+outputRepoState repoState = do+  showElem indexAdd repoState Green Vivid "A"+  showElem indexDel repoState Green Vivid "D"+  showElem indexMod repoState Green Vivid "M"+  showElem renamed  repoState Green Vivid "R"+  when ((indexAdd repoState > 0) || (indexDel repoState > 0) || (indexMod repoState > 0) || (renamed repoState > 0)) . liftIO . putStr $ " "++  showElem localDel repoState Red Vivid "D"+  showElem localMod repoState Red Vivid "M"+  when ((localDel repoState > 0) || (localMod repoState > 0)) . liftIO . putStr $ " "++  showElem localAdd repoState White Vivid "A"+  when (localAdd repoState > 0) . liftIO . putStr $ " "++  showElem conflict repoState Green Vivid "C"+  when (conflict repoState > 0) . liftIO . putStr $ " "++showElem :: (GitLocalRepoChanges -> Int)+         -> GitLocalRepoChanges+         -> Color+         -> ColorIntensity+         -> String+         -> ShellOutput+showElem elemFunc repoState color intensity letter = do+  let num = elemFunc repoState+  when (num > 0) $ showNumState num color intensity letter++showNumState :: Int+         -> Color+         -> ColorIntensity+         -> String+         -> ShellOutput+showNumState num color intensity letter = do+    liftIO . putStr . show $ num+    showStrInColor color intensity letter
+ src/GitHUD/Git/Command.hs view
@@ -0,0 +1,83 @@+module GitHUD.Git.Command (+  gitCmdLocalBranchName+  , gitCmdRemoteName+  , gitCmdRemoteBranchName+  , gitCmdPorcelainStatus+  , gitCmdRevToPush+  , gitCmdRevToPull+  , gitCmdStashCount+  , gitCmdCommitShortSHA+  , checkInGitDirectory+  ) where++import Control.Concurrent.MVar (MVar, putMVar)+import System.Process (readProcessWithExitCode, proc, StdStream(CreatePipe, UseHandle), createProcess, CreateProcess(..))+import GHC.IO.Handle (hGetLine)+import System.Exit (ExitCode(ExitSuccess))++import GitHUD.Process (readProcessWithIgnoreExitCode)+import GitHUD.Git.Common++checkInGitDirectory :: IO Bool+checkInGitDirectory = do+  (exCode, _, _) <- readProcessWithExitCode "git" ["rev-parse", "--git-dir"] ""+  return (exCode == ExitSuccess)++gitCmdLocalBranchName :: MVar String -> IO ()+gitCmdLocalBranchName out = do+  localBranch <- readProcessWithIgnoreExitCode "git" ["symbolic-ref", "--short", "HEAD"] ""+  putMVar out localBranch++gitCmdRemoteName :: String         -- ^ local branch name+              -> MVar String   -- ^ the output mvar+              -> IO ()+gitCmdRemoteName localBranchName out = do+  remoteName <- readProcessWithIgnoreExitCode "git" ["config", "--get", gitRemoteTrackingConfigKey localBranchName] ""+  putMVar out remoteName++gitCmdRemoteBranchName :: String     -- ^ remote name+                    -> MVar String     -- ^ The output mvar+                    -> IO ()+gitCmdRemoteBranchName remoteName out = do+  remoteBranch <- readProcessWithIgnoreExitCode "git" ["config", "--get", gitRemoteBranchConfigKey remoteName] ""+  putMVar out remoteBranch+++gitCmdPorcelainStatus :: MVar String -> IO ()+gitCmdPorcelainStatus out = do+  porcelainStatus <- readProcessWithIgnoreExitCode "git" ["status", "--porcelain"] ""+  putMVar out porcelainStatus++gitCmdRevToPush :: String          -- ^ from revision+             -> String          -- ^ to revision+             -> MVar String      -- ^ The output mvar+             -> IO ()+gitCmdRevToPush fromCommit toCommit out = do+  revToPush <- readProcessWithIgnoreExitCode "git" ["rev-list", "--right-only", "--count", mergeBaseDiffFromTo fromCommit toCommit] ""+  putMVar out revToPush++gitCmdRevToPull :: String          -- ^ from revision+             -> String          -- ^ to revision+             -> MVar String      -- ^ The output mvar+             -> IO ()+gitCmdRevToPull fromCommit toCommit out = do+  revToPull <- readProcessWithIgnoreExitCode "git" ["rev-list", "--left-only", "--count", mergeBaseDiffFromTo fromCommit toCommit] ""+  putMVar out revToPull++gitCmdStashCount :: MVar String     -- ^ The output mvar+              -> IO ()+gitCmdStashCount out = do+  ( _, Just hGitStashList, _, _) <- createProcess+    (proc "git" ["stash", "list"])+    { std_out = CreatePipe }+  ( _, Just hCountStr, _, _) <- createProcess+    (proc "wc" ["-l"])+    { std_in = UseHandle hGitStashList, std_out = CreatePipe }+  count <- hGetLine hCountStr+  putMVar out count++gitCmdCommitShortSHA :: MVar String+                  -> IO ()+gitCmdCommitShortSHA out = do+  shortSHA <- readProcessWithIgnoreExitCode "git" ["rev-parse", "--short", "HEAD"] ""+  putMVar out shortSHA
+ src/GitHUD/Git/Common.hs view
@@ -0,0 +1,16 @@+module GitHUD.Git.Common (+  gitRemoteTrackingConfigKey+  , gitRemoteBranchConfigKey+  , mergeBaseDiffFromTo+  ) where+++gitRemoteTrackingConfigKey :: String -> String+gitRemoteTrackingConfigKey localBranchName = "branch." ++ localBranchName ++ ".remote"++gitRemoteBranchConfigKey :: String -> String+gitRemoteBranchConfigKey localBranchName = "branch." ++ localBranchName ++ ".merge"++mergeBaseDiffFromTo :: String -> String -> String+mergeBaseDiffFromTo fromCommit toCommit = fromCommit ++ "..." ++ toCommit+
+ src/GitHUD/Git/Parse/Base.hs view
@@ -0,0 +1,83 @@+module GitHUD.Git.Parse.Base (+  getGitRepoState+  ) where++import Control.Concurrent (forkIO)+import Control.Concurrent.MVar (newEmptyMVar, takeMVar)++import GitHUD.Git.Types+import GitHUD.Git.Command+import GitHUD.Git.Parse.Status+import GitHUD.Git.Parse.Branch+import GitHUD.Git.Parse.Count++removeEndingNewline :: String -> String+removeEndingNewline str = concat . lines $ str++getGitRepoState :: IO GitRepoState+getGitRepoState = do+  -- Preparing MVars+  mvLocalBranch <- newEmptyMVar+  mvGitStatus <- newEmptyMVar+  mvRemoteName <- newEmptyMVar+  mvStashCount <- newEmptyMVar+  mvCommitShortSHA <- newEmptyMVar++  forkIO $ gitCmdLocalBranchName mvLocalBranch+  forkIO $ gitCmdPorcelainStatus mvGitStatus+  forkIO $ gitCmdStashCount mvStashCount+  forkIO $ gitCmdCommitShortSHA mvCommitShortSHA++  localBranchName <- removeEndingNewline <$> (takeMVar mvLocalBranch)+  forkIO $ gitCmdRemoteName localBranchName mvRemoteName++  remoteName <- removeEndingNewline <$> takeMVar mvRemoteName+  repoState <- gitParseStatus <$> takeMVar mvGitStatus+  stashCountStr <- takeMVar mvStashCount+  commitShortSHA <- removeEndingNewline <$> takeMVar mvCommitShortSHA++  fillGitRemoteRepoState zeroGitRepoState {+    gitLocalRepoChanges = repoState+    , gitRemote = remoteName+    , gitLocalBranch = localBranchName+    , gitCommitShortSHA = commitShortSHA+    , gitStashCount = (getCount stashCountStr)+  }++fillGitRemoteRepoState :: GitRepoState+                       -> IO GitRepoState+fillGitRemoteRepoState repoState@( GitRepoState { gitRemote = ""} ) = return repoState+fillGitRemoteRepoState repoState = do+  mvRemoteBranchName <- newEmptyMVar+  mvCommitsToPull <- newEmptyMVar+  mvCommitsToPush <- newEmptyMVar+  mvRemoteCommitsToPull <- newEmptyMVar+  mvRemoteCommitsToPush <- newEmptyMVar++  forkIO $ gitCmdRemoteBranchName (gitLocalBranch repoState) mvRemoteBranchName+  remoteBranch <- removeEndingNewline <$> (takeMVar mvRemoteBranchName)++  let fullRemoteBranchName = buildFullyQualifiedRemoteBranchName (gitRemote repoState) remoteBranch++  forkIO $ gitCmdRevToPush "origin/master" fullRemoteBranchName mvRemoteCommitsToPush+  forkIO $ gitCmdRevToPull "origin/master" fullRemoteBranchName mvRemoteCommitsToPull+  forkIO $ gitCmdRevToPush fullRemoteBranchName "HEAD" mvCommitsToPush+  forkIO $ gitCmdRevToPull fullRemoteBranchName "HEAD" mvCommitsToPull++  rCommitsToMergeStr <- takeMVar mvRemoteCommitsToPush+  let rCommitsToMerge = getCount rCommitsToMergeStr+  rCommitsToRMasterStr <- takeMVar mvRemoteCommitsToPull+  let rCommitsToRMaster = getCount rCommitsToRMasterStr++  commitsToPushStr <- takeMVar mvCommitsToPush+  let commitsToPush = getCount commitsToPushStr+  commitsToPullStr <- takeMVar mvCommitsToPull+  let commitsToPull = getCount commitsToPullStr++  return repoState {+    gitRemoteTrackingBranch = remoteBranch+    , gitCommitsToPull = commitsToPull+    , gitCommitsToPush = commitsToPush+    , gitRemoteCommitsToPull = rCommitsToRMaster+    , gitRemoteCommitsToPush = rCommitsToMerge+  }
+ src/GitHUD/Git/Parse/Branch.hs view
@@ -0,0 +1,29 @@+module GitHUD.Git.Parse.Branch (+  buildFullyQualifiedRemoteBranchName+  ) where++import Text.Parsec (parse)+import Text.Parsec.String (Parser)+import Text.Parsec.Char (anyChar, string)+import Text.Parsec.Prim (many)++buildFullyQualifiedRemoteBranchName :: String       -- ^ remote+                                    -> String       -- ^ remote Branch Name+                                    -> String+buildFullyQualifiedRemoteBranchName remote branch =+  remote ++ "/" ++ (simpleRemoteBranchName branch)++simpleRemoteBranchName :: String+                       -> String+simpleRemoteBranchName branch =+  either+    (const "")+    id+    (parse remoteBranchParser "" branch)++remoteBranchParser :: Parser String+remoteBranchParser = do+  string "refs/heads/"+  many anyChar++
+ src/GitHUD/Git/Parse/Count.hs view
@@ -0,0 +1,23 @@+module GitHUD.Git.Parse.Count (+  getCount+  ) where++import Text.Parsec (parse)+import Text.Parsec.String (Parser)+import Text.Parsec.Char (anyChar)+import Text.Parsec.Prim (many)++getCount :: String -> Int+getCount numberString =+  either+    (const 0)+    id+    (parse countParser "" numberString)++countParser :: Parser Int+countParser = do+  number <- many anyChar+  if null number+    then return 0+    else return (read number)+
+ src/GitHUD/Git/Parse/Status.hs view
@@ -0,0 +1,149 @@+module GitHUD.Git.Parse.Status (+  gitParseStatus+  ) where++import Text.Parsec (parse)+import Text.Parsec.String (Parser)+import Text.Parsec.Char (anyChar, newline, noneOf, oneOf)+import Text.Parsec.Prim (many, (<?>), try)+import Text.Parsec.Combinator (choice)++import GitHUD.Git.Types++data GitFileState = LocalMod+                  | LocalAdd+                  | LocalDel+                  | IndexMod+                  | IndexAdd+                  | IndexDel+                  | Renamed+                  | Conflict+                  | Skip            -- ^ Used to skip an output. Necessary because we are parsing twice the output, ignoring certain lines on each pass+                  deriving (Show)++-- | In case of error, return zeroRepoState, i.e. no changes+gitParseStatus :: String -> GitLocalRepoChanges+gitParseStatus out =+  mergeGitLocalRepoChanges local index+  where local = (parseLocal out)+        index = (parseIndex out)++parseLocal :: String -> GitLocalRepoChanges+parseLocal str =+  either+    (const zeroLocalRepoChanges)+    id+    (parse localPorcelainStatusParser "" str)++parseIndex :: String -> GitLocalRepoChanges+parseIndex str =+  either+    (const zeroLocalRepoChanges)+    id+    (parse indexPorcelainStatusParser "" str)++localPorcelainStatusParser :: Parser GitLocalRepoChanges+localPorcelainStatusParser = gitLinesToLocalRepoState . many $ gitLocalLines++indexPorcelainStatusParser :: Parser GitLocalRepoChanges+indexPorcelainStatusParser = gitLinesToIndexRepoState . many $ gitIndexLines++gitLinesToLocalRepoState :: Parser [GitFileState] -> Parser GitLocalRepoChanges+gitLinesToLocalRepoState gitFileStateP = do+    gitFileState <- gitFileStateP+    return $ foldl linesStateFolder zeroLocalRepoChanges gitFileState++gitLinesToIndexRepoState :: Parser [GitFileState] -> Parser GitLocalRepoChanges+gitLinesToIndexRepoState gitFileStateP = do+    gitFileState <- gitFileStateP+    return $ foldl linesStateFolder zeroLocalRepoChanges gitFileState++linesStateFolder :: GitLocalRepoChanges -> GitFileState -> GitLocalRepoChanges+linesStateFolder repoS (LocalMod) = repoS { localMod = (localMod repoS) + 1 }+linesStateFolder repoS (LocalAdd) = repoS { localAdd = (localAdd repoS) + 1 }+linesStateFolder repoS (LocalDel) = repoS { localDel = (localDel repoS) + 1 }+linesStateFolder repoS (IndexMod) = repoS { indexMod = (indexMod repoS) + 1 }+linesStateFolder repoS (IndexAdd) = repoS { indexAdd = (indexAdd repoS) + 1 }+linesStateFolder repoS (IndexDel) = repoS { indexDel = (indexDel repoS) + 1 }+linesStateFolder repoS (Conflict) = repoS { conflict = (conflict repoS) + 1 }+linesStateFolder repoS (Renamed)  = repoS { renamed = (renamed repoS) + 1 }+linesStateFolder repoS (Skip)     = repoS++gitLocalLines :: Parser GitFileState+gitLocalLines = do+    state <- localFileState+    newline+    return state++gitIndexLines :: Parser GitFileState+gitIndexLines = do+    state <- indexFileState+    newline+    return state++indexFileState :: Parser GitFileState+indexFileState = do+    state <- choice [+        conflictState+        , renamedState+        , indexModState+        , indexAddState+        , indexDelState+        -- Fallthrough to skip the lines indicating local modifications+        , skipLine+        ] <?> "local file state"+    many $ noneOf "\n"+    return state++localFileState :: Parser GitFileState+localFileState = do+    state <- choice [+        localModState+        , localAddState+        , localDelState+        -- Fallthrough to skip the lines indicating index modifications+        , skipLine+        ] <?> "local file state"+    many $ noneOf "\n"+    return state++-- | Parser of 2 characters exactly that returns a specific State+twoCharParser :: [Char]           -- ^ List of allowed first Char to be matched+              -> [Char]           -- ^ List of allowed second Char to be matched+              -> GitFileState   -- ^ the GitFileState to return as output+              -> Parser GitFileState+twoCharParser first second state = try $ do+  oneOf first+  oneOf second+  return state++skipLine :: Parser GitFileState+skipLine = anyChar >> return Skip++conflictState :: Parser GitFileState+conflictState = choice [+  (twoCharParser "D" "DU" Conflict)+  , (twoCharParser "A" "AU" Conflict)+  , (twoCharParser "U" "AUD" Conflict)+  ] <?> "conflict parser"++localModState :: Parser GitFileState+localModState = twoCharParser "MARC " "M" LocalMod++localAddState :: Parser GitFileState+localAddState = twoCharParser "?" "?" LocalAdd++localDelState :: Parser GitFileState+localDelState = twoCharParser "MARC " "D" LocalDel++indexModState :: Parser GitFileState+indexModState = twoCharParser "M" "DM " IndexMod++indexAddState :: Parser GitFileState+indexAddState = twoCharParser "A" "DM " IndexAdd++indexDelState :: Parser GitFileState+indexDelState = twoCharParser "D" "M " IndexDel++renamedState :: Parser GitFileState+renamedState = twoCharParser "R" "DM " Renamed
+ src/GitHUD/Git/Types.hs view
@@ -0,0 +1,71 @@+module GitHUD.Git.Types (+  GitLocalRepoChanges(..)+  , zeroLocalRepoChanges+  , GitRepoState(..)+  , zeroGitRepoState+  , mergeGitLocalRepoChanges+  ) where++data GitLocalRepoChanges = GitLocalRepoChanges { localMod :: Int+                                 , localAdd :: Int+                                 , localDel :: Int+                                 , indexMod :: Int+                                 , indexAdd :: Int+                                 , indexDel :: Int+                                 , renamed  :: Int+                                 , conflict :: Int+                                 } deriving (Show, Eq)++zeroLocalRepoChanges :: GitLocalRepoChanges+zeroLocalRepoChanges = GitLocalRepoChanges { localMod = 0+                             , localAdd = 0+                             , localDel = 0+                             , indexMod = 0+                             , indexAdd = 0+                             , indexDel = 0+                             , renamed  = 0+                             , conflict = 0+                             }++mergeGitLocalRepoChanges :: GitLocalRepoChanges -> GitLocalRepoChanges -> GitLocalRepoChanges+mergeGitLocalRepoChanges a b =+  GitLocalRepoChanges {+    localMod   = (localMod a) + (localMod b)+    , localAdd = (localAdd a) + (localAdd b)+    , localDel = (localDel a) + (localDel b)+    , indexMod = (indexMod a) + (indexMod b)+    , indexAdd = (indexAdd a) + (indexAdd b)+    , indexDel = (indexDel a) + (indexDel b)+    , renamed  = (renamed a) + (renamed b)+    , conflict = (conflict a) + (conflict b)+  }++data GitRepoState =+  GitRepoState {+    gitLocalRepoChanges :: GitLocalRepoChanges+    , gitLocalBranch :: String+    , gitCommitShortSHA :: String+    , gitRemote :: String+    , gitRemoteTrackingBranch :: String+    , gitStashCount :: Int+    , gitCommitsToPull :: Int+    , gitCommitsToPush :: Int+    , gitRemoteCommitsToPull :: Int+    , gitRemoteCommitsToPush :: Int+  }+  deriving (Eq, Show)++zeroGitRepoState :: GitRepoState+zeroGitRepoState =+  GitRepoState {+    gitLocalRepoChanges = zeroLocalRepoChanges+    , gitLocalBranch = ""+    , gitCommitShortSHA = ""+    , gitRemote = ""+    , gitRemoteTrackingBranch = ""+    , gitStashCount = 0+    , gitCommitsToPull = 0+    , gitCommitsToPush = 0+    , gitRemoteCommitsToPull = 0+    , gitRemoteCommitsToPush = 0+  }
+ src/GitHUD/Process.hs view
@@ -0,0 +1,14 @@+module GitHUD.Process (+  readProcessWithIgnoreExitCode+  ) where++import System.Process (readProcessWithExitCode)+import System.Exit (ExitCode(ExitSuccess))++readProcessWithIgnoreExitCode :: FilePath -> [String] -> String -> IO String+readProcessWithIgnoreExitCode command options stdin = do+  (exCode, stdout, _) <- readProcessWithExitCode command options stdin+  if (exCode == ExitSuccess)+    then return stdout+    else return ""+
+ src/GitHUD/Terminal/Base.hs view
@@ -0,0 +1,58 @@+module GitHUD.Terminal.Base (+  showStrInColor+  ) where++import Control.Monad.Reader++import GitHUD.Terminal.Types++showStrInColor :: Color               -- ^ The terminal color to use+               -> ColorIntensity      -- ^ The intensity to use+               -> String              -- ^ The string to output+               -> ShellOutput+showStrInColor color intensity str = do+  shell <- ask+  liftIO $ outputStrInColor color intensity str shell++outputStrInColor :: Color+                 -> ColorIntensity+                 -> String+                 -> Shell+                 -> IO()+outputStrInColor color intensity str shell = do+  let startCode = terminalStartCode color intensity+  if (shell == ZSH)+    then putStr $ zshMarkZeroWidth startCode+    else putStr $ startCode++  putStr str+  if (shell == ZSH)+    then putStr $ zshMarkZeroWidth terminalEndCode+    else putStr $ terminalEndCode++zshMarkZeroWidth :: String+                 -> String+zshMarkZeroWidth str = "%{" `mappend` str `mappend` "%}"++terminalStartCode :: Color+                  -> ColorIntensity+                  -> String+terminalStartCode  Black    Vivid  = "\x1b[1;30m"+terminalStartCode  Red      Vivid  = "\x1b[1;31m"+terminalStartCode  Green    Vivid  = "\x1b[1;32m"+terminalStartCode  Yellow   Vivid  = "\x1b[1;33m"+terminalStartCode  Blue     Vivid  = "\x1b[1;34m"+terminalStartCode  Magenta  Vivid  = "\x1b[1;35m"+terminalStartCode  Cyan     Vivid  = "\x1b[1;36m"+terminalStartCode  White    Vivid  = "\x1b[1;37m"+terminalStartCode  Black    Dull   = "\x1b[30m"+terminalStartCode  Red      Dull   = "\x1b[31m"+terminalStartCode  Green    Dull   = "\x1b[32m"+terminalStartCode  Yellow   Dull   = "\x1b[33m"+terminalStartCode  Blue     Dull   = "\x1b[34m"+terminalStartCode  Magenta  Dull   = "\x1b[35m"+terminalStartCode  Cyan     Dull   = "\x1b[36m"+terminalStartCode  White    Dull   = "\x1b[37m"++terminalEndCode :: String+terminalEndCode = "\x1b[0m"
+ src/GitHUD/Terminal/Types.hs view
@@ -0,0 +1,14 @@+module GitHUD.Terminal.Types (+  Color(..)+  , ColorIntensity(..)+  , Shell(..)+  , ShellOutput(..)+  ) where++import Control.Monad.Reader++data Color = Black | Red | Green | Yellow | Blue | Magenta | Cyan | White+data ColorIntensity = Dull | Vivid+data Shell = ZSH | Other deriving (Eq)+type ShellOutput = ReaderT Shell IO ()+
+ test/Spec.hs view
@@ -0,0 +1,49 @@+import Test.Tasty+-- import Test.Tasty.SmallCheck as SC+-- import Test.Tasty.QuickCheck as QC++import Test.GitHUD.Git.Parse.Status+import Test.GitHUD.Git.Parse.Branch++main :: IO ()+main = defaultMain tests++tests :: TestTree+tests = testGroup "Tests" [statusTests, branchTests]+--+-- tests :: TestTree+-- tests = testGroup "Tests" [properties, unitTests]+--+-- properties :: TestTree+-- properties = testGroup "Properties" [scProps, qcProps]+--+-- scProps = testGroup "(checked by SmallCheck)"+--   [ SC.testProperty "sort == sort . reverse" $+--       \list -> sort (list :: [Int]) == sort (reverse list)+--   , SC.testProperty "Fermat's little theorem" $+--       \x -> ((x :: Integer)^7 - x) `mod` 7 == 0+--   -- the following property does not hold+--   , SC.testProperty "Fermat's last theorem" $+--       \x y z n ->+--         (n :: Integer) >= 3 SC.==> x^n + y^n /= (z^n :: Integer)+--   ]+--+-- qcProps = testGroup "(checked by QuickCheck)"+--   [ QC.testProperty "sort == sort . reverse" $+--       \list -> sort (list :: [Int]) == sort (reverse list)+--   , QC.testProperty "Fermat's little theorem" $+--       \x -> ((x :: Integer)^7 - x) `mod` 7 == 0+--   -- the following property does not hold+--   , QC.testProperty "Fermat's last theorem" $+--       \x y z n ->+--         (n :: Integer) >= 3 QC.==> x^n + y^n /= (z^n :: Integer)+--   ]+--+-- unitTests = testGroup "Unit tests"+--   [ testCase "List comparison (different length)" $+--       [1, 2, 3] `compare` [1,2] @?= GT+--+--   -- the following test does not hold+--   , testCase "List comparison (same length)" $+--       [1, 2, 3] `compare` [1,2,2] @?= LT+--   ]
+ test/Test/GitHUD/Git/Parse/Branch.hs view
@@ -0,0 +1,15 @@+module Test.GitHUD.Git.Parse.Branch (+  branchTests+  ) where++import Test.Tasty+import Test.Tasty.HUnit++import GitHUD.Git.Parse.Branch++branchTests :: TestTree+branchTests = testGroup "Branch Parser Test"+  [ testCase "remote branch name" $+      buildFullyQualifiedRemoteBranchName "bar" "refs/heads/foo"+      @?= "bar/foo"+  ]
+ test/Test/GitHUD/Git/Parse/Status.hs view
@@ -0,0 +1,82 @@+module Test.GitHUD.Git.Parse.Status (+  statusTests+  ) where++import Test.Tasty+import Test.Tasty.HUnit++import GitHUD.Git.Parse.Status+import GitHUD.Git.Types++statusTests :: TestTree+statusTests = testGroup "Status Parser Test"+  [ testCase "with an empty input, should return 0 for all categories" $+      gitParseStatus ""  @?= zeroLocalRepoChanges++    , testCase "with one locally modified file" $+      gitParseStatus " M some random foo bar stuff\n" @?= (zeroLocalRepoChanges { localMod = 1 })++    , testCase "with one locally deleted file" $+      gitParseStatus " D some random foo bar stuff\n" @?= (zeroLocalRepoChanges { localDel = 1 })++    , testCase "with one locally added file" $+      gitParseStatus "?? some random foo bar stuff\n" @?= (zeroLocalRepoChanges { localAdd = 1 })++    , testCase "with one added file to the index" $+      gitParseStatus "A  some random foo bar stuff\n" @?= (zeroLocalRepoChanges { indexAdd = 1 })++    , testCase "with one modified file to the index" $+      gitParseStatus "M  some random foo bar stuff\n" @?= (zeroLocalRepoChanges { indexMod = 1 })++    , testCase "with one added file to the index" $+      gitParseStatus "D  some random foo bar stuff\n" @?= (zeroLocalRepoChanges { indexDel = 1 })++    , testCase "with a conflict with both sides changed" $+      gitParseStatus "UU test\n" @?= (zeroLocalRepoChanges { conflict = 1 })++    , testCase "with a conflict with us side changed" $+      gitParseStatus "DU test\n" @?= (zeroLocalRepoChanges { conflict = 1 })++    , testCase "with a conflict with them side changed" $+      gitParseStatus "UD test\n" @?= (zeroLocalRepoChanges { conflict = 1 })++    , testCase "with a complex mix" $+      gitParseStatus+      complexStatusString+      @?= (zeroLocalRepoChanges { localAdd = 1, localDel = 1, localMod = 1,+                           indexAdd = 1, indexMod = 1, indexDel = 1, conflict = 3 })++    , testCase "with a renamed file in the index" $+      gitParseStatus "R  test\n" @?= (zeroLocalRepoChanges { renamed = 1 })++    , testCase "with a file renamed in the index and modified locally" $+      gitParseStatus "RM test\n" @?= (zeroLocalRepoChanges { localMod = 1, renamed = 1 })++    , testCase "with a file renamed in the index and deleted locally" $+      gitParseStatus "RD test\n" @?= (zeroLocalRepoChanges { localDel = 1, renamed = 1 })++    , testCase "with a file modified in the index and deleted locally" $+      gitParseStatus "MD test\n" @?= (zeroLocalRepoChanges { localDel = 1, indexMod = 1 })++    , testCase "with a file changed in the index AND locally" $+      gitParseStatus "MM test\n" @?= (zeroLocalRepoChanges { localMod = 1, indexMod = 1 })++    , testCase "with a file added in the index AND modified locally" $+      gitParseStatus "AM test\n" @?= (zeroLocalRepoChanges { localMod = 1, indexAdd = 1 })++    , testCase "with a file added in the index AND deleted locally" $+      gitParseStatus "AD test\n" @?= (zeroLocalRepoChanges { localDel = 1, indexAdd = 1 })++  ]++complexStatusString :: String+complexStatusString =+  " M foo\n\+  \ D bar\n\+  \?? add\n\+  \A  add\n\+  \M  mod\n\+  \D  del\n\+  \UU conflict\n\+  \DU conflict\n\+  \UD conflict\n"