got rid of Core module

Most of it was to do with managing annexed Content, so put there
This commit is contained in:
Joey Hess 2011-01-16 16:05:05 -04:00
parent 84836ed804
commit e7b557ef5d
24 changed files with 104 additions and 89 deletions

View file

@ -22,7 +22,7 @@ import LocationLog
import Locations import Locations
import qualified Remotes import qualified Remotes
import qualified GitRepo as Git import qualified GitRepo as Git
import Core import Content
import qualified Annex import qualified Annex
import UUID import UUID
import Messages import Messages

View file

@ -18,7 +18,7 @@ import TypeInternals
import Messages import Messages
import qualified Annex import qualified Annex
import Locations import Locations
import Core import Content
backend :: Backend backend :: Backend
backend = Backend.File.backend { backend = Backend.File.backend {

View file

@ -18,7 +18,7 @@ import qualified Backend.File
import TypeInternals import TypeInternals
import Locations import Locations
import qualified Annex import qualified Annex
import Core import Content
import Messages import Messages
backend :: Backend backend :: Backend

View file

@ -1,4 +1,4 @@
{- git-annex command line parsing {- git-annex command line parsing and dispatch
- -
- Copyright 2010 Joey Hess <joey@kitenet.net> - Copyright 2010 Joey Hess <joey@kitenet.net>
- -
@ -7,22 +7,27 @@
module CmdLine ( module CmdLine (
dispatch, dispatch,
parseCmd,
usage, usage,
shutdown
) where ) where
import System.IO.Error (try)
import System.Console.GetOpt import System.Console.GetOpt
import Control.Monad (when)
import Control.Monad.State (liftIO) import Control.Monad.State (liftIO)
import Control.Monad (when, unless)
import System.Directory
import qualified Annex import qualified Annex
import qualified GitRepo as Git import qualified GitRepo as Git
import qualified GitQueue
import Types import Types
import Command import Command
import BackendList import BackendList
import Core
import Upgrade import Upgrade
import Options import Options
import Messages
import UUID
import Locations
{- Runs the passed command line. -} {- Runs the passed command line. -}
dispatch :: Git.Repo -> [String] -> [Command] -> [Option] -> String -> IO () dispatch :: Git.Repo -> [String] -> [Command] -> [Option] -> String -> IO ()
@ -68,3 +73,46 @@ usage header cmds options =
indent l = " " ++ l indent l = " " ++ l
pad n s = replicate (n - length s) ' ' pad n s = replicate (n - length s) ' '
longest f = foldl max 0 $ map (length . f) cmds longest f = foldl max 0 $ map (length . f) cmds
{- Runs a list of Annex actions. Catches IO errors and continues
- (but explicitly thrown errors terminate the whole command).
- Runs shutdown and propigates an overall error status at the end.
-}
tryRun :: AnnexState -> [Annex Bool] -> IO ()
tryRun state actions = tryRun' state 0 actions
tryRun' :: AnnexState -> Integer -> [Annex Bool] -> IO ()
tryRun' state errnum (a:as) = do
result <- try $ Annex.run state a
case result of
Left err -> do
Annex.eval state $ showErr err
tryRun' state (errnum + 1) as
Right (True,state') -> tryRun' state' errnum as
Right (False,state') -> tryRun' state' (errnum + 1) as
tryRun' state errnum [] = do
_ <- try $ Annex.run state $ shutdown errnum
when (errnum > 0) $ error $ show errnum ++ " failed"
{- Actions to perform each time ran. -}
startup :: Annex Bool
startup = do
prepUUID
return True
{- Cleanup actions. -}
shutdown :: Integer -> Annex ()
shutdown errnum = do
q <- Annex.queueGet
unless (q == GitQueue.empty) $ do
showSideAction "Recording state in git..."
Annex.queueRun
-- If nothing failed, clean up any files left in the temp directory,
-- but leave the directory itself. If something failed, temp files
-- are left behind to allow resuming on re-run.
when (errnum == 0) $ do
g <- Annex.gitRepo
let tmp = annexTmpLocation g
exists <- liftIO $ doesDirectoryExist tmp
when exists $ liftIO $ removeDirectoryRecursive tmp
liftIO $ createDirectoryIfMissing True tmp

View file

@ -15,7 +15,7 @@ import qualified Annex
import qualified Backend import qualified Backend
import LocationLog import LocationLog
import Types import Types
import Core import Content
import Messages import Messages
command :: [Command] command :: [Command]

View file

@ -13,7 +13,7 @@ import Command
import qualified Backend import qualified Backend
import LocationLog import LocationLog
import Types import Types
import Core import Content
import Messages import Messages
import Utility import Utility

View file

@ -12,7 +12,7 @@ import qualified Annex
import qualified Backend import qualified Backend
import LocationLog import LocationLog
import Types import Types
import Core import Content
import Messages import Messages
command :: [Command] command :: [Command]

View file

@ -11,7 +11,7 @@ import Control.Monad (when)
import Control.Monad.State (liftIO) import Control.Monad.State (liftIO)
import Command import Command
import Core import Content
command :: [Command] command :: [Command]
command = [Command "find" (paramOptional $ paramRepeating paramPath) seek command = [Command "find" (paramOptional $ paramRepeating paramPath) seek

View file

@ -14,7 +14,7 @@ import System.Directory
import Command import Command
import qualified Annex import qualified Annex
import Utility import Utility
import Core import Content
import Messages import Messages
command :: [Command] command :: [Command]

View file

@ -17,7 +17,7 @@ import qualified Annex
import Utility import Utility
import qualified Backend import qualified Backend
import Types import Types
import Core import Content
import Messages import Messages
command :: [Command] command :: [Command]

View file

@ -10,7 +10,7 @@ module Command.Get where
import Command import Command
import qualified Backend import qualified Backend
import Types import Types
import Core import Content
import Messages import Messages
command :: [Command] command :: [Command]

View file

@ -12,7 +12,7 @@ import System.Exit
import Command import Command
import Types import Types
import Core import Content
import qualified Backend import qualified Backend
command :: [Command] command :: [Command]

View file

@ -16,7 +16,7 @@ import qualified Annex
import qualified Backend import qualified Backend
import Locations import Locations
import Types import Types
import Core import Content
import Messages import Messages
import qualified Command.Add import qualified Command.Add

View file

@ -14,7 +14,7 @@ import qualified Command.Drop
import qualified Annex import qualified Annex
import LocationLog import LocationLog
import Types import Types
import Core import Content
import qualified GitRepo as Git import qualified GitRepo as Git
import qualified Remotes import qualified Remotes
import UUID import UUID

View file

@ -13,7 +13,8 @@ import System.Exit
import Command import Command
import Types import Types
import Core import CmdLine
import Content
import qualified Backend import qualified Backend
import RsyncFile import RsyncFile

View file

@ -15,7 +15,7 @@ import Locations
import qualified Annex import qualified Annex
import Command import Command
import Types import Types
import Core import Content
import qualified Backend import qualified Backend
import RsyncFile import RsyncFile

View file

@ -16,7 +16,7 @@ import Utility
import qualified Backend import qualified Backend
import LocationLog import LocationLog
import Types import Types
import Core import Content
import Messages import Messages
command :: [Command] command :: [Command]

View file

@ -16,7 +16,7 @@ import Utility
import qualified Backend import qualified Backend
import LocationLog import LocationLog
import Types import Types
import Core import Content
import qualified GitRepo as Git import qualified GitRepo as Git
import Messages import Messages

View file

@ -17,7 +17,7 @@ import qualified Backend
import Types import Types
import Messages import Messages
import Locations import Locations
import Core import Content
import CopyFile import CopyFile
command :: [Command] command :: [Command]

View file

@ -9,13 +9,16 @@ module Command.Unused where
import Control.Monad.State (liftIO) import Control.Monad.State (liftIO)
import qualified Data.Map as M import qualified Data.Map as M
import Data.Maybe
import Command import Command
import Types import Types
import Core import Content
import Messages import Messages
import Locations import Locations
import qualified Annex import qualified Annex
import qualified GitRepo as Git
import qualified Backend
command :: [Command] command :: [Command]
command = [Command "unused" paramNothing seek "look for unused file content"] command = [Command "unused" paramNothing seek "look for unused file content"]
@ -80,3 +83,11 @@ unusedKeys = do
existsMap :: Ord k => [k] -> M.Map k Int existsMap :: Ord k => [k] -> M.Map k Int
existsMap l = M.fromList $ map (\k -> (k, 1)) l existsMap l = M.fromList $ map (\k -> (k, 1)) l
{- List of keys referenced by symlinks in the git repo. -}
getKeysReferenced :: Annex [Key]
getKeysReferenced = do
g <- Annex.gitRepo
files <- liftIO $ Git.inRepo g [Git.workTree g]
keypairs <- mapM Backend.lookupFile files
return $ map fst $ catMaybes keypairs

View file

@ -1,19 +1,30 @@
{- git-annex core functions {- git-annex file content managing
- -
- Copyright 2010 Joey Hess <joey@kitenet.net> - Copyright 2010 Joey Hess <joey@kitenet.net>
- -
- Licensed under the GNU GPL version 3 or higher. - Licensed under the GNU GPL version 3 or higher.
-} -}
module Core where module Content (
inAnnex,
calcGitLink,
logStatus,
getViaTmp,
preventWrite,
allowWrite,
moveAnnex,
removeAnnex,
fromAnnex,
moveBad,
getKeysPresent
) where
import System.IO.Error (try) import System.IO.Error (try)
import System.Directory import System.Directory
import Control.Monad.State (liftIO) import Control.Monad.State (liftIO)
import System.Path import System.Path
import Control.Monad (when, unless, filterM) import Control.Monad (when, filterM)
import System.Posix.Files import System.Posix.Files
import Data.Maybe
import System.FilePath import System.FilePath
import Types import Types
@ -21,56 +32,8 @@ import Locations
import LocationLog import LocationLog
import UUID import UUID
import qualified GitRepo as Git import qualified GitRepo as Git
import qualified GitQueue
import qualified Annex import qualified Annex
import qualified Backend
import Utility import Utility
import Messages
{- Runs a list of Annex actions. Catches IO errors and continues
- (but explicitly thrown errors terminate the whole command).
- Runs shutdown and propigates an overall error status at the end.
-}
tryRun :: AnnexState -> [Annex Bool] -> IO ()
tryRun state actions = tryRun' state 0 actions
tryRun' :: AnnexState -> Integer -> [Annex Bool] -> IO ()
tryRun' state errnum (a:as) = do
result <- try $ Annex.run state a
case result of
Left err -> do
Annex.eval state $ showErr err
tryRun' state (errnum + 1) as
Right (True,state') -> tryRun' state' errnum as
Right (False,state') -> tryRun' state' (errnum + 1) as
tryRun' state errnum [] = do
_ <- try $ Annex.run state $ shutdown errnum
when (errnum > 0) $ error $ show errnum ++ " failed"
{- Actions to perform each time ran. -}
startup :: Annex Bool
startup = do
prepUUID
return True
{- When git-annex is done, it runs this. -}
shutdown :: Integer -> Annex Bool
shutdown errnum = do
q <- Annex.queueGet
unless (q == GitQueue.empty) $ do
showSideAction "Recording state in git..."
Annex.queueRun
-- If nothing failed, clean up any files left in the temp directory,
-- but leave the directory itself. If something failed, temp files
-- are left behind to allow resuming on re-run.
when (errnum == 0) $ do
g <- Annex.gitRepo
let tmp = annexTmpLocation g
exists <- liftIO $ doesDirectoryExist tmp
when exists $ liftIO $ removeDirectoryRecursive tmp
liftIO $ createDirectoryIfMissing True tmp
return True
{- Checks if a given key is currently present in the annexLocation. -} {- Checks if a given key is currently present in the annexLocation. -}
inAnnex :: Key -> Annex Bool inAnnex :: Key -> Annex Bool
@ -200,11 +163,3 @@ getKeysPresent' dir = do
case result of case result of
Right s -> return $ isRegularFile s Right s -> return $ isRegularFile s
Left _ -> return False Left _ -> return False
{- List of keys referenced by symlinks in the git repo. -}
getKeysReferenced :: Annex [Key]
getKeysReferenced = do
g <- Annex.gitRepo
files <- liftIO $ Git.inRepo g [Git.workTree g]
keypairs <- mapM Backend.lookupFile files
return $ map fst $ catMaybes keypairs

View file

@ -34,7 +34,7 @@ import LocationLog
import Locations import Locations
import UUID import UUID
import Utility import Utility
import qualified Core import qualified Content
import Messages import Messages
import CopyFile import CopyFile
import RsyncFile import RsyncFile
@ -159,7 +159,7 @@ inAnnex r key = if Git.repoIsUrl r
-- run a local check inexpensively, -- run a local check inexpensively,
-- by making an Annex monad using the remote -- by making an Annex monad using the remote
a <- Annex.new r [] a <- Annex.new r []
Annex.eval a (Core.inAnnex key) Annex.eval a (Content.inAnnex key)
checkremote = do checkremote = do
showNote ("checking " ++ Git.repoDescribe r ++ "...") showNote ("checking " ++ Git.repoDescribe r ++ "...")
inannex <- onRemote r (boolSystem, False) "inannex" inannex <- onRemote r (boolSystem, False) "inannex"
@ -253,7 +253,7 @@ copyToRemote r key
liftIO $ do liftIO $ do
a <- Annex.new r [] a <- Annex.new r []
Annex.eval a $ do Annex.eval a $ do
ok <- Core.getViaTmp key $ ok <- Content.getViaTmp key $
\f -> liftIO $ copyFile keysrc f \f -> liftIO $ copyFile keysrc f
Annex.queueRun Annex.queueRun
return ok return ok

View file

@ -14,7 +14,7 @@ import Control.Monad (filterM)
import System.Posix.Files import System.Posix.Files
import System.FilePath import System.FilePath
import Core import Content
import Types import Types
import Locations import Locations
import qualified GitRepo as Git import qualified GitRepo as Git

View file

@ -32,7 +32,7 @@ import qualified GitAnnex
import qualified LocationLog import qualified LocationLog
import qualified UUID import qualified UUID
import qualified Remotes import qualified Remotes
import qualified Core import qualified Content
import qualified Backend.SHA1 import qualified Backend.SHA1
import qualified Backend.WORM import qualified Backend.WORM
import qualified Command.DropUnused import qualified Command.DropUnused
@ -318,7 +318,7 @@ test_fsck = "git-annex fsck" ~: intmpclonerepo $ do
where where
corrupt f = do corrupt f = do
git_annex "get" ["-q", f] @? "get of file failed" git_annex "get" ["-q", f] @? "get of file failed"
Core.allowWrite f Content.allowWrite f
writeFile f (changedcontent f) writeFile f (changedcontent f)
r <- git_annex "fsck" ["-q"] r <- git_annex "fsck" ["-q"]
not r @? "fsck failed to fail with corrupted file content" not r @? "fsck failed to fail with corrupted file content"