summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorGravatar Joey Hess <joey@kitenet.net>2010-10-14 03:40:26 -0400
committerGravatar Joey Hess <joey@kitenet.net>2010-10-14 03:40:26 -0400
commitf407f23a54d9152a382ee8e48629f40e1a72a26f (patch)
tree088162654cba0cc1251d71140c51b8dc6ed165bb
parent6f3572e47f57bbe5cc76b58c8bcdc9c6c455dce0 (diff)
more refactor
-rw-r--r--Commands.hs58
-rw-r--r--Core.hs87
-rw-r--r--git-annex.hs41
3 files changed, 98 insertions, 88 deletions
diff --git a/Commands.hs b/Commands.hs
index 98e65b126..be61c7c64 100644
--- a/Commands.hs
+++ b/Commands.hs
@@ -1,7 +1,6 @@
{- git-annex subcommands -}
module Commands (
- start,
annexCmd,
unannexCmd,
getCmd,
@@ -26,32 +25,6 @@ import UUID
import LocationLog
import Types
-{- Create and returns an Annex state object.
- - Examines and prepares the git repo.
- -}
-start :: IO AnnexState
-start = do
- g <- Git.repoFromCwd
- let s = Annex.new g
- (_,s') <- Annex.run s (prep g)
- return s'
- where
- prep g = do
- -- setup git and read its config; update state
- g' <- liftIO $ Git.configRead g
- Annex.gitRepoChange g'
- liftIO $ gitSetup g'
- Annex.backendsChange $ parseBackendList $
- Git.configGet g' "annex.backends" ""
- prepUUID
-
-inBackend file yes no = do
- r <- liftIO $ Backend.lookupFile file
- case (r) of
- Just v -> yes v
- Nothing -> no
-notinBackend file yes no = inBackend file no yes
-
{- 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. -}
annexCmd :: FilePath -> Annex ()
@@ -146,30 +119,6 @@ pushCmd reponame = do error "not implemented" -- TODO
pullCmd :: String -> Annex ()
pullCmd reponame = do error "not implemented" -- TODO
-{- Sets up a git repo for git-annex. May be called repeatedly. -}
-gitSetup :: Git.Repo -> IO ()
-gitSetup repo = do
- -- configure git to use union merge driver on state files
- exists <- doesFileExist attributes
- if (not exists)
- then do
- writeFile attributes $ attrLine ++ "\n"
- commit
- else do
- content <- readFile attributes
- if (all (/= attrLine) (lines content))
- then do
- appendFile attributes $ attrLine ++ "\n"
- commit
- else return ()
- where
- attrLine = stateLoc ++ "/*.log merge=union"
- attributes = Git.attributes repo
- commit = do
- Git.run repo ["add", attributes]
- Git.run repo ["commit", "-m", "git-annex setup",
- attributes]
-
{- Updates the LocationLog when a key's presence changes. -}
logStatus :: Key -> LogStatus -> Annex ()
logStatus key status = do
@@ -182,6 +131,13 @@ logStatus key status = do
Git.run g ["add", f]
Git.run g ["commit", "-m", "git-annex log update", f]
+inBackend file yes no = do
+ r <- liftIO $ Backend.lookupFile file
+ case (r) of
+ Just v -> yes v
+ Nothing -> no
+notinBackend file yes no = inBackend file no yes
+
{- Checks if a given key is currently present in the annexLocation -}
inAnnex :: Backend -> Key -> Annex Bool
inAnnex backend key = do
diff --git a/Core.hs b/Core.hs
new file mode 100644
index 000000000..e3d2c6403
--- /dev/null
+++ b/Core.hs
@@ -0,0 +1,87 @@
+{- git-annex core functions -}
+
+module Core where
+
+import System.IO
+import System.Directory
+import Control.Monad.State (liftIO)
+import Control.Exception
+import CmdLine
+import Types
+import BackendList
+import Locations
+import UUID
+import qualified GitRepo as Git
+import qualified Annex
+
+{- Create and returns an Annex state object.
+ - Examines and prepares the git repo.
+ -}
+start :: IO AnnexState
+start = do
+ g <- Git.repoFromCwd
+ let s = Annex.new g
+ (_,s') <- Annex.run s (prep g)
+ return s'
+ where
+ prep g = do
+ -- setup git and read its config; update state
+ g' <- liftIO $ Git.configRead g
+ Annex.gitRepoChange g'
+ liftIO $ gitSetup g'
+ Annex.backendsChange $ parseBackendList $
+ Git.configGet g' "annex.backends" ""
+ prepUUID
+
+{- Processes each param in the list by dispatching the handler function
+ - for the user-selection operation mode. Catches exceptions, not stopping
+ - if some error out, and propigates an overall error status at the end.
+ -
+ - This runs in the IO monad, not in the Annex monad. It seems that
+ - exceptions can only be caught in the IO monad, not in a stacked monad;
+ - or more likely I missed an easy way to do it. So, I have to laboriously
+ - thread AnnexState through this function.
+ -}
+tryRun :: AnnexState -> Mode -> [String] -> IO ()
+tryRun state mode params = tryRun' state mode 0 0 params
+tryRun' state mode errnum oknum [] = do
+ if (errnum > 0)
+ then error $ (show errnum) ++ " failed ; " ++ show (oknum) ++ " ok"
+ else return ()
+tryRun' state mode errnum oknum (f:fs) = do
+ result <- try
+ (Annex.run state (dispatch mode f))::IO (Either SomeException ((), AnnexState))
+ case (result) of
+ Left err -> do
+ showErr err
+ tryRun' state mode (errnum + 1) oknum fs
+ Right (_,state') -> tryRun' state' mode errnum (oknum + 1) fs
+
+{- Exception pretty-printing. -}
+showErr e = do
+ hPutStrLn stderr $ "git-annex: " ++ (show e)
+ return ()
+
+{- Sets up a git repo for git-annex. May be called repeatedly. -}
+gitSetup :: Git.Repo -> IO ()
+gitSetup repo = do
+ -- configure git to use union merge driver on state files
+ exists <- doesFileExist attributes
+ if (not exists)
+ then do
+ writeFile attributes $ attrLine ++ "\n"
+ commit
+ else do
+ content <- readFile attributes
+ if (all (/= attrLine) (lines content))
+ then do
+ appendFile attributes $ attrLine ++ "\n"
+ commit
+ else return ()
+ where
+ attrLine = stateLoc ++ "/*.log merge=union"
+ attributes = Git.attributes repo
+ commit = do
+ Git.run repo ["add", attributes]
+ Git.run repo ["commit", "-m", "git-annex setup",
+ attributes]
diff --git a/git-annex.hs b/git-annex.hs
index ce3b2ac42..b326b2b19 100644
--- a/git-annex.hs
+++ b/git-annex.hs
@@ -1,45 +1,12 @@
-{- git-annex main program
- - -}
+{- git-annex main program -}
-import Control.Monad.State
-import System.IO
import System.Environment
-import Control.Exception
-import CmdLine
-import Types
-import Commands
import qualified Annex
+import Core
+import CmdLine
main = do
args <- getArgs
(mode, params) <- argvToMode args
state <- start
- tryRun state mode 0 0 params
-
-{- Processes each param in the list by dispatching the handler function
- - for the user-selection operation mode. Catches exceptions, not stopping
- - if some error out, and propigates an overall error status at the end.
- -
- - This runs in the IO monad, not in the Annex monad. It seems that
- - exceptions can only be caught in the IO monad, not in a stacked monad;
- - or more likely I missed an easy way to do it. So, I have to laboriously
- - thread AnnexState through this function.
- -}
-tryRun :: AnnexState -> Mode -> Int -> Int -> [String] -> IO ()
-tryRun state mode errnum oknum [] = do
- if (errnum > 0)
- then error $ (show errnum) ++ " failed ; " ++ show (oknum) ++ " ok"
- else return ()
-tryRun state mode errnum oknum (f:fs) = do
- result <- try
- (Annex.run state (dispatch mode f))::IO (Either SomeException ((), AnnexState))
- case (result) of
- Left err -> do
- showErr err
- tryRun state mode (errnum + 1) oknum fs
- Right (_,state') -> tryRun state' mode errnum (oknum + 1) fs
-
-{- Exception pretty-printing. -}
-showErr e = do
- hPutStrLn stderr $ "git-annex: " ++ (show e)
- return ()
+ tryRun state mode params