refactor and improve pointer file handling code

diff --git a/Annex/CatFile.hs b/Annex/CatFile.hs
index 7c0022ca59ec607bf824972d2451a4daf426ec23..aefccd42403753f018d3029f057adbc6281b84c5 100644 (file)
--- a/Annex/CatFile.hs
+++ b/Annex/CatFile.hs
@@ -14,7 +14,6 @@ module Annex.CatFile (
        catFileHandle,
        catFileStop,
        catKey,
-       parsePointer,
        catKeyFile,
        catKeyFileHEAD,
        catSymLinkTarget,
@@ -31,7 +30,7 @@ import qualified Annex
 import Git.Types
 import Git.FilePath
 import qualified Git.Ref
-import Types.Key
+import Annex.Link
 
 catFile :: Git.Branch -> FilePath -> Annex L.ByteString
 catFile branch file = do
@@ -83,22 +82,7 @@ catFileStop = do
 
 {- From ref to a symlink or a pointer file, get the key. -}
 catKey :: Ref -> Annex (Maybe Key)
-catKey ref = parsePointer . fromInternalGitPath . decodeBS . L.take maxsz 
-       <$> catObject ref
-  where
-       -- Want to avoid buffering really big files in git into memory.
-       -- 8192 bytes is plenty for a pointer to a key.
-       -- Pad some more to allow for any pointer files that might have
-       -- lines after the key explaining what the file is used for.
-       maxsz = 81920
-
-{- Only look at the first line of a pointer file. -}
-parsePointer :: String -> Maybe Key
-parsePointer s = headMaybe (lines s) >>= go
-  where
-       go l
-               | isLinkToAnnex l = file2key $ takeFileName l
-               | otherwise = Nothing
+catKey ref = parseLinkOrPointer <$> catObject ref
 
 {- Gets a symlink target. -}
 catSymLinkTarget :: Sha -> Annex String

diff --git a/Annex/Init.hs b/Annex/Init.hs
index b00e4121806d7eb9e9d7e94635ce04ae20cc74d5..7eea0dfa139172434ec8dc46be4912cb84671827 100644 (file)
--- a/Annex/Init.hs
+++ b/Annex/Init.hs
@@ -29,11 +29,11 @@ import Types.TrustLevel
 import Annex.Version
 import Annex.Difference
 import Annex.UUID
+import Annex.Link
 import Config
 import Annex.Direct
 import Annex.Content.Direct
 import Annex.Environment
-import Backend
 import Annex.Hook
 import Upgrade
 #ifndef mingw32_HOST_OS

diff --git a/Annex/Link.hs b/Annex/Link.hs
index 98b200f0a0a669f026eb87794eb6c17c4749357d..f405403f26b2bf21b482840b27da8d42050633e3 100644 (file)
--- a/Annex/Link.hs
+++ b/Annex/Link.hs
@@ -5,7 +5,9 @@
  - On other filesystems, git instead stores the symlink target in a regular
  - file.
  -
- - Copyright 2013 Joey Hess <id@joeyh.name>
+ - Pointer files are used instead of symlinks for unlocked files.
+ -
+ - Copyright 2013-2015 Joey Hess <id@joeyh.name>
  -
  - Licensed under the GNU GPL version 3 or higher.
  -}
@@ -19,6 +21,9 @@ import qualified Git.UpdateIndex
 import qualified Annex.Queue
 import Git.Types
 import Git.FilePath
+import Types.Key
+
+import qualified Data.ByteString.Lazy as L
 
 type LinkTarget = String
 
@@ -110,3 +115,32 @@ stageSymlink :: FilePath -> Sha -> Annex ()
 stageSymlink file sha =
        Annex.Queue.addUpdateIndex =<<
                inRepo (Git.UpdateIndex.stageSymlink file sha)
+
+{- Parses a symlink target or a pointer file to a Key.
+ - Only looks at the first line, as pointer files can have subsequent
+ - lines. -}
+parseLinkOrPointer :: L.ByteString -> Maybe Key
+parseLinkOrPointer = parseLinkOrPointer' . decodeBS . L.take maxsz
+  where
+       {- Want to avoid buffering really big files in git into
+        - memory when reading files that may be pointers.
+        -
+        - 8192 bytes is plenty for a pointer to a key.
+        - Pad some more to allow for any pointer files that might have
+        - lines after the key explaining what the file is used for. -}
+       maxsz = 81920
+
+parseLinkOrPointer' :: String -> Maybe Key
+parseLinkOrPointer' s = headMaybe (lines (fromInternalGitPath s)) >>= go
+  where
+       go l
+               | isLinkToAnnex l = file2key $ takeFileName l
+               | otherwise = Nothing
+
+formatPointer :: Key -> String
+formatPointer k = toInternalGitPath $ pathSeparator:objectDir </> key2file k
+
+{- Checks if a file is a pointer to a key. -}
+isPointerFile :: FilePath -> Annex (Maybe Key)
+isPointerFile f = liftIO $ catchDefaultIO Nothing $ 
+       parseLinkOrPointer <$> L.readFile f

diff --git a/Backend.hs b/Backend.hs
index 28f83c7e01436c28fba25ff495de3b46cfa771d0..d37eed34afb7877061ec7695ddf1a94f8e02c5a0 100644 (file)
--- a/Backend.hs
+++ b/Backend.hs
@@ -11,7 +11,6 @@ module Backend (
        genKey,
        lookupFile,
        getBackend,
-       isAnnexLink,
        chooseBackend,
        lookupBackendName,
        maybeLookupBackendName,

diff --git a/Command/Smudge.hs b/Command/Smudge.hs
index e08afed6bb3a69faff7744c9ea91c527f0894251..f9f819bec5518dcaf2b9aa5e5306eec84d0087d6 100644 (file)
--- a/Command/Smudge.hs
+++ b/Command/Smudge.hs
@@ -9,16 +9,14 @@ module Command.Smudge where
 
 import Common.Annex
 import Command
-import Types.Key
 import Annex.Content
-import Annex.CatFile
+import Annex.Link
 import Annex.MetaData
 import Annex.FileMatcher
 import Types.KeySource
 import Backend
 import Logs.Location
 import qualified Database.AssociatedFiles as AssociatedFiles
-import Git.FilePath
 
 import qualified Data.ByteString.Lazy as B
 
@@ -46,16 +44,13 @@ seek o = commandAction $
 -- available annex object, should output its content.
 smudge :: FilePath -> CommandStart
 smudge file = do
-       liftIO $ fileEncoding stdin
-       s <- liftIO $ hGetContents stdin
-       case parsePointer s of
-               Nothing -> liftIO $ putStr s
+       b <- liftIO $ B.hGetContents stdin
+       case parseLinkOrPointer b of
+               Nothing -> liftIO $ B.putStr b
                Just k -> do
                        updateAssociatedFiles k file
                        content <- calcRepo (gitAnnexLocation k)
-                       liftIO $ maybe
-                               (putStr s)
-                               (B.hPut stdout)
+                       liftIO $ B.hPut stdout . fromMaybe b
                                =<< catchMaybeIO (B.readFile content)
        stop
 
@@ -102,11 +97,8 @@ ingest file = do
                =<< liftIO (getFileStatus file)
        return k
 
--- Could add a newline and some text explaining this file is a pointer.
--- parsePointer only looks at the first line.
 emitPointer :: Key -> IO ()
-emitPointer k = putStrLn $ toInternalGitPath $
-       pathSeparator:objectDir </> key2file k
+emitPointer = putStrLn . formatPointer
 
 updateAssociatedFiles :: Key -> FilePath -> Annex ()
 updateAssociatedFiles k f = do