diff options
Diffstat (limited to 'Annex.hs')
-rw-r--r-- | Annex.hs | 52 |
1 files changed, 11 insertions, 41 deletions
@@ -20,49 +20,41 @@ import LocationLog -- git-annex's runtime state data State = State { repo :: GitRepo, - config :: Config -} - -data Config = Config { - annex_name :: String, - annex_numcopies :: Int, - annex_backends :: [Backend] + backends :: [Backend] } {- An annexed file's content is stored somewhere under .git/annex/ -} -annexDir :: GitRepo -> Key -> IO FilePath -annexDir repo key = do - dir <- gitDir repo - return $ dir ++ "/annex/" ++ key +annexDir :: GitRepo -> Key -> FilePath +annexDir repo key = gitDir repo ++ "/annex/" ++ key {- On startup, examine the git repo, prepare it, and record state for - later. -} startAnnex :: IO State startAnnex = do r <- gitRepoCurrent - config <- queryConfig r gitPrep r + return State { repo = r, - config = config + backends = parseBackendList $ gitConfig r "annex.backends" "" } {- Annexes a file, storing it in a backend, and then moving it into - the annex directory and setting up the symlink pointing to its content. -} annexFile :: State -> FilePath -> IO () annexFile state file = do - alreadyannexed <- lookupBackend backends (repo state) file + alreadyannexed <- lookupBackend (backends state) (repo state) file case (alreadyannexed) of Just _ -> error $ "already annexed: " ++ file Nothing -> do checkLegal file - stored <- storeFile backends (repo state) file + stored <- storeFile (backends state) (repo state) file case (stored) of Nothing -> error $ "no backend could store: " ++ file Just key -> symlink key where symlink key = do - dest <- annexDir (repo state) key + let dest = annexDir (repo state) key createDirectoryIfMissing True (parentDir dest) renameFile file dest createSymbolicLink dest file @@ -72,40 +64,22 @@ annexFile state file = do if ((isSymbolicLink s) || (not $ isRegularFile s)) then error $ "not a regular file: " ++ file else return () - backends = getConfig state annex_backends {- Inverse of annexFile. -} unannexFile :: State -> FilePath -> IO () unannexFile state file = do - alreadyannexed <- lookupBackend backends (repo state) file + alreadyannexed <- lookupBackend (backends state) (repo state) file case (alreadyannexed) of Nothing -> error $ "not annexed " ++ file Just _ -> do - mkey <- dropFile backends (repo state) file + mkey <- dropFile (backends state) (repo state) file case (mkey) of Nothing -> return () Just key -> do - src <- annexDir (repo state) key + let src = annexDir (repo state) key removeFile file renameFile src file return () - where - backends = getConfig state annex_backends - -{- Query the git repo for relevant configuration settings. -} -queryConfig :: GitRepo -> IO Config -queryConfig repo = do - -- a name can be configured, if none is, use the repository path - name <- gitConfigGet "annex.name" (gitRepoTop repo) - -- default number of copies to keep of file contents is 1 - numcopies <- gitConfigGet "annex.numcopies" "1" - backends <- gitConfigGet "annex.backends" "" - - return Config { - annex_name = name, - annex_numcopies = read numcopies, - annex_backends = parseBackendList backends - } {- Sets up a git repo for git-annex. May be called repeatedly. -} gitPrep :: GitRepo -> IO () @@ -125,7 +99,3 @@ gitPrep repo = do appendFile attributes $ attrLine ++ "\n" gitAdd repo attributes else return () - -{- Looks up a key in a State's Config -} -getConfig :: State -> (Config -> b) -> b -getConfig state key = key $ config state |