Merge branch 'master' into unusedfull

Git/LsFiles.hs

@@ -23,13 +23,16 @@ inRepo :: Repo -> [FilePath] -> IO [FilePath]
 inRepo repo l = pipeNullSplit repo $
 	Params "ls-files --cached -z --" : map File l
 
-{- Scans for files at the specified locations that are not checked into
+{- Scans for files at the specified locations that are not checked into git. -}
- - git. -}
 notInRepo :: Repo -> Bool -> [FilePath] -> IO [FilePath]
 notInRepo repo include_ignored l =
-	pipeNullSplit repo $ [Params "ls-files --others"]++exclude++[Params "-z --"] ++ map File l
+	pipeNullSplit repo $
+		[Params "ls-files --others"] ++ exclude ++
+		[Params "-z --"] ++ map File l
 	where
-		exclude = if include_ignored then [] else [Param "--exclude-standard"]
+		exclude
+			| include_ignored = []
+			| otherwise = [Param "--exclude-standard"]
 
 {- Returns a list of all files that are staged for commit. -}
 staged :: Repo -> [FilePath] -> IO [FilePath]

Git/LsTree.hs

@@ -0,0 +1,48 @@
+{- git ls-tree interface
+ -
+ - Copyright 2011 Joey Hess <joey@kitenet.net>
+ -
+ - Licensed under the GNU GPL version 3 or higher.
+ -}
+
+module Git.LsTree (
+	lsTree
+) where
+
+import Numeric
+import Control.Applicative
+import Data.Char
+
+import Git
+import Utility.SafeCommand
+
+type Treeish = String
+
+data TreeItem = TreeItem
+	{ mode :: Int
+	, objtype :: String
+	, sha :: String
+	, file :: FilePath
+	} deriving Show
+
+{- Lists the contents of a Treeish -}
+lsTree :: Repo -> Treeish -> IO [TreeItem]
+lsTree repo t = map parseLsTree <$>
+	pipeNullSplit repo [Params "ls-tree --full-tree -z -r --", File t]
+
+{- Parses a line of ls-tree output.
+ - (The --long format is not currently supported.) -}
+parseLsTree :: String -> TreeItem
+parseLsTree l = TreeItem m o s f
+	where
+		-- l = <mode> SP <type> SP <sha> TAB <file>
+		-- Since everything until the file is fixed-width,
+		-- do not need to split on words.
+		(m, past_m) = head $ readOct l
+		(o, past_o) = splitAt 4 $ space past_m
+		(s, past_s) = splitAt shaSize $ space past_o
+		f = decodeGitFile $ space past_s
+		space s@(sp:rest)
+			| isSpace sp = rest
+			| otherwise = error $
+				"ls-tree parse error at '" ++ s ++ "' in " ++ l

LocationLog.hs

@@ -23,7 +23,6 @@ module LocationLog (
 ) where
 
 import System.FilePath
-import Control.Monad (when)
 import Control.Applicative
 import Data.Maybe
 
