diff options
author | 2011-09-28 14:08:36 -0400 | |
---|---|---|
committer | 2011-09-28 14:08:36 -0400 | |
commit | 4afdd34e8909bbadfcbddc6c63fd9e6a31efea21 (patch) | |
tree | 296135d43e6793b1f994ff1ca556e7821b63159d | |
parent | 4bf1a5ef59026a095abf751ea60b586c299aa0b9 (diff) | |
parent | 93807564d00b3f64ad2353731fffb5c45ef8c01a (diff) |
Merge branch 'master' into unusedfull
-rw-r--r-- | Git/LsFiles.hs | 11 | ||||
-rw-r--r-- | Git/LsTree.hs | 48 | ||||
-rw-r--r-- | LocationLog.hs | 13 | ||||
-rw-r--r-- | PresenceLog.hs | 28 | ||||
-rw-r--r-- | doc/git-annex.mdwn | 1 | ||||
-rw-r--r-- | doc/install.mdwn | 2 | ||||
-rw-r--r-- | doc/install/Fedora.mdwn | 2 | ||||
-rw-r--r-- | doc/install/OSX.mdwn | 2 |
8 files changed, 77 insertions, 30 deletions
diff --git a/Git/LsFiles.hs b/Git/LsFiles.hs index 1ecbb029b..c778e5d69 100644 --- a/Git/LsFiles.hs +++ b/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 - - git. -} +{- Scans for files at the specified locations that are not checked into 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] diff --git a/Git/LsTree.hs b/Git/LsTree.hs new file mode 100644 index 000000000..8b530d2ad --- /dev/null +++ b/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 diff --git a/LocationLog.hs b/LocationLog.hs index fa660c8b6..7e5e81d7a 100644 --- a/LocationLog.hs +++ b/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 - when (null u) $ - error $ "unknown UUID for " ++ Git.repoDescribe repo ++ - " (have you run git annex init there?)" - addLog (logFile key) =<< logNow s u +logChange repo key u s + | null u = error $ + "unknown UUID for " ++ Git.repoDescribe repo ++ + " (have you run git annex init there?)" + | 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.) -} diff --git a/PresenceLog.hs b/PresenceLog.hs index e0c872997..7742651b8 100644 --- a/PresenceLog.hs +++ b/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 - ls <- readLog file - return $ map info $ filterPresent ls +currentLog file = map info . filterPresent <$> readLog file {- Returns the info from LogLines that are in effect. -} filterPresent :: [LogLine] -> [LogLine] -filterPresent ls = filter (\l -> InfoPresent == status l) $ compactLog ls - -type LogMap = Map.Map String LogLine +filterPresent = filter (\l -> InfoPresent == status l) . compactLog {- Compacts a set of logs, returning a subset that contains the current - status. -} compactLog :: [LogLine] -> [LogLine] -compactLog = compactLog' Map.empty -compactLog' :: LogMap -> [LogLine] -> [LogLine] -compactLog' m [] = Map.elems m -compactLog' m (l:ls) = compactLog' (mapLog m l) ls +compactLog = M.elems . foldr mapLog M.empty + +type LogMap = M.Map String LogLine {- 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 m l = +mapLog :: LogLine -> LogMap -> LogMap +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 diff --git a/doc/git-annex.mdwn b/doc/git-annex.mdwn index 714f23bef..3ba58f25a 100644 --- a/doc/git-annex.mdwn +++ b/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 ...] diff --git a/doc/install.mdwn b/doc/install.mdwn index cd51b96d2..6f892e37a 100644 --- a/doc/install.mdwn +++ b/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 diff --git a/doc/install/Fedora.mdwn b/doc/install/Fedora.mdwn index 068d5c111..7e983597b 100644 --- a/doc/install/Fedora.mdwn +++ b/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> diff --git a/doc/install/OSX.mdwn b/doc/install/OSX.mdwn index 680c331ee..f65e0bb4f 100644 --- a/doc/install/OSX.mdwn +++ b/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]] |