fiddle
This commit is contained in:
parent
16b551726d
commit
107074d662
1 changed files with 15 additions and 11 deletions
26
GitRepo.hs
26
GitRepo.hs
|
@ -7,6 +7,7 @@
|
||||||
|
|
||||||
module GitRepo (
|
module GitRepo (
|
||||||
GitRepo,
|
GitRepo,
|
||||||
|
gitRepoFromPath,
|
||||||
gitRepoCurrent,
|
gitRepoCurrent,
|
||||||
gitRepoTop,
|
gitRepoTop,
|
||||||
gitDir,
|
gitDir,
|
||||||
|
@ -35,8 +36,8 @@ data GitRepo = GitRepo {
|
||||||
} deriving (Show, Read, Eq)
|
} deriving (Show, Read, Eq)
|
||||||
|
|
||||||
{- GitRepo constructor -}
|
{- GitRepo constructor -}
|
||||||
gitRepo :: FilePath -> IO GitRepo
|
gitRepoFromPath :: FilePath -> IO GitRepo
|
||||||
gitRepo dir = do
|
gitRepoFromPath dir = do
|
||||||
b <- isBareRepo dir
|
b <- isBareRepo dir
|
||||||
|
|
||||||
let r = GitRepo {
|
let r = GitRepo {
|
||||||
|
@ -110,14 +111,17 @@ gitPipeRead repo params =
|
||||||
gitConfigRead :: GitRepo -> IO GitRepo
|
gitConfigRead :: GitRepo -> IO GitRepo
|
||||||
gitConfigRead repo = do
|
gitConfigRead repo = do
|
||||||
c <- gitPipeRead repo ["config", "--list"]
|
c <- gitPipeRead repo ["config", "--list"]
|
||||||
return repo { config = Map.fromList $ parse c }
|
return repo { config = gitConfigParse c }
|
||||||
where
|
|
||||||
parse s = map pair $ lines s
|
{- Parses git config --list output into a config map. -}
|
||||||
pair l = (key l, val l)
|
gitConfigParse :: String -> Map.Map String String
|
||||||
key l = (keyval l) !! 0
|
gitConfigParse s = Map.fromList $ map pair $ lines s
|
||||||
val l = join sep $ drop 1 $ keyval l
|
where
|
||||||
keyval l = split sep l :: [String]
|
pair l = (key l, val l)
|
||||||
sep = "="
|
key l = (keyval l) !! 0
|
||||||
|
val l = join sep $ drop 1 $ keyval l
|
||||||
|
keyval l = split sep l :: [String]
|
||||||
|
sep = "="
|
||||||
|
|
||||||
{- Returns a single git config setting, or a default value if not set. -}
|
{- Returns a single git config setting, or a default value if not set. -}
|
||||||
gitConfig :: GitRepo -> String -> String -> String
|
gitConfig :: GitRepo -> String -> String -> String
|
||||||
|
@ -132,7 +136,7 @@ gitRepoCurrent = do
|
||||||
cwd <- getCurrentDirectory
|
cwd <- getCurrentDirectory
|
||||||
top <- seekUp cwd isRepoTop
|
top <- seekUp cwd isRepoTop
|
||||||
case top of
|
case top of
|
||||||
(Just dir) -> gitRepo dir
|
(Just dir) -> gitRepoFromPath dir
|
||||||
Nothing -> error "Not in a git repository."
|
Nothing -> error "Not in a git repository."
|
||||||
|
|
||||||
seekUp :: String -> (String -> IO Bool) -> IO (Maybe String)
|
seekUp :: String -> (String -> IO Bool) -> IO (Maybe String)
|
||||||
|
|
Loading…
Add table
Add a link
Reference in a new issue