@@ -36,16 +35,16 @@ import PresenceLog
 
 {- Log a change in the presence of a key's value in a repository. -}
 logChange :: Git.Repo -> Key -> UUID -> LogStatus -> Annex ()
-logChange repo key u s = do
+logChange repo key u s
-	when (null u) $
+	| null u = error $
-		error $ "unknown UUID for " ++ Git.repoDescribe repo ++ 
+		"unknown UUID for " ++ Git.repoDescribe repo ++ 
-			" (have you run git annex init there?)"
+		" (have you run git annex init there?)"
-	addLog (logFile key) =<< logNow s u
+	| otherwise = addLog (logFile key) =<< logNow s u
 
 {- Returns a list of repository UUIDs that, according to the log, have
  - the value of a key. -}
 keyLocations :: Key -> Annex [UUID]
-keyLocations key = currentLog $ logFile key
+keyLocations = currentLog . logFile
 
 {- Finds all keys that have location log information.
  - (There may be duplicate keys in the list.) -}

PresenceLog.hs

@@ -26,7 +26,7 @@ module PresenceLog (
 import Data.Time.Clock.POSIX
 import Data.Time
 import System.Locale
-import qualified Data.Map as Map
+import qualified Data.Map as M
 import Control.Monad.State (liftIO)
 import Control.Applicative
 
@@ -85,7 +85,7 @@ readLog :: FilePath -> Annex [LogLine]
 readLog file = parseLog <$> Branch.get file
 
 parseLog :: String -> [LogLine]
-parseLog s = filter parsable $ map read $ lines s
+parseLog = filter parsable . map read . lines
 	where
 		-- some lines may be unparseable, avoid them
 		parsable l = status l /= Undefined
@@ -102,31 +102,27 @@ logNow s i = do
 
 {- Reads a log and returns only the info that is still in effect. -}
 currentLog :: FilePath -> Annex [String]
-currentLog file = do
+currentLog file = map info . filterPresent <$> readLog file
-	ls <- readLog file
-	return $ map info $ filterPresent ls
 
 {- Returns the info from LogLines that are in effect. -}
 filterPresent :: [LogLine] -> [LogLine]
-filterPresent ls = filter (\l -> InfoPresent == status l) $ compactLog ls
+filterPresent = filter (\l -> InfoPresent == status l) . compactLog
-
-type LogMap = Map.Map String LogLine
 
 {- Compacts a set of logs, returning a subset that contains the current
  - status. -}
 compactLog :: [LogLine] -> [LogLine]
-compactLog = compactLog' Map.empty
+compactLog = M.elems . foldr mapLog M.empty
-compactLog' :: LogMap -> [LogLine] -> [LogLine]
+
-compactLog' m [] = Map.elems m
+type LogMap = M.Map String LogLine
-compactLog' m (l:ls) = compactLog' (mapLog m l) ls
 
 {- Inserts a log into a map of logs, if the log has better (ie, newer)
  - information than the other logs in the map -}
-mapLog :: LogMap -> LogLine -> LogMap
+mapLog :: LogLine -> LogMap -> LogMap
-mapLog m l = 
+mapLog l m = 
 	if better
-		then Map.insert i l m
+		then M.insert i l m
 		else m
 	where
-		better = maybe True (\l' -> date l' <= date l) $ Map.lookup i m
+		better = maybe True newer $ M.lookup i m
+		newer l' = date l' <= date l
 		i = info l

doc/git-annex.mdwn

@@ -64,6 +64,7 @@ subdirectories).
 
   Adds files in the path to the annex. Files that are already checked into
   git, or that git has been configured to ignore will be silently skipped.
+  (Use --force to add ignored files.)
 
 * get [path ...]
 

doc/install.mdwn

@@ -8,7 +8,7 @@
 
 ## Using cabal
 
-As a haskell package, git-annex can be built using cabal. For example:
+As a haskell package, git-annex can be installed using cabal. For example:
 
 	cabal install git-annex --bindir=$HOME/bin
 

doc/install/Fedora.mdwn

@@ -3,5 +3,5 @@ Installation recipe for Fedora 14.
 <pre>
 sudo yum install ghc cabal-install
 sudo cabal update
-sudo cabal install git-annex
+cabal install git-annex --bindir=$HOME/bin
 </pre>

doc/install/OSX.mdwn

@@ -9,7 +9,7 @@ sudo ln -s /opt/local/include/pcre.h  /usr/include/pcre.h # This is hack that al
 export PATH=$PATH:/opt/local/libexec/gnubin
 
 sudo cabal update
-sudo cabal install git-annex
+cabal install git-annex --bindir=$HOME/bin
 </pre>
 
 Originally posted by Jon at <https://gist.github.com/671785> --[[Joey]], modified by [[kristianrumberg]]