packages feed

gitlib (empty) → 0.1.0

raw patch · 15 files changed

+828/−0 lines, 15 filesdep +basedep +bytestringdep +containerssetup-changed

Dependencies added: base, bytestring, containers, gitlib, hlibgit2, lens, process, stringable, system-fileio, system-filepath, text, time

Files

+ Data/Git.hs view
@@ -0,0 +1,43 @@+module Data.Git (+    module Data.Git.Repository,+    -- module Data.Git.Config,+    -- module Data.Git.Types,+    -- module Data.Git.Revwalk,+    -- module Data.Git.OdbBackend,+    -- module Data.Git.Tag,+    -- module Data.Git.Net,+    -- module Data.Git.Refs,+    -- module Data.Git.Refspec,+    -- module Data.Git.Reflog,+    -- module Data.Git.Commit,+    -- module Data.Git.Index,+    -- module Data.Git.Signature,+    module Data.Git.Blob,+    module Data.Git.Errors,+    module Data.Git.Oid,+    module Data.Git.Tree,+    -- module Data.Git.Odb,+    module Data.Git.Common,+    module Data.Git.Object+) where++import Data.Git.Repository+-- import Data.Git.Config+-- import Data.Git.Types+-- import Data.Git.Revwalk+-- import Data.Git.OdbBackend+-- import Data.Git.Tag+-- import Data.Git.Net+-- import Data.Git.Refs+-- import Data.Git.Refspec+-- import Data.Git.Reflog+-- import Data.Git.Commit+-- import Data.Git.Index+-- import Data.Git.Signature+import Data.Git.Blob+import Data.Git.Errors+import Data.Git.Oid+import Data.Git.Tree+-- import Data.Git.Odb+import Data.Git.Common+import Data.Git.Object
+ Data/Git/Blob.hs view
@@ -0,0 +1,106 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE TemplateHaskell #-}++module Data.Git.Blob+       ( Blob(..), HasBlob(..)+       , createBlob+       , getBlobContents+       , writeBlob )+       where++import Bindings.Libgit2+import Data.ByteString as B hiding (map)+import Data.ByteString.Unsafe+import Data.Git.Common+import Data.Git.Errors+import Data.Git.Internal+import Data.Text as T hiding (map)+import Prelude hiding (FilePath)++default (Text)++data Blob = Blob { _blobInfo     :: Base Blob+                 , _blobContents :: B.ByteString }++makeClassy ''Blob++instance Show Blob where+  show x = case x^.blobInfo.gitId of+    Left _  -> "Blob"+    Right y -> "Blob#" ++ show y++instance Updatable Blob where+  update = writeBlob+  objectId = undefined++-- | Create a new blob in the 'Repository', with 'ByteString' as its contents.+--+--   Note that since empty blobs cannot exist in Git, no means is provided for+--   creating one; if the give string is 'empty', it is an error.+createBlob :: Repository -> B.ByteString -> Blob+createBlob repo text+  | text == B.empty = error "Cannot create an empty blob"+  | otherwise = Blob { _blobInfo     = newBase repo (Left doWriteBlob) Nothing+                     , _blobContents = text }++lookupBlob :: Repository -> Oid -> IO (Maybe Blob)+lookupBlob repo oid =+  lookupObject' repo oid c'git_blob_lookup c'git_blob_lookup_prefix+                (\coid obj _ ->+                  return Blob { _blobInfo     = newBase repo (Right coid)+                                                             (Just obj)+                              , _blobContents = B.empty })++getBlobContents :: Blob -> IO (Blob, B.ByteString)+getBlobContents b =+  case b^.blobInfo.gitId of+    Left _     -> return $ (b, contents)+    Right hash ->+      if contents /= B.empty+        then return (b, contents)+        else+        case b^.blobInfo.gitObj of+          Just blobPtr ->+            withForeignPtr blobPtr $ \ptr -> do+              size <- c'git_blob_rawsize (castPtr ptr)+              buf  <- c'git_blob_rawcontent (castPtr ptr)+              bstr <- curry unsafePackCStringLen (castPtr buf)+                            (fromIntegral size)+              return (blobContents .~ bstr $ b, bstr)++          Nothing -> do+            b' <- lookupBlob repo (Oid hash)+            case b' of+              Just blobPtr' -> getBlobContents blobPtr'+              Nothing       -> return (b, B.empty)++  where repo     = b^.blobInfo.gitRepo+        contents = b^.blobContents++-- | Write out a blob to its repository.  If it has already been written,+--   nothing will happen.+writeBlob :: Blob -> IO Blob+writeBlob b@(Blob { _blobInfo = Base { _gitId = Right _ } }) = return b+writeBlob b = do hash <- doWriteBlob b+                 return $ blobInfo.gitId .~ Right hash $+                          blobContents   .~ B.empty    $ b++doWriteBlob :: Blob -> IO COid+doWriteBlob b = do+  ptr <- mallocForeignPtr+  r   <- withForeignPtr repo (createFromBuffer ptr)+  when (r < 0) $ throwIO BlobCreateFailed+  return (COid ptr)++  where+    repo = fromMaybe (error "Repository invalid") $+           b^.blobInfo.gitRepo.repoObj++    createFromBuffer ptr repoPtr =+      unsafeUseAsCStringLen (b^.blobContents) $+        uncurry (\cstr len ->+                  withForeignPtr ptr $ \ptr' ->+                    c'git_blob_create_frombuffer+                      ptr' repoPtr (castPtr cstr) (fromIntegral len))++-- Blob.hs
+ Data/Git/Commit.hs view
@@ -0,0 +1,31 @@+{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE TemplateHaskell #-}++module Data.Git.Commit where++import Bindings.Libgit2+import Control.Lens+import Data.Either+import Data.Git.Common+import Data.Git.Internal+import Data.Git.Tree+import Data.Text as T hiding (map)+import Prelude hiding (FilePath)++default (Text)++data Commit = Commit { _commitInfo :: Base Commit+                     , _commitWho  :: WhoWhen+                     , _commitLog  :: Text+                     , _commitTree :: Tree+                     , _commitObj  :: ObjPtr C'git_commit }++makeClassy ''Commit++instance Show Commit where+  show x = case x^.commitInfo.gitId of+    Left _  -> "Commit"+    Right y -> "Commit#" ++ show y++-- Commit.hs
+ Data/Git/Common.hs view
@@ -0,0 +1,34 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE TemplateHaskell #-}++module Data.Git.Common+       ( Author, HasAuthor(..)+       , WhoWhen, HasWhoWhen(..)+       , Base(..), gitId, gitRepo+       , newBase )+       where++import Control.Lens+import Data.Either+import Data.Git.Internal+import Data.Text as T hiding (map)+import Data.Time+import Prelude hiding (FilePath)++default (Text)++data Author = Author { _authorName  :: Text+                     , _authorEmail :: Text }+            deriving (Show, Eq)++makeClassy ''Author++data WhoWhen = WhoWhen { _whoAuthor        :: Author+                       , _whoAuthorDate    :: UTCTime+                       , _whoCommitter     :: Author+                       , _whoCommitterDate :: UTCTime }+           deriving (Show, Eq)++makeClassy ''WhoWhen++-- Common.hs
+ Data/Git/Errors.hs view
@@ -0,0 +1,23 @@+{-# LANGUAGE DeriveDataTypeable #-}++module Data.Git.Errors+       ( GitException(..) )+       where++import Control.Exception+import Data.Typeable+import Prelude hiding (FilePath)++data GitException = RepositoryNotExist String+                  | RepositoryInvalid+                  | BlobCreateFailed+                  | TreeCreateFailed+                  | TreeBuilderCreateFailed+                  | ObjectLookupFailed+                  | ObjectIdTooLong+                  | OidCopyFailed+                  deriving (Show, Typeable)++instance Exception GitException++-- Errors.hs
+ Data/Git/Internal.hs view
@@ -0,0 +1,153 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE TypeSynonymInstances #-}+{-# LANGUAGE FlexibleInstances #-}++module Data.Git.Internal+       ( ObjPtr++       , Updatable(..)++       , Base(..), gitId, gitRepo, gitObj+       , newBase++       , Repository+       , HasRepository(..)++       , openRepository+       , createRepository+       , openOrCreateRepository+       , repositoryPtr++       , lookupObject'++       , module F+       , module X )+       where++import           Bindings.Libgit2 as X+import           Control.Applicative as X+import           Control.Exception as X+import           Control.Lens as X hiding((<.>))+import           Control.Monad as X hiding (mapM, mapM_, sequence, sequence_,+                                            forM, forM_, msum)+import           Data.Either as X+import           Data.Foldable as X+import           Data.Git.Errors as X+import           Data.Git.Oid as X+import           Data.Maybe as X+import           Data.Monoid as X+import           Data.Stringable as X+import           Data.Text as T hiding (map)+import           Data.Traversable as X+import           Filesystem as X+import qualified Filesystem.Path.CurrentOS as F+import           Filesystem.Path.CurrentOS as X hiding (empty, concat,+                                                        toText, fromText)+import           Foreign.C.String as X+import           Foreign.C.Types as X+import           Foreign.ForeignPtr as X+import           Foreign.Marshal.Alloc as X+import           Foreign.Marshal.Utils as X+import           Foreign.Ptr as X+import           Foreign.StablePtr as X+import           Foreign.Storable as X+import           Prelude hiding (FilePath, mapM, mapM_, sequence, sequence_)+import           Unsafe.Coerce as X++default (Text)++type ObjPtr a = Maybe (ForeignPtr a)++class Updatable a where+  update :: a -> IO a+  update_ :: a -> IO ()+  update_ x = void (update x)+  objectId :: a -> IO Oid++data Repository = Repository { _repoPath :: FilePath+                             , _repoObj  :: ObjPtr C'git_repository }++makeClassy ''Repository++instance Show Repository where+  show x = "Repository " <> toString (x^.repoPath)++data Base a = Base { _gitId   :: Ident a+                   , _gitRepo :: Repository+                   , _gitObj  :: ObjPtr C'git_object }++makeLenses ''Base++instance Show (Base a) where+  show x = case x^.gitId of+    Left _  -> "Base"+    Right y -> "Base#" ++ show y++newBase :: Repository -> Ident a -> ObjPtr C'git_object -> Base a+newBase repo oid obj = Base { _gitId   = oid+                            , _gitRepo = repo+                            , _gitObj  = obj }++repositoryPtr :: Repository -> ForeignPtr C'git_repository+repositoryPtr repo = fromMaybe (error "Repository invalid") (repo^.repoObj)++openRepository :: FilePath -> IO Repository+openRepository path =+  openRepositoryWith path c'git_repository_open++createRepository :: FilePath -> Bool -> IO Repository+createRepository path bare =+  openRepositoryWith path (\x y -> c'git_repository_init x y (fromBool bare))++openOrCreateRepository :: FilePath -> Bool -> IO Repository+openOrCreateRepository path bare = do+  b <- isDirectory path+  if b+    then openRepository path+    else createRepository path bare++openRepositoryWith :: FilePath+                   -> (Ptr (Ptr C'git_repository) -> CString -> IO CInt)+                   -> IO Repository+openRepositoryWith path fn = alloca $ \ptr ->+  case F.toText path of+    Left p  -> doesNotExist p+    Right p ->+      withCStringable p $ \str -> do+        r <- fn ptr str+        when (r < 0) $ doesNotExist p+        ptr' <- peek ptr+        fptr <- newForeignPtr p'git_repository_free ptr'+        return Repository { _repoPath = path+                          , _repoObj  = Just fptr }++  where doesNotExist = throwIO . RepositoryNotExist . toString++lookupObject'+  :: Repository -> Oid+  -> (Ptr (Ptr a) -> Ptr C'git_repository -> Ptr C'git_oid -> IO CInt)+  -> (Ptr (Ptr a) -> Ptr C'git_repository -> Ptr C'git_oid -> CUInt -> IO CInt)+  -> (COid -> ForeignPtr C'git_object -> Ptr C'git_object -> IO b)+  -> IO (Maybe b)+lookupObject' repo oid lookupFn lookupPrefixFn createFn = alloca $ \ptr -> do+  r <- withForeignPtr (repositoryPtr repo) $ \repoPtr ->+         case oid of+           Oid (COid oid') ->+             withForeignPtr oid' $ \oidPtr ->+               lookupFn (castPtr ptr) repoPtr oidPtr+           PartialOid (COid oid') len ->+             withForeignPtr oid' $ \oidPtr ->+               lookupPrefixFn (castPtr ptr) repoPtr oidPtr (fromIntegral len)+  if r < 0+    then return Nothing+    else do+      ptr'     <- peek ptr+      coid     <- c'git_object_id ptr'+      coidCopy <- mallocForeignPtr+      withForeignPtr coidCopy $ flip c'git_oid_cpy coid++      fptr <- newForeignPtr p'git_object_free ptr'+      Just <$> createFn (COid coidCopy) fptr ptr'++-- Internal.hs
+ Data/Git/Object.hs view
@@ -0,0 +1,62 @@+{-# LANGUAGE OverloadedStrings #-}++module Data.Git.Object+       ( Object(..)+       , Ref(..)+       , revParse+       , lookupObject )+       where++import           Data.ByteString as B hiding (map)+import           Data.Git.Blob+import           Data.Git.Commit+import           Data.Git.Internal+import           Data.Git.Tag+import           Data.Git.Tree+import qualified Data.Map as M++data Object = BlobObj   Blob+            | TreeObj   Tree+            | CommitObj Commit+            | TagObj    Tag++data Ref a = FullHash a+           | PartialHash a+           | BranchName a+           | TagName a+           | RefName a+           | FullRefName a+           | Specifier a++revParse :: CStringable a => Ref a -> IO (Maybe Oid)+revParse (FullHash r)    = stringToOid r+revParse (PartialHash r) = stringToOid r+revParse (BranchName r)  = undefined+revParse (TagName r)     = undefined+revParse (RefName r)     = undefined+revParse (FullRefName r) = undefined+revParse (Specifier r)   = undefined++lookupObject :: Repository -> Oid -> IO (Maybe Object)+lookupObject repo oid =+  lookupObject' repo oid+    (\x y z    -> c'git_object_lookup x y z c'GIT_OBJ_ANY)+    (\x y z l  -> c'git_object_lookup_prefix x y z l c'GIT_OBJ_ANY)+    (\coid x y -> c'git_object_type y >>= createObject repo coid x)++createObject :: Repository -> COid -> ForeignPtr C'git_object -> C'git_otype+             -> IO Object+createObject repo coid obj typ+  | typ == c'GIT_OBJ_BLOB =+    return $ BlobObj Blob { _blobInfo =+                               newBase repo (Right coid) (Just obj)+                          , _blobContents = B.empty }++  | typ == c'GIT_OBJ_TREE =+    return $ TreeObj Tree { _treeInfo =+                               newBase repo (Right coid) (Just obj)+                          , _treeContents = M.empty }++  | otherwise = return undefined++-- Object.hs
+ Data/Git/Oid.hs view
@@ -0,0 +1,83 @@+{-# LANGUAGE FlexibleInstances #-}++module Data.Git.Oid+       ( Oid(..)+       , COid(..)+       , Ident+       , compareCOid+       , compareCOidLen+       , equalCOid+       , stringToOid )+       where++import Bindings.Libgit2.Oid+import Control.Exception+import Control.Monad+import Data.ByteString.Unsafe+import Data.Git.Errors+import Data.Stringable as S+import Foreign.ForeignPtr+import System.IO.Unsafe++newtype COid = COid (ForeignPtr C'git_oid)++instance Show COid where+  show (COid x) =+    toString $ unsafePerformIO $+      withForeignPtr x (unsafePackMallocCString <=< c'git_oid_allocfmt)++type Ident a = Either (a -> IO COid) COid++data Oid = Oid COid+         | PartialOid COid Int+         deriving Show++compareCOid :: COid -> COid -> Ordering+(COid x) `compareCOid` (COid y) =+  let c = unsafePerformIO $+            withForeignPtr x $ \x' ->+              withForeignPtr y $ \y' ->+                c'git_oid_cmp x' y'+  in c `compare` 0++compareCOidLen :: COid -> COid -> Int -> Ordering+compareCOidLen (COid x) (COid y) l =+  let c = unsafePerformIO $+            withForeignPtr x $ \x' ->+              withForeignPtr y $ \y' ->+                c'git_oid_ncmp x' y' (fromIntegral l)+  in c `compare` 0++instance Ord COid where+  compare = compareCOid++equalCOid :: Ord a => a -> a -> Bool+x `equalCOid` y = (x `compare` y) == EQ++instance Eq COid where+  (==) = equalCOid++instance Eq Oid where+  (Oid x) == (Oid y) = x `equalCOid` y+  (PartialOid x xl) == (PartialOid y yl) =+    xl == yl && compareCOidLen x y xl == EQ+  _ == _ = False++stringToOid :: CStringable a => a -> IO (Maybe Oid)+stringToOid str+  | len > 40 = throwIO ObjectIdTooLong+  | otherwise = do+    oid <- mallocForeignPtr+    withCStringable str $ \cstr ->+      withForeignPtr oid $ \ptr -> do+        r <- if len == 40+             then c'git_oid_fromstr ptr cstr+             else c'git_oid_fromstrn ptr cstr (fromIntegral len)+        if r < 0+          then return Nothing+          else return . Just $ if len == 40+                               then Oid (COid oid)+                               else PartialOid (COid oid) len+  where len = S.length str++-- Oid.hs
+ Data/Git/Repository.hs view
@@ -0,0 +1,21 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE TemplateHaskell #-}++module Data.Git.Repository+       ( Oid+       , Ident+       , ObjPtr++       , Updatable(..)++       , Repository+       , HasRepository(..)++       , openRepository+       , createRepository+       , openOrCreateRepository )+       where++import Data.Git.Internal++-- Repository.hs
+ Data/Git/Tag.hs view
@@ -0,0 +1,25 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE TemplateHaskell #-}++module Data.Git.Tag where++import Control.Lens+import Data.Either+import Data.Git.Common+import Data.Git.Internal+import Data.Text as T hiding (map)+import Prelude hiding (FilePath)++default (Text)++data Tag = Tag { _tagInfo :: Base Tag+               , _tagRef  :: Oid }++makeClassy ''Tag++instance Show Tag where+  show x = case x^.tagInfo.gitId of+    Left _  -> "Tag"+    Right y -> "Tag#" ++ show y++-- Tag.hs
+ Data/Git/Tree.hs view
@@ -0,0 +1,116 @@+{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE TemplateHaskell #-}++module Data.Git.Tree where++import           Bindings.Libgit2+import           Control.Lens+import           Data.Either+import           Data.Git.Blob+import           Data.Git.Common+import           Data.Git.Errors+import           Data.Git.Internal+import qualified Data.Map as M hiding (map)+import           Data.Text as T hiding (map)+import           Filesystem.Path.CurrentOS as F+import           Prelude hiding (FilePath)++default (Text)++type TreeOrBlob = Either Blob Tree+type TreeMap    = M.Map Text TreeOrBlob++data Tree = Tree { _treeInfo     :: Base Tree+                 , _treeContents :: TreeMap }++makeClassy ''Tree++instance Show Tree where+  show x = case x^.treeInfo.gitId of+    Left _  -> "Tree"+    Right y -> "Tree#" ++ show y++instance Updatable Tree where+  update     = writeTree+  --objectId t = return $ t^.treeInfo.gitId+  objectId t = undefined++newTreeBase :: Tree -> Base Tree+newTreeBase t = newBase (t^.treeInfo.gitRepo) (Left doWriteTree) Nothing++-- | Create a new tree, starting it with the contents at the given path.+--+--   Note that since empty trees cannot exist in Git, no means is provided for+--   creating one.+createTree :: Repository -> FilePath -> TreeOrBlob -> Tree+createTree repo path item = updateTree path item (emptyTree repo)++lookupTree :: Repository -> Oid -> IO (Maybe Tree)+lookupTree repo oid =+  lookupObject' repo oid c'git_tree_lookup c'git_tree_lookup_prefix+    (\coid obj _ ->+      return Tree { _treeInfo =+                       newBase repo (Right coid) (Just obj)+                  , _treeContents = M.empty })++-- | Write out a tree to its repository.  If it has already been written,+--   nothing will happen.+writeTree :: Tree -> IO Tree+writeTree t@(Tree { _treeInfo = Base { _gitId = Right _ } }) = return t+writeTree t = do hash <- doWriteTree t+                 return $ treeInfo.gitId .~ Right hash $ t++doWriteTree :: Tree -> IO COid+doWriteTree t = do+  ptr <- mallocForeignPtr+  r   <- withForeignPtr repo (createFromTreeMap ptr)+  -- when (r < 0) $ throwIO TreeCreateFailed+  return (COid ptr)++  where repo = fromMaybe (error "Repository invalid") $+                         t^.treeInfo.gitRepo.repoObj++createFromTreeMap t repoPtr = alloca $ \ptr -> do+  r <- c'git_treebuilder_create ptr nullPtr+  when (r < 0) $ throwIO TreeBuilderCreateFailed+  builder <- peek ptr+  return undefined+{-+  for (M.toList (t^.treeContents)) $ \k v -> do+    v'  <- update v               -- make sure the object is updated+    oid <- objectId v'+    withCStringable k $ \name ->+      c'git_treebuilder_insert nullPtr builder name oid 0+-}++emptyTree :: Repository -> Tree+emptyTree repo =+  Tree { _treeInfo     = newBase repo (Left doWriteTree) Nothing+       , _treeContents = M.empty }++doUpdateTree :: [Text] -> TreeOrBlob -> Tree -> Tree+doUpdateTree (x:xs) item t =+  treeInfo     .~ newTreeBase t $+  treeContents .~ update' xs    $ t++  where repo       = t^.treeInfo.gitRepo+        treeMap    = t^.treeContents+        update' [] = M.insert x item treeMap+        update' _  = M.insert x subTree treeMap+        subTree    = Right $ doUpdateTree xs item tree'+        tree'      = case M.lookup x treeMap of+                       Just (Right m) -> m+                       _ -> emptyTree repo+doUpdateTree [] _ _ = undefined++updateTree :: FilePath -> TreeOrBlob -> Tree -> Tree+updateTree = doUpdateTree . splitPath++splitPath :: FilePath -> [Text]+splitPath path = splitOn "/" text+  where text = case F.toText path of+                 Left x  -> error $ "Invalid path: " ++ T.unpack x+                 Right y -> y++-- Tree.hs
+ LICENSE view
@@ -0,0 +1,19 @@+opyright (c) 2012 John Wiegley++Permission is hereby granted, free of charge, to any person obtaining a copy+of this software and associated documentation files (the "Software"), to deal+in the Software without restriction, including without limitation the rights+to use, copy, modify, merge, publish, distribute, sublicense, and/or sell+copies of the Software, and to permit persons to whom the Software is+furnished to do so, subject to the following conditions:++The above copyright notice and this permission notice shall be included in+all copies or substantial portions of the Software.++THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR+IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,+FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE+AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER+LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,+OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN+THE SOFTWARE.
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ gitlib.cabal view
@@ -0,0 +1,62 @@+Name:                gitlib+Version:             0.1.0+Synopsis:            Higher-level types for working with hlibgit2+Description:         Higher-level types for working with hlibgit2+License-file:        LICENSE+License:             MIT+Author:              John Wiegley+Maintainer:          johnw@newartisans.com+Build-Type:          Simple+Cabal-Version:       >=1.10+Category:            FFI++Source-repository head+  type: git+  location: git://github.com/jwiegley/gitlib.git++Test-suite smoke+  default-language: Haskell98+  type: exitcode-stdio-1.0+  main-is: Main.hs+  hs-source-dirs: tests+  build-depends:+      base >=3+    , gitlib+    , process+    , system-filepath >= 0.4.7+    , system-fileio   >= 0.3.9+    , time            >= 1.4+    , text            >= 0.11.2+    , containers      >= 0.4.2+    , bytestring      >= 0.9.2.1+    , stringable      >= 0.1+    , lens            >= 2.8++Library+  default-language: Haskell98+  default-extensions:+    ForeignFunctionInterface+  build-depends:+      base            >= 3 && < 5+    , hlibgit2        >= 0.6+    , system-filepath >= 0.4.7+    , system-fileio   >= 0.3.9+    , time            >= 1.4+    , text            >= 0.11.2+    , containers      >= 0.4.2+    , bytestring      >= 0.9.2.1+    , stringable      >= 0.1+    , lens            >= 2.8+  exposed-modules:+    Data.Git+    Data.Git.Blob+    Data.Git.Commit+    Data.Git.Common+    Data.Git.Errors+    Data.Git.Object+    Data.Git.Oid+    Data.Git.Repository+    Data.Git.Tag+    Data.Git.Tree+  other-modules:+    Data.Git.Internal
+ tests/Main.hs view
@@ -0,0 +1,48 @@+{-# LANGUAGE OverloadedStrings #-}++module Main where++import           Control.Monad+import           Data.Foldable+import           Data.Git+import           Data.Text as T hiding (map)+import           Data.Text.IO+import qualified Data.Text.Encoding as E+import           Filesystem.Path.CurrentOS+import           Foreign.C.String+import           Foreign.Marshal.Alloc+import           Foreign.Storable+import           Prelude hiding (FilePath, putStr, putStrLn)+import           System.Exit+import           System.Process(system)++default (Text)++main :: IO ()+main = do+  putStrLn "Accessing via higher-level types..."+  repo <- createRepository (fromText "smoke.git") True+  update_ $ createBlob repo (E.encodeUtf8 "Hello, world!\n")++  putStrLn "Looking up Blob by its full SHA..."+  catBlob repo "af5626b4a114abcb82d63db7c8082c3c4756e51b"++  putStrLn "Looking up Blob by its short SHA..."+  catBlob repo "af5626b"++catBlob :: Repository -> Text -> IO ()+catBlob repo sha = do+  hash <- stringToOid sha+  print hash+  for_ hash $ \hash' -> do+    obj <- lookupObject repo hash'+    case obj of+      Just (BlobObj b) -> do+        putStrLn "Found a blob, contents: "+        (_, contents) <- getBlobContents b+        putStr (E.decodeUtf8 contents)++      Just _  -> error "Found something else..."+      Nothing -> error "Didn't find anything :("++-- Main.hs ends here