summaryrefslogtreecommitdiff
path: root/Annex.hs
blob: 6e5198e8ef6926ab661a56f955a65a3251d463a4 (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
{- git-annex monad
 -
 - Copyright 2010 Joey Hess <joey@kitenet.net>
 -
 - Licensed under the GNU GPL version 3 or higher.
 -}

module Annex (
	new,
	run,
	eval,
	gitRepo,
	gitRepoChange,
	backends,
	backendsChange,
	supportedBackends,
	flagIsSet,
	flagChange,
	flagGet,
	Flag(..),
	queue,
	queueGet,
	queueRun,
	setConfig
) where

import Control.Monad.State
import qualified Data.Map as M

import qualified GitRepo as Git
import qualified GitQueue
import Types
import qualified TypeInternals as Internals

{- Create and returns an Annex state object for the specified git repo. -}
new :: Git.Repo -> [Backend] -> IO AnnexState
new gitrepo allbackends = do
	let s = Internals.AnnexState {
		Internals.repo = gitrepo,
		Internals.backends = [],
		Internals.supportedBackends = allbackends,
		Internals.flags = M.empty,
		Internals.repoqueue = GitQueue.empty
	}
	(_,s') <- Annex.run s prep
	return s'
	where
		prep = do
			-- read git config and update state
			gitrepo' <- liftIO $ Git.configRead gitrepo Nothing
			Annex.gitRepoChange gitrepo'

{- performs an action in the Annex monad -}
run :: AnnexState -> StateT AnnexState IO a -> IO (a, AnnexState)
run state action = runStateT action state
eval :: AnnexState -> StateT AnnexState IO a -> IO a
eval state action = evalStateT action state

{- Returns the git repository being acted on -}
gitRepo :: Annex Git.Repo
gitRepo = do
	state <- get
	return (Internals.repo state)

{- Changes the git repository being acted on. -}
gitRepoChange :: Git.Repo -> Annex ()
gitRepoChange r = do
	state <- get
	put state { Internals.repo = r }

{- Returns the backends being used. -}
backends :: Annex [Backend]
backends = do
	state <- get
	return (Internals.backends state)

{- Sets the backends to use. -}
backendsChange :: [Backend] -> Annex ()
backendsChange b = do
	state <- get
	put state { Internals.backends = b }

{- Returns the full list of supported backends. -}
supportedBackends :: Annex [Backend]
supportedBackends = do
	state <- get
	return (Internals.supportedBackends state)

{- Return True if a Bool flag is set. -}
flagIsSet :: FlagName -> Annex Bool
flagIsSet name = do
	state <- get
	case (M.lookup name $ Internals.flags state) of
		Just (FlagBool True) -> return True
		_ -> return False 

{- Sets the value of a flag. -}
flagChange :: FlagName -> Flag -> Annex ()
flagChange name val = do
	state <- get
	put state { Internals.flags = M.insert name val $ Internals.flags state }

{- Gets the value of a String flag (or "" if there is no such String flag) -}
flagGet :: FlagName -> Annex String
flagGet name = do
	state <- get
	case (M.lookup name $ Internals.flags state) of
		Just (FlagString s) -> return s
		_ -> return ""

{- Adds a git command to the queue. -}
queue :: String -> [String] -> FilePath -> Annex ()
queue command params file = do
	state <- get
	let q = Internals.repoqueue state
	put state { Internals.repoqueue = GitQueue.add q command params file }

{- Returns the queue. -}
queueGet :: Annex GitQueue.Queue
queueGet = do
	state <- get
	return (Internals.repoqueue state)

{- Runs (and empties) the queue. -}
queueRun :: Annex ()
queueRun = do
	state <- get
	let q = Internals.repoqueue state
	g <- gitRepo
	liftIO $ GitQueue.run g q
	put state { Internals.repoqueue = GitQueue.empty }

{- Changes a git config setting in both internal state and .git/config -}
setConfig :: String -> String -> Annex ()
setConfig key value = do
	g <- Annex.gitRepo
	liftIO $ Git.run g ["config", key, value]
	-- re-read git config and update the repo's state
	g' <- liftIO $ Git.configRead g Nothing
	Annex.gitRepoChange g'