Skip to content
This repository

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Browse code

Start working on test program

  • Loading branch information...
commit 184147d15a9dd09b8189b80c0c831a11c2e0ae18 1 parent e7c9ae8
Jurriën Stutterheim authored
2  hgit2.cabal
@@ -48,7 +48,7 @@ Source-Repository head
48 48 Executable hgit2
49 49 HS-Source-Dirs: src/haskell
50 50 Main-Is: Main.hs
51   - Build-Depends: base >= 4 && < 5, hgit2
  51 + Build-Depends: base >= 4 && < 5, hgit2, directory >= 1.1
52 52
53 53 Library
54 54 HS-Source-Dirs: src/haskell
13 src/haskell/Data/HGit2/Repository.chs
@@ -77,12 +77,13 @@ openRepoODB dir (ODB dfp) idxFile workTree =
77 77 --
78 78 -- The method will automatically detect if the repository is bare (if there is
79 79 -- a repository).
80   -discover :: CSize -> String -> Bool -> String -> IOEitherErr String
81   -discover sz startPath acrossFs ceilingDirs = alloca $ \out ->
  80 +-- TODO: Size is not calculated correctly
  81 +discover :: String -> Bool -> String -> IOEitherErr String
  82 +discover startPath acrossFs ceilingDirs = alloca $ \out ->
82 83 withCString startPath $ \spStr ->
83 84 withCString ceilingDirs $ \cdsStr -> do
84   - res <- {#call git_repository_discover#} out (fromIntegral sz) spStr
85   - (fromBool acrossFs) cdsStr
  85 + res <- {#call git_repository_discover#} out (fromIntegral $ (length startPath * 2))
  86 + spStr (fromBool acrossFs) cdsStr
86 87 eitherPeekStr out id res
87 88
88 89 -- | Get the object database behind a Git repository
@@ -109,8 +110,8 @@ index (Repository fp) =
109 110 callPeek Index (\out -> {#call git_repository_index#} out r)
110 111
111 112 -- | Creates a new Git repository in the given folder.
112   -init :: String -> Bool -> IOEitherErr Repository
113   -init pth bare =
  113 +initRepo :: String -> Bool -> IOEitherErr Repository
  114 +initRepo pth bare =
114 115 withCString pth $ \pstr ->
115 116 callPeek Repository
116 117 (\out -> {#call git_repository_init#} out pstr (fromBool bare))
31 src/haskell/Main.hs
@@ -19,17 +19,32 @@ import Data.HGit2.Revwalk
19 19 import Data.HGit2.Tag
20 20 import Data.HGit2.Remote
21 21 import Data.HGit2.Transport
  22 +import System.Directory
22 23
  24 +pth :: String
  25 +pth = "/Users/norm2782/src/hgit2/test/.git"
23 26
  27 +-- TODO: Error when repo exists:
  28 +-- No repo found: GitEoverflow
  29 +-- Due to discover
24 30 main :: IO ()
25 31 main = do
26   - putStrLn "Opening repo in pwd"
27   - r <- openRepo "/Users/norm2782/src/hgit2/.git"
28   - putStrLn "Opened repo"
29   - case r of
30   - (Left err) -> putStrLn $ "Error opening repo: " ++ show err
31   - (Right repo) -> do msg "Checking whether repo is empty... " (isEmpty repo)
32   - msg "Repository path... " (path repo GitRepoPath)
33   -
  32 + putStrLn $ "Looking for repo in " ++ pth
  33 + disc <- discover pth False ""
  34 + case disc of
  35 + Left err -> do putStrLn $ "Error or no repo found: " ++ show err
  36 + putStrLn $ "Initializing new repo in " ++ pth
  37 + inrp <- initRepo pth False
  38 + case inrp of
  39 + Left err -> putStrLn $ "Error initializing: " ++ show err
  40 + Right repo -> testRepo repo
  41 + Right pth -> do repo <- openRepo pth
  42 + case repo of
  43 + Left err -> putStrLn $ "Error opening repo: " ++ show err
  44 + Right repo -> testRepo repo
34 45
35 46 msg str rhs = putStrLn . (str ++) . show =<< rhs
  47 +
  48 +testRepo repo = do msg "Checking whether repo is empty... " (isEmpty repo)
  49 + msg "Repository path... " (path repo GitRepoPath)
  50 + {- removeDirectoryRecursive pth-}

0 comments on commit 184147d

Please sign in to comment.
Something went wrong with that request. Please try again.