2f4d4d1c45
This includes a generic JSONStream library built on top of Text.JSON (somewhat hackishly). It would be possible to stream out a single json document describing all actions, but it's probably better for consumers if they can expect one json document per line, so I did it that way instead. Output from external programs used for transferring files is not currently hidden when outputting json, which probably makes it not very useful there. This may be dealt with if there is demand for json output for --get or --move to be parsable. The version, status, and find subcommands have hand-crafted output and don't do json. The whereis subcommand needs to be modified to produce useful json.
114 lines
2.5 KiB
Haskell
114 lines
2.5 KiB
Haskell
{- git-annex monad
|
||
-
|
||
- Copyright 2010 Joey Hess <joey@kitenet.net>
|
||
-
|
||
- Licensed under the GNU GPL version 3 or higher.
|
||
-}
|
||
|
||
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
|
||
|
||
module Annex (
|
||
Annex,
|
||
AnnexState(..),
|
||
OutputType(..),
|
||
new,
|
||
run,
|
||
eval,
|
||
getState,
|
||
changeState,
|
||
gitRepo
|
||
) where
|
||
|
||
import Control.Monad.State
|
||
import Control.Monad.IO.Control
|
||
import Control.Applicative hiding (empty)
|
||
|
||
import qualified Git
|
||
import Git.Queue
|
||
import Types.Backend
|
||
import Types.Remote
|
||
import Types.Crypto
|
||
import Types.BranchState
|
||
import Types.TrustLevel
|
||
import Types.UUID
|
||
|
||
-- git-annex's monad
|
||
newtype Annex a = Annex { runAnnex :: StateT AnnexState IO a }
|
||
deriving (
|
||
Monad,
|
||
MonadIO,
|
||
MonadControlIO,
|
||
MonadState AnnexState,
|
||
Functor,
|
||
Applicative
|
||
)
|
||
|
||
-- internal state storage
|
||
data AnnexState = AnnexState
|
||
{ repo :: Git.Repo
|
||
, backends :: [Backend Annex]
|
||
, remotes :: [Remote Annex]
|
||
, repoqueue :: Queue
|
||
, output :: OutputType
|
||
, force :: Bool
|
||
, fast :: Bool
|
||
, branchstate :: BranchState
|
||
, forcebackend :: Maybe String
|
||
, forcenumcopies :: Maybe Int
|
||
, defaultkey :: Maybe String
|
||
, toremote :: Maybe String
|
||
, fromremote :: Maybe String
|
||
, exclude :: [String]
|
||
, forcetrust :: [(UUID, TrustLevel)]
|
||
, trustmap :: Maybe TrustMap
|
||
, cipher :: Maybe Cipher
|
||
}
|
||
|
||
data OutputType = NormalOutput | QuietOutput | JSONOutput
|
||
|
||
newState :: Git.Repo -> AnnexState
|
||
newState gitrepo = AnnexState
|
||
{ repo = gitrepo
|
||
, backends = []
|
||
, remotes = []
|
||
, repoqueue = empty
|
||
, output = NormalOutput
|
||
, force = False
|
||
, fast = False
|
||
, branchstate = startBranchState
|
||
, forcebackend = Nothing
|
||
, forcenumcopies = Nothing
|
||
, defaultkey = Nothing
|
||
, toremote = Nothing
|
||
, fromremote = Nothing
|
||
, exclude = []
|
||
, forcetrust = []
|
||
, trustmap = Nothing
|
||
, cipher = Nothing
|
||
}
|
||
|
||
{- Create and returns an Annex state object for the specified git repo. -}
|
||
new :: Git.Repo -> IO AnnexState
|
||
new gitrepo = newState <$> Git.configRead gitrepo
|
||
|
||
{- performs an action in the Annex monad -}
|
||
run :: AnnexState -> Annex a -> IO (a, AnnexState)
|
||
run s a = runStateT (runAnnex a) s
|
||
eval :: AnnexState -> Annex a -> IO a
|
||
eval s a = evalStateT (runAnnex a) s
|
||
|
||
{- Gets a value from the internal state, selected by the passed value
|
||
- constructor. -}
|
||
getState :: (AnnexState -> a) -> Annex a
|
||
getState = gets
|
||
|
||
{- Applies a state mutation function to change the internal state.
|
||
-
|
||
- Example: changeState $ \s -> s { quiet = True }
|
||
-}
|
||
changeState :: (AnnexState -> AnnexState) -> Annex ()
|
||
changeState = modify
|
||
|
||
{- Returns the git repository being acted on -}
|
||
gitRepo :: Annex Git.Repo
|
||
gitRepo = getState repo
|