Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Browse files

Added support for fetching the tree for a commit

  • Loading branch information...
commit 426659e2f11698f93cfcf4e4ccadbc124243366b 1 parent 6c15155
@jystic authored
Showing with 61 additions and 27 deletions.
  1. +1 −0  gittens.cabal
  2. +60 −27 src/Main.hs
View
1  gittens.cabal
@@ -21,6 +21,7 @@ executable gittens
, blaze-builder == 0.3.*
, bytestring == 0.10.*
, conduit == 0.5.*
+ , containers == 0.5.*
, gitlib == 0.7.*
, http-types == 0.8.*
, network == 2.4.*
View
87 src/Main.hs
@@ -3,24 +3,26 @@
{-# OPTIONS_GHC -fno-warn-orphans #-}
import Control.Applicative
+import Control.Monad
import Control.Monad.IO.Class (liftIO)
import Data.Aeson (ToJSON(..), object, (.=))
import Data.Attoparsec.Text.Lazy
import Data.Git
import Data.Maybe (catMaybes, listToMaybe)
+import qualified Data.Map as M
import Data.Monoid ((<>))
import Data.Text (Text, unpack)
import qualified Data.Text as T
import Data.Text.Encoding (decodeUtf8)
import Data.Text.Lazy (toStrict, fromStrict)
-import Filesystem.Path.CurrentOS
+import Filesystem.Path.CurrentOS hiding (concat)
import Network (withSocketsDo)
import Network.Wai (rawPathInfo)
import Network.Wai.Middleware.RequestLogger
import Network.Wai.Middleware.Static hiding ((<|>))
-import Web.Scotty
+import Web.Scotty hiding (body, files)
-import Prelude hiding (FilePath)
+import Prelude hiding (FilePath, log)
main :: IO ()
main = withSocketsDo $ do
@@ -44,30 +46,41 @@ app = do
process :: GitRequest -> ActionM ()
-process (Refs path) = do
- repo <- liftIO (openRepository path)
- refs <- liftIO (listRefNames repo allRefsFlag)
- json refs
-
-process (Commits path ref limit) = do
- repo <- liftIO (openRepository path)
- commits <- liftIO (getCommits repo ref limit)
- json commits
+process (GitRefs path) =
+ (json =<<) . liftIO $ do
+ repo <- openRepository path
+ listRefNames repo allRefsFlag
+
+process (GitCommits path ref limit) = do
+ (json =<<) . liftIO $ do
+ repo <- openRepository path
+ commit <- getCommit repo ref
+ getHistory limit commit
+
+process (GitTree path ref) = do
+ (json =<<) . liftIO $ do
+ repo <- openRepository path
+ commit <- getCommit repo ref
+ tree <- loadObject' (commitTree commit) commit
+ files <- getFiles tree
+ return $ map (\(p,b) -> (p, show (getId b))) files
------------------------------------------------------------------------
type RepoPath = FilePath
-type OidOrRef = Text
+type Revision = Text
data GitRequest
- = Refs RepoPath
- | Commits RepoPath OidOrRef Int
+ = GitRefs RepoPath
+ | GitCommits RepoPath Revision Int
+ | GitTree RepoPath Revision
deriving (Eq, Show)
pGitRequest :: Parser GitRequest
pGitRequest =
- Refs <$> pRepoPath <*. "refs"
- <|> Commits <$> pRepoPath <*> pOidOrRef <*> "commits/" .*> decimal
+ GitRefs <$> pRepoPath <*. "refs"
+ <|> GitCommits <$> pRepoPath <*> pRevision <*> "commits/" .*> decimal
+ <|> GitTree <$> pRepoPath <*> pRevision <*. "tree"
pRepoPath :: Parser RepoPath
pRepoPath = fromText <$> (windows <|> unix)
@@ -82,8 +95,8 @@ pRepoPath = fromText <$> (windows <|> unix)
char ':'
return (d <> ":" <> p)
-pOidOrRef :: Parser OidOrRef
-pOidOrRef = takeWhile1 (/= ':') <* char ':'
+pRevision :: Parser Revision
+pRevision = takeWhile1 (/= ':') <* char ':'
------------------------------------------------------------------------
@@ -108,16 +121,16 @@ resolveRef' repo ref = do
]
return $ listToMaybe $ catMaybes xs
-getCommits :: Repository -> Text -> Int -> IO [Commit]
-getCommits repo ref limit = do
- moid <- resolveRef' repo ref
- case moid of
+getCommit :: Repository -> Text -> IO Commit
+getCommit repo ref = do
+ mOid <- resolveRef' repo ref
+ case mOid of
Nothing -> error ("Cannot resolve: " ++ unpack ref)
Just oid -> do
- mcommit <- lookupCommit repo oid
- case mcommit of
+ mCommit <- lookupCommit repo oid
+ case mCommit of
Nothing -> error ("Cannot find ref: " ++ show oid)
- Just commit -> getHistory limit commit
+ Just commit -> return commit
getHistory :: Int -> Commit -> IO [Commit]
getHistory 0 _ = return []
@@ -129,13 +142,32 @@ getHistory n c = do
ps' <- getHistory (n-1) p
return (c:ps')
+getFiles :: Tree -> IO [(Text, Blob)]
+getFiles tree =
+ liftM concat . mapM go $ M.toList $ treeContents tree
+ where
+ go (name, BlobEntry ref _) = do
+ blob <- loadObject' ref tree
+ return [(name, blob)]
+ go (name, TreeEntry ref) = do
+ subTree <- loadObject' ref tree
+ files <- getFiles subTree
+ return (map prefix files)
+ where
+ prefix (p, b) = (name `T.append` "/" `T.append` p, b)
+
instance ToJSON Commit where
toJSON c = object [
"hash" .= show (getId c)
, "author" .= commitAuthor c
, "committer" .= commitCommitter c
- , "log" .= commitLog c
+ , "subject" .= subject
+ , "body" .= body
]
+ where
+ log = commitLog c
+ subject = T.takeWhile (/= '\n') log
+ body = T.strip $ T.dropWhile (/= '\n') log
instance ToJSON Signature where
toJSON s = object [
@@ -143,3 +175,4 @@ instance ToJSON Signature where
, "email" .= signatureEmail s
, "when" .= signatureWhen s
]
+
Please sign in to comment.
Something went wrong with that request. Please try again.