miss-0: A Haskell git implimentation

Safe HaskellNone
LanguageHaskell2010

Data.Git.Monad

Contents

Description

Functionality we're currently missing (an assuredly incomplete list):

  • .git textfile (gitdir: some-path)
  • using $GIT_DIRECTORY
  • objectsinfoalternates or $GIT_ALTERNATE_OBJECT_DIRECTORIES
Synopsis

The Git Monad

class Monad m => MonadGit m where Source #

Monads that let you work with git repositories.

Methods

lookupSha :: Sha1 -> m (Maybe Object) Source #

Try to look up an object by its Sha1.

writeObject :: Object -> m Sha1 Source #

Write an Object to storage, returning its Sha1. We should have the law: writeObject o >>= s -> flushObjects >> lookupSha s == return (Just o)

flushObjects :: m () Source #

Flush written Objects to disk. Defaults to a no-op.

lookupRef :: Ref -> m (Maybe Sha1) Source #

Try to get the Sha1 from a Ref.

listRefs :: m (Map Ref (Maybe Sha1)) Source #

A Map from Refs to the Sha1s at which they point, optionally. An instance may choose not to provide hashes for some Refs (e.g., only providing hashes for packed refs, but not loose ones).

writeRef :: Ref -> Sha1 -> m () Source #

Write a Ref to the given Sha1.

writeSymRef Source #

Arguments

:: Ref

write a symref here

-> Ref

pointing to here

-> m () 

Write a symref from the first argument to the second.

registerPack :: PackFile -> m () Source #

Register a packfile with git so it knows to search it. Primarily a support function for PackingT, and perhaps should be seperated out.

Instances
MonadIO m => MonadGit (GitT m) Source #

A concrete MonadGit instance writing loose objects.

Instance details

Defined in Data.Git.Monad

(MonadGit m, MonadIO m) => MonadGit (PackingT m) Source #

Like the instance for GitT, but writing packfiles.

Instance details

Defined in Data.Git.Monad

data GitT m a Source #

A Git monad transformer that writes loose objects.

Instances
MonadTrans GitT Source # 
Instance details

Defined in Data.Git.Internal.Types

Methods

lift :: Monad m => m a -> GitT m a #

Monad m => MonadState GitConf (GitT m) Source # 
Instance details

Defined in Data.Git.Internal.Types

Methods

get :: GitT m GitConf #

put :: GitConf -> GitT m () #

state :: (GitConf -> (a, GitConf)) -> GitT m a #

Monad m => Monad (GitT m) Source # 
Instance details

Defined in Data.Git.Internal.Types

Methods

(>>=) :: GitT m a -> (a -> GitT m b) -> GitT m b #

(>>) :: GitT m a -> GitT m b -> GitT m b #

return :: a -> GitT m a #

fail :: String -> GitT m a #

Functor m => Functor (GitT m) Source # 
Instance details

Defined in Data.Git.Internal.Types

Methods

fmap :: (a -> b) -> GitT m a -> GitT m b #

(<$) :: a -> GitT m b -> GitT m a #

MonadFail m => MonadFail (GitT m) Source # 
Instance details

Defined in Data.Git.Internal.Types

Methods

fail :: String -> GitT m a #

Monad m => Applicative (GitT m) Source # 
Instance details

Defined in Data.Git.Internal.Types

Methods

pure :: a -> GitT m a #

(<*>) :: GitT m (a -> b) -> GitT m a -> GitT m b #

liftA2 :: (a -> b -> c) -> GitT m a -> GitT m b -> GitT m c #

(*>) :: GitT m a -> GitT m b -> GitT m b #

(<*) :: GitT m a -> GitT m b -> GitT m a #

MonadIO m => MonadIO (GitT m) Source # 
Instance details

Defined in Data.Git.Internal.Types

Methods

liftIO :: IO a -> GitT m a #

MonadCatch m => MonadCatch (GitT m) Source # 
Instance details

Defined in Data.Git.Internal.Types

Methods

catch :: Exception e => GitT m a -> (e -> GitT m a) -> GitT m a

MonadThrow m => MonadThrow (GitT m) Source # 
Instance details

Defined in Data.Git.Internal.Types

Methods

throwM :: Exception e => e -> GitT m a

MonadIO m => MonadGit (GitT m) Source #

A concrete MonadGit instance writing loose objects.

