2010-10-10 19:54:02 +00:00
|
|
|
{- git-annex file locations
|
2010-10-27 20:53:54 +00:00
|
|
|
-
|
|
|
|
- Copyright 2010 Joey Hess <joey@kitenet.net>
|
|
|
|
-
|
|
|
|
- Licensed under the GNU GPL version 3 or higher.
|
2010-10-10 19:54:02 +00:00
|
|
|
-}
|
|
|
|
|
2010-10-11 21:52:46 +00:00
|
|
|
module Locations (
|
|
|
|
gitStateDir,
|
2010-10-13 00:04:36 +00:00
|
|
|
stateLoc,
|
|
|
|
keyFile,
|
2010-10-13 07:41:12 +00:00
|
|
|
fileKey,
|
2010-10-13 04:58:59 +00:00
|
|
|
annexLocation,
|
2010-10-17 20:39:30 +00:00
|
|
|
annexLocationRelative,
|
2010-11-07 21:36:24 +00:00
|
|
|
annexTmpLocation,
|
2010-11-08 19:14:54 +00:00
|
|
|
annexDir,
|
2010-11-08 20:47:36 +00:00
|
|
|
annexObjectDir,
|
|
|
|
|
|
|
|
prop_idempotent_fileKey
|
2010-10-11 21:52:46 +00:00
|
|
|
) where
|
2010-10-10 19:54:02 +00:00
|
|
|
|
2010-10-13 00:04:36 +00:00
|
|
|
import Data.String.Utils
|
2010-10-16 20:20:49 +00:00
|
|
|
|
2010-10-14 07:18:11 +00:00
|
|
|
import Types
|
2010-10-14 06:36:41 +00:00
|
|
|
import qualified GitRepo as Git
|
2010-10-10 19:54:02 +00:00
|
|
|
|
2010-10-11 04:23:49 +00:00
|
|
|
{- Long-term, cross-repo state is stored in files inside the .git-annex
|
2010-10-12 04:53:42 +00:00
|
|
|
- directory, in the git repository's working tree. -}
|
2010-10-31 20:00:32 +00:00
|
|
|
stateLoc :: String
|
2010-10-17 02:36:35 +00:00
|
|
|
stateLoc = ".git-annex/"
|
2010-10-14 06:36:41 +00:00
|
|
|
gitStateDir :: Git.Repo -> FilePath
|
2010-10-17 02:36:35 +00:00
|
|
|
gitStateDir repo = (Git.workTree repo) ++ "/" ++ stateLoc
|
2010-10-13 00:04:36 +00:00
|
|
|
|
2010-11-08 20:47:36 +00:00
|
|
|
{- Annexed file's absolute location. -}
|
2010-10-14 23:36:11 +00:00
|
|
|
annexLocation :: Git.Repo -> Key -> FilePath
|
|
|
|
annexLocation r key =
|
2010-10-31 20:00:32 +00:00
|
|
|
(Git.workTree r) ++ "/" ++ (annexLocationRelative key)
|
2010-10-13 05:04:06 +00:00
|
|
|
|
2010-10-25 21:31:07 +00:00
|
|
|
{- Annexed file's location relative to git's working tree.
|
|
|
|
-
|
|
|
|
- Note: Assumes repo is NOT bare.-}
|
2010-10-31 20:00:32 +00:00
|
|
|
annexLocationRelative :: Key -> FilePath
|
2010-11-08 20:47:36 +00:00
|
|
|
annexLocationRelative key = ".git/annex/objects/" ++ f ++ "/" ++ f
|
|
|
|
where
|
|
|
|
f = keyFile key
|
2010-10-13 07:41:12 +00:00
|
|
|
|
2010-11-07 21:36:24 +00:00
|
|
|
{- The annex directory of a repository.
|
2010-10-25 21:31:07 +00:00
|
|
|
-
|
|
|
|
- Note: Assumes repo is NOT bare. -}
|
2010-11-07 21:36:24 +00:00
|
|
|
annexDir :: Git.Repo -> FilePath
|
|
|
|
annexDir r = Git.workTree r ++ "/.git/annex"
|
|
|
|
|
2010-11-08 19:14:54 +00:00
|
|
|
{- The part of the annex directory where file contents are stored.
|
|
|
|
-}
|
|
|
|
annexObjectDir :: Git.Repo -> FilePath
|
|
|
|
annexObjectDir r = annexDir r ++ "/objects"
|
|
|
|
|
2010-11-07 21:36:24 +00:00
|
|
|
{- .git-annex/tmp is used for temp files -}
|
2010-10-17 20:39:30 +00:00
|
|
|
annexTmpLocation :: Git.Repo -> FilePath
|
2010-11-07 21:36:24 +00:00
|
|
|
annexTmpLocation r = annexDir r ++ "/tmp/"
|
2010-10-17 20:39:30 +00:00
|
|
|
|
2010-10-13 07:41:12 +00:00
|
|
|
{- Converts a key into a filename fragment.
|
|
|
|
-
|
|
|
|
- Escape "/" in the key name, to keep a flat tree of files and avoid
|
|
|
|
- issues with keys containing "/../" or ending with "/" etc.
|
|
|
|
-
|
|
|
|
- "/" is escaped to "%" because it's short and rarely used, and resembles
|
|
|
|
- a slash
|
|
|
|
- "%" is escaped to "&s", and "&" to "&a"; this ensures that the mapping
|
|
|
|
- is one to one.
|
|
|
|
- -}
|
|
|
|
keyFile :: Key -> FilePath
|
2010-11-08 20:47:36 +00:00
|
|
|
keyFile key = replace "/" "%" $ replace "%" "&s" $ replace "&" "&a" $ show key
|
2010-10-13 07:41:12 +00:00
|
|
|
|
2010-10-14 03:31:08 +00:00
|
|
|
{- Reverses keyFile, converting a filename fragment (ie, the basename of
|
|
|
|
- the symlink target) into a key. -}
|
2010-10-13 07:41:12 +00:00
|
|
|
fileKey :: FilePath -> Key
|
2010-10-14 23:36:11 +00:00
|
|
|
fileKey file = read $
|
2010-10-14 06:52:17 +00:00
|
|
|
replace "&a" "&" $ replace "&s" "%" $ replace "%" "/" file
|
2010-11-08 20:47:36 +00:00
|
|
|
|
|
|
|
{- for quickcheck -}
|
|
|
|
prop_idempotent_fileKey :: String -> Bool
|
|
|
|
prop_idempotent_fileKey s = k == (fileKey $ keyFile k)
|
|
|
|
where k = read "test:s"
|