Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Browse files

Start working on test program

  • Loading branch information...
commit 184147d15a9dd09b8189b80c0c831a11c2e0ae18 1 parent e7c9ae8
Jurriën Stutterheim authored
2  hgit2.cabal
View
@@ -48,7 +48,7 @@ Source-Repository head
Executable hgit2
HS-Source-Dirs: src/haskell
Main-Is: Main.hs
- Build-Depends: base >= 4 && < 5, hgit2
+ Build-Depends: base >= 4 && < 5, hgit2, directory >= 1.1
Library
HS-Source-Dirs: src/haskell
13 src/haskell/Data/HGit2/Repository.chs
View
@@ -77,12 +77,13 @@ openRepoODB dir (ODB dfp) idxFile workTree =
--
-- The method will automatically detect if the repository is bare (if there is
-- a repository).
-discover :: CSize -> String -> Bool -> String -> IOEitherErr String
-discover sz startPath acrossFs ceilingDirs = alloca $ \out ->
+-- TODO: Size is not calculated correctly
+discover :: String -> Bool -> String -> IOEitherErr String
+discover startPath acrossFs ceilingDirs = alloca $ \out ->
withCString startPath $ \spStr ->
withCString ceilingDirs $ \cdsStr -> do
- res <- {#call git_repository_discover#} out (fromIntegral sz) spStr
- (fromBool acrossFs) cdsStr
+ res <- {#call git_repository_discover#} out (fromIntegral $ (length startPath * 2))
+ spStr (fromBool acrossFs) cdsStr
eitherPeekStr out id res
-- | Get the object database behind a Git repository
@@ -109,8 +110,8 @@ index (Repository fp) =
callPeek Index (\out -> {#call git_repository_index#} out r)
-- | Creates a new Git repository in the given folder.
-init :: String -> Bool -> IOEitherErr Repository
-init pth bare =
+initRepo :: String -> Bool -> IOEitherErr Repository
+initRepo pth bare =
withCString pth $ \pstr ->
callPeek Repository
(\out -> {#call git_repository_init#} out pstr (fromBool bare))
31 src/haskell/Main.hs
View
@@ -19,17 +19,32 @@ import Data.HGit2.Revwalk
import Data.HGit2.Tag
import Data.HGit2.Remote
import Data.HGit2.Transport
+import System.Directory
+pth :: String
+pth = "/Users/norm2782/src/hgit2/test/.git"
+-- TODO: Error when repo exists:
+-- No repo found: GitEoverflow
+-- Due to discover
main :: IO ()
main = do
- putStrLn "Opening repo in pwd"
- r <- openRepo "/Users/norm2782/src/hgit2/.git"
- putStrLn "Opened repo"
- case r of
- (Left err) -> putStrLn $ "Error opening repo: " ++ show err
- (Right repo) -> do msg "Checking whether repo is empty... " (isEmpty repo)
- msg "Repository path... " (path repo GitRepoPath)
-
+ putStrLn $ "Looking for repo in " ++ pth
+ disc <- discover pth False ""
+ case disc of
+ Left err -> do putStrLn $ "Error or no repo found: " ++ show err
+ putStrLn $ "Initializing new repo in " ++ pth
+ inrp <- initRepo pth False
+ case inrp of
+ Left err -> putStrLn $ "Error initializing: " ++ show err
+ Right repo -> testRepo repo
+ Right pth -> do repo <- openRepo pth
+ case repo of
+ Left err -> putStrLn $ "Error opening repo: " ++ show err
+ Right repo -> testRepo repo
msg str rhs = putStrLn . (str ++) . show =<< rhs
+
+testRepo repo = do msg "Checking whether repo is empty... " (isEmpty repo)
+ msg "Repository path... " (path repo GitRepoPath)
+ {- removeDirectoryRecursive pth-}
Please sign in to comment.
Something went wrong with that request. Please try again.