mirrors/git-annex
2
0
Fork 0
Code Issues Pull requests Projects Releases Packages 1 Wiki Activity Actions

reorg

Browse source
This commit is contained in:
Joey Hess 2014-01-21 18:08:56 -04:00
parent 0ef282a116
commit f7cdc40f7b
14 changed files with 91 additions and 77 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

2
Annex/Drop.hs
View file

@ -9,7 +9,7 @@ module Annex.Drop where
import Common.Annex
import Logs.Trust
import Logs.NumCopies
import Config.NumCopies
import Types.Remote (uuid)
import qualified Remote
import qualified Command.Drop

2
Assistant/WebApp/Configurators/Preferences.hs
View file

@ -17,11 +17,11 @@ import qualified Annex
import qualified Git
import Config
import Config.Files
import Config.NumCopies
import Utility.DataUnits
import Git.Config
import Types.Distribution
import qualified Build.SysConfig
import Logs.NumCopies
import qualified Data.Text as T

2
Command/Copy.hs
View file

@ -13,7 +13,7 @@ import GitAnnex.Options
import qualified Command.Move
import qualified Remote
import Annex.Wanted
import Logs.NumCopies
import Config.NumCopies
def :: [Command]
def = [withOptions Command.Move.moveOptions $ command "copy" paramPaths seek

2
Command/Drop.hs
View file

@ -14,7 +14,7 @@ import qualified Annex
import Annex.UUID
import Logs.Location
import Logs.Trust
import Logs.NumCopies
import Config.NumCopies
import Annex.Content
import qualified Option
import Annex.Wanted

2
Command/DropUnused.hs
View file

@ -15,7 +15,7 @@ import qualified Remote
import qualified Git
import qualified Option
import Command.Unused (withUnusedMaps, UnusedMaps(..), startUnused)
import Logs.NumCopies
import Config.NumCopies
def :: [Command]
def = [withOptions [Command.Drop.fromOption] $

2
Command/Fsck.hs
View file

@ -25,7 +25,7 @@ import Annex.Perms
import Annex.Link
import Logs.Location
import Logs.Trust
import Logs.NumCopies
import Config.NumCopies
import Annex.UUID
import Utility.DataUnits
import Utility.FileMode

2
Command/Get.hs
View file

@ -12,7 +12,7 @@ import Command
import qualified Remote
import Annex.Content
import Logs.Transfer
import Logs.NumCopies
import Config.NumCopies
import Annex.Wanted
import GitAnnex.Options
import qualified Command.Move

2
Command/Info.hs
View file

@ -29,7 +29,7 @@ import Annex.Content
import Types.Key
import Logs.UUID
import Logs.Trust
import Logs.NumCopies
import Config.NumCopies
import Remote
import Config
import Utility.Percentage

2
Command/Mirror.hs
View file

@ -16,7 +16,7 @@ import qualified Command.Get
import qualified Remote
import Annex.Content
import qualified Annex
import Logs.NumCopies
import Config.NumCopies
def :: [Command]
def = [withOptions (fromToOptions ++ keyOptions) $

2
Command/NumCopies.hs
View file

@ -10,7 +10,7 @@ module Command.NumCopies where
import Common.Annex
import qualified Annex
import Command
import Logs.NumCopies
import Config.NumCopies
import Types.Messages
def :: [Command]

80
Config/NumCopies.hs Normal file
View file

@ -0,0 +1,80 @@
{- git-annex numcopies configuration
-
- Copyright 2014 Joey Hess <joey@kitenet.net>
-
- Licensed under the GNU GPL version 3 or higher.
-}
module Config.NumCopies (
module Types.NumCopies,
module Logs.NumCopies,
getFileNumCopies,
getGlobalFileNumCopies,
getNumCopies,
numCopiesCheck,
deprecatedNumCopies,
defaultNumCopies
) where
import Common.Annex
import qualified Annex
import Types.NumCopies
import Logs.NumCopies
import Logs.Trust
import Annex.CheckAttr
import qualified Remote
defaultNumCopies :: NumCopies
defaultNumCopies = NumCopies 1
fromSources :: [Annex (Maybe NumCopies)] -> Annex NumCopies
fromSources = fromMaybe defaultNumCopies <$$> getM id
{- The git config annex.numcopies is deprecated. -}
deprecatedNumCopies :: Annex (Maybe NumCopies)
deprecatedNumCopies = annexNumCopies <$> Annex.getGitConfig
{- Value forced on the command line by --numcopies. -}
getForcedNumCopies :: Annex (Maybe NumCopies)
getForcedNumCopies = Annex.getState Annex.forcenumcopies
{- Numcopies value from any of the non-.gitattributes configuration
- sources. -}
getNumCopies :: Annex NumCopies
getNumCopies = fromSources
[ getForcedNumCopies
, getGlobalNumCopies
, deprecatedNumCopies
]
{- Numcopies value for a file, from any configuration source, including the
- deprecated git config. -}
getFileNumCopies :: FilePath -> Annex NumCopies
getFileNumCopies f = fromSources
[ getForcedNumCopies
, getFileNumCopies' f
, deprecatedNumCopies
]
{- This is the globally visible numcopies value for a file. So it does
- not include local configuration in the git config or command line
- options. -}
getGlobalFileNumCopies :: FilePath -> Annex NumCopies
getGlobalFileNumCopies f = fromSources
[ getFileNumCopies' f
]
getFileNumCopies' :: FilePath -> Annex (Maybe NumCopies)
getFileNumCopies' file = maybe getGlobalNumCopies (return . Just) =<< getattr
where
getattr = (NumCopies <$$> readish)
<$> checkAttr "annex.numcopies" file
{- Checks if numcopies are satisfied for a file by running a comparison
- between the number of (not untrusted) copies that are
- belived to exist, and the configured value. -}
numCopiesCheck :: FilePath -> Key -> (Int -> Int -> v) -> Annex v
numCopiesCheck file key vs = do
NumCopies needed <- getFileNumCopies file
have <- trustExclude UnTrusted =<< Remote.keyLocations key
return $ length have `vs` needed

2
Limit.hs
View file

@ -23,7 +23,7 @@ import qualified Backend
import Annex.Content
import Annex.UUID
import Logs.Trust
import Logs.NumCopies
import Config.NumCopies
import Types.TrustLevel
import Types.Key
import Types.Group

65
Logs/NumCopies.hs
View file

@ -8,16 +8,9 @@
{-# OPTIONS_GHC -fno-warn-orphans #-}
module Logs.NumCopies (
module Types.NumCopies,
setGlobalNumCopies,
getGlobalNumCopies,
globalNumCopiesLoad,
getFileNumCopies,
getGlobalFileNumCopies,
getNumCopies,
numCopiesCheck,
deprecatedNumCopies,
defaultNumCopies
) where
import Common.Annex
@ -25,9 +18,6 @@ import qualified Annex
import Types.NumCopies
import Logs
import Logs.SingleValue
import Logs.Trust
import Annex.CheckAttr
import qualified Remote
instance SingleValueSerializable NumCopies where
serialize (NumCopies n) = show n
@ -46,58 +36,3 @@ globalNumCopiesLoad = do
v <- getLog numcopiesLog
Annex.changeState $ \s -> s { Annex.globalnumcopies = v }
return v
defaultNumCopies :: NumCopies
defaultNumCopies = NumCopies 1
fromSources :: [Annex (Maybe NumCopies)] -> Annex NumCopies
fromSources = fromMaybe defaultNumCopies <$$> getM id
{- The git config annex.numcopies is deprecated. -}
deprecatedNumCopies :: Annex (Maybe NumCopies)
deprecatedNumCopies = annexNumCopies <$> Annex.getGitConfig
{- Value forced on the command line by --numcopies. -}
getForcedNumCopies :: Annex (Maybe NumCopies)
getForcedNumCopies = Annex.getState Annex.forcenumcopies
{- Numcopies value from any of the non-.gitattributes configuration
- sources. -}
getNumCopies :: Annex NumCopies
getNumCopies = fromSources
[ getForcedNumCopies
, getGlobalNumCopies
, deprecatedNumCopies
]
{- Numcopies value for a file, from any configuration source, including the
- deprecated git config. -}
getFileNumCopies :: FilePath -> Annex NumCopies
getFileNumCopies f = fromSources
[ getForcedNumCopies
, getFileNumCopies' f
, deprecatedNumCopies
]
{- This is the globally visible numcopies value for a file. So it does
- not include local configuration in the git config or command line
- options. -}
getGlobalFileNumCopies :: FilePath -> Annex NumCopies
getGlobalFileNumCopies f = fromSources
[ getFileNumCopies' f
]
getFileNumCopies' :: FilePath -> Annex (Maybe NumCopies)
getFileNumCopies' file = maybe getGlobalNumCopies (return . Just) =<< getattr
where
getattr = (NumCopies <$$> readish)
<$> checkAttr "annex.numcopies" file
{- Checks if numcopies are satisfied for a file by running a comparison
- between the number of (not untrusted) copies that are
- belived to exist, and the configured value. -}
numCopiesCheck :: FilePath -> Key -> (Int -> Int -> v) -> Annex v
numCopiesCheck file key vs = do
NumCopies needed <- getFileNumCopies file
have <- trustExclude UnTrusted =<< Remote.keyLocations key
return $ length have `vs` needed

1
Types/GitConfig.hs
View file

@ -79,7 +79,6 @@ extractGitConfig r = GitConfig
, gcryptId = getmaybe "core.gcrypt-id"
}
where
get k def = fromMaybe def $ getmayberead k
getbool k def = fromMaybe def $ getmaybebool k
getmaybebool k = Git.Config.isTrue =<< getmaybe k
getmayberead k = readish =<< getmaybe k