diff options
Diffstat (limited to 'Git')
| -rw-r--r-- | Git/Branch.hs | 8 | ||||
| -rw-r--r-- | Git/Config.hs | 3 | ||||
| -rw-r--r-- | Git/Ref.hs | 29 |
3 files changed, 33 insertions, 7 deletions
diff --git a/Git/Branch.hs b/Git/Branch.hs index cce56dcfa..98811a987 100644 --- a/Git/Branch.hs +++ b/Git/Branch.hs @@ -14,6 +14,14 @@ import Git import Git.Sha import Git.Command +{- The currently checked out branch. -} +current :: Repo -> IO (Maybe Git.Ref) +current r = parse <$> pipeRead [Param "symbolic-ref", Param "HEAD"] r + where + parse v + | L.null v = Nothing + | otherwise = Just $ Git.Ref $ firstLine $ L.unpack v + {- Checks if the second branch has any commits not present on the first - branch. -} changed :: Branch -> Branch -> Repo -> IO Bool diff --git a/Git/Config.hs b/Git/Config.hs index b2587aa44..d9109548b 100644 --- a/Git/Config.hs +++ b/Git/Config.hs @@ -29,7 +29,8 @@ read repo@(Repo { location = Dir d }) = do bracket_ (changeWorkingDirectory d) (changeWorkingDirectory cwd) $ pOpen ReadFromPipe "git" ["config", "--null", "--list"] $ hRead repo -read r = assertLocal r $ error "internal" +read r = assertLocal r $ + error $ "internal error; trying to read config of " ++ show r {- Reads git config from a handle and populates a repo with it. -} hRead :: Repo -> Handle -> IO Repo diff --git a/Git/Ref.hs b/Git/Ref.hs index 0197ae789..557d24a37 100644 --- a/Git/Ref.hs +++ b/Git/Ref.hs @@ -13,14 +13,26 @@ import Common import Git import Git.Command -{- Converts a fully qualified git ref into a user-visible version. -} +{- Converts a fully qualified git ref into a user-visible string. -} describe :: Ref -> String -describe = remove "refs/heads/" . remove "refs/remotes/" . show +describe = show . base + +{- Often git refs are fully qualified (eg: refs/heads/master). + - Converts such a fully qualified ref into a base ref (eg: master). -} +base :: Ref -> Ref +base = Ref . remove "refs/heads/" . remove "refs/remotes/" . show where remove prefix s | prefix `isPrefixOf` s = drop (length prefix) s | otherwise = s + +{- Given a directory such as "refs/remotes/origin", and a ref such as + - refs/heads/master, yields a version of that ref under the directory, + - such as refs/remotes/origin/master. -} +under :: String -> Ref -> Ref +under dir r = Ref $ dir </> show (base r) + {- Checks if a ref exists. -} exists :: Ref -> Repo -> IO Bool exists ref = runBool "show-ref" @@ -36,13 +48,18 @@ sha branch repo = process . L.unpack <$> showref repo process [] = Nothing process s = Just $ Ref $ firstLine s -{- List of (refs, branches) matching a given ref spec. - - Duplicate refs are filtered out. -} +{- List of (refs, branches) matching a given ref spec. -} matching :: Ref -> Repo -> IO [(Ref, Branch)] matching ref repo = do r <- pipeRead [Param "show-ref", Param $ show ref] repo - return $ nubBy uniqref $ map (gen . L.unpack) (L.lines r) + return $ map (gen . L.unpack) (L.lines r) where - uniqref (a, _) (b, _) = a == b gen l = let (r, b) = separate (== ' ') l in (Ref r, Ref b) + +{- List of (refs, branches) matching a given ref spec. + - Duplicate refs are filtered out. -} +matchingUniq :: Ref -> Repo -> IO [(Ref, Branch)] +matchingUniq ref repo = nubBy uniqref <$> matching ref repo + where + uniqref (a, _) (b, _) = a == b |