git-annex/Locations.hs

95 lines
2.6 KiB
Haskell
Raw Normal View History

{- 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-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,
annexBadLocation,
2010-11-15 22:04:19 +00:00
annexUnusedLog,
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-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-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
stateLoc = ".git-annex/"
2010-10-14 06:36:41 +00:00
gitStateDir :: Git.Repo -> FilePath
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 =
Git.workTree r ++ "/" ++ annexLocationRelative key
2010-10-13 05:04:06 +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.
-
- 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-15 22:04:19 +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-11-15 22:04:19 +00:00
{- .git-annex/bad/ is used for bad files found during fsck -}
annexBadLocation :: Git.Repo -> FilePath
annexBadLocation r = annexDir r ++ "/bad/"
2010-11-15 22:04:19 +00:00
{- .git/annex/unused is used to number possibly unused keys -}
annexUnusedLog :: Git.Repo -> FilePath
annexUnusedLog r = annexDir r ++ "/unused"
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)
2010-11-08 21:44:30 +00:00
where k = read $ "test:" ++ s