Instance details

Defined in Data.Git.Monad

type Git a = GitT IO a Source #

A convenient version of GitT.

runGit :: RawFilePath -> Git a -> IO a Source #

Do some git computations in the given git directory.

runGitT :: MonadIO m => RawFilePath -> GitT m a -> m a Source #

Do some git computations in the given git directory.

Repository Management

initRepo :: Maybe RawFilePath -> IO () Source #

Minimal rendition of git init. When given Nothing, creates a .git/ the current working directory. When given Just path, initializes a repository at path. Thus, initRepo Nothing == initRepo (Just ".git").

repoPath :: (MonadIO m, InRepo a) => a -> GitT m RawFilePath Source #

The path of an object in the git directory

Object Reading

findBlob :: MonadGit m => Sha1 -> m (Maybe Blob) Source #

Lookup a Sha1. Nothing when the object does not exist or is not a Blob.

findTag :: MonadGit m => Sha1 -> m (Maybe Tag) Source #

Lookup a Sha1. Nothing when the object does not exist or is not a Tag.

findTree :: MonadGit m => Sha1 -> m (Maybe Tree) Source #

Lookup a Sha1. Nothing when the object does not exist or is not a Tree.

findTreeish :: MonadGit m => Sha1 -> m (Maybe Tree) Source #

A "treeish" is an object that can be recursively dereferenced to a Tree. This includes Trees themselves, Commits, and (usually) Tags.

findCommit :: MonadGit m => Sha1 -> m (Maybe Commit) Source #

Lookup a Sha1. Nothing when the object does not exist or is not a Commit.

grepCommit :: MonadGit m => (Commit -> Bool) -> Sha1 -> m (Maybe Sha1) Source #

Search through the Commit with the given Sha1 and its ancestors, for the first commit satisfying the given predicate.

resolveSha :: (MonadFail m, MonadGit m) => Sha1 -> [PathComponent] -> m (Maybe Sha1) Source #

Given a Sha1 that refers to a tree-ish (see findTreeish) and a list of path components, find the Sha1 of the object in the tree at that path.

resolveBlob :: (MonadFail m, MonadGit m) => Sha1 -> [PathComponent] -> m (Maybe Blob) Source #

As resolveSha, expecting a Blob at the given location.

Object Writing

writeBlob :: MonadGit m => Blob -> m Sha1 Source #

Write a Blob, returning its Sha1.

writeTree :: MonadGit m => Tree -> m Sha1 Source #

Write a Tree, returning its Sha1.

writeCommit :: MonadGit m => Commit -> m Sha1 Source #

Write a Commit, returning its Sha1.

writeTag :: MonadGit m => Tag -> m Sha1 Source #

Write a Tag, returning its Sha1.

Writing Packfiles

packing :: MonadIO m => PackingT (GitT m) a -> GitT m a Source #

Run a GitT computation, writing objects to a packfile instead of loose. Currently objects are not findable until flushObjects is called.

Ref Handling

readBranch :: MonadGit m => RefName -> m (Maybe Sha1) Source #

Read a Sha1 out of a branch (in refsheads)

readHead :: MonadGit m => m (Maybe Sha1) Source #

Read the Sha1 in HEAD

writeBranch :: MonadIO m => RefName -> Sha1 -> GitT m () Source #

Set a branch (in refsheads) to a particular Sha1.

writeHead :: MonadGit m => Ref -> m () Source #

Point HEAD at a Ref

detachHead :: MonadGit m => Sha1 -> m () Source #

Set HEAD to a specific Sha1. Leaves the repo in a "detached HEAD" state.

listBranches :: MonadGit m => m (Set RefName) Source #

List all branches.

readPackedRefs :: MonadIO m => GitT m (Maybe [(Ref, Sha1)]) Source #

Read this repository's packed-refs file, if it's there.

NB: Loose refs have priority over packed refs, so if (for example) a branch exists both loose and packed in the repository and is associated with different hashes, it points to whatever the loose one says. *However*, this function intentionally does *not* honor that.

peelRef :: MonadGit m => Ref -> m (Maybe Sha1) Source #

Attempt to peel (recursively dereference) a ref (usually a tag) down to the Sha1 of a non-tag object. TODO: improve this documentation.

peeled :: MonadGit m => Ref -> m Ref Source #

The peeled version of a Ref.