bug
This commit is contained in:
parent
d4ce072452
commit
aa2f4bd810
5 changed files with 46 additions and 46 deletions
15
Annex.hs
15
Annex.hs
|
@ -14,9 +14,18 @@ import qualified GitRepo as Git
|
|||
import Types
|
||||
import qualified BackendTypes as Backend
|
||||
|
||||
-- constructor
|
||||
new :: Git.Repo -> AnnexState
|
||||
new g = Backend.AnnexState { Backend.repo = g, Backend.backends = [] }
|
||||
{- Create and returns an Annex state object for the specified git repo.
|
||||
-}
|
||||
new :: Git.Repo -> IO AnnexState
|
||||
new g = do
|
||||
let s = Backend.AnnexState { Backend.repo = g, Backend.backends = [] }
|
||||
(_,s') <- Annex.run s (prep g)
|
||||
return s'
|
||||
where
|
||||
prep g = do
|
||||
-- read git config and update state
|
||||
g' <- liftIO $ Git.configRead g
|
||||
Annex.gitRepoChange g'
|
||||
|
||||
-- performs an action in the Annex monad
|
||||
run state action = runStateT (action) state
|
||||
|
|
|
@ -52,7 +52,7 @@ storeFileKey :: FilePath -> Annex (Maybe (Key, Backend))
|
|||
storeFileKey file = do
|
||||
g <- Annex.gitRepo
|
||||
let relfile = Git.relative g file
|
||||
b <- Annex.backends
|
||||
b <- backendList
|
||||
storeFileKey' b file relfile
|
||||
storeFileKey' [] _ _ = return Nothing
|
||||
storeFileKey' (b:bs) file relfile = do
|
||||
|
|
|
@ -14,6 +14,7 @@ import Locations
|
|||
import qualified Remotes
|
||||
import qualified GitRepo as Git
|
||||
import Utility
|
||||
import Core
|
||||
|
||||
backend = Backend {
|
||||
name = "file",
|
||||
|
|
67
Core.hs
67
Core.hs
|
@ -6,52 +6,39 @@ import System.IO
|
|||
import System.Directory
|
||||
import Control.Monad.State (liftIO)
|
||||
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'
|
||||
prepUUID
|
||||
|
||||
|
||||
{- 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 ()
|
||||
gitSetup :: Annex ()
|
||||
gitSetup = do
|
||||
g <- Annex.gitRepo
|
||||
liftIO $ setupattributes g
|
||||
prepUUID
|
||||
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]
|
||||
-- configure git to use union merge driver on state files
|
||||
setupattributes repo = do
|
||||
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]
|
||||
|
||||
{- Checks if a given key is currently present in the annexLocation -}
|
||||
inAnnex :: Backend -> Key -> Annex Bool
|
||||
|
|
|
@ -7,12 +7,15 @@ import qualified Annex
|
|||
import Types
|
||||
import Core
|
||||
import Commands
|
||||
import Annex
|
||||
import qualified GitRepo as Git
|
||||
|
||||
main = do
|
||||
args <- getArgs
|
||||
actions <- argvToActions args
|
||||
state <- start
|
||||
tryRun state actions
|
||||
gitrepo <- Git.repoFromCwd
|
||||
state <- new gitrepo
|
||||
tryRun state (gitSetup:actions)
|
||||
|
||||
{- Runs a list of Annex actions. Catches exceptions, not stopping
|
||||
- if some error out, and propigates an overall error status at the end.
|
||||
|
|
Loading…
Reference in a new issue