Added support for fetching the tree for a commit

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.*

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,17 +142,37 @@ 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 [
         "name"  .= signatureName s
       , "email" .= signatureEmail s
       , "when"  .= signatureWhen s
       ]
+