factor out RemoteLog
This commit is contained in:
parent
9f1577f746
commit
6040d8aed1
4 changed files with 106 additions and 88 deletions
|
@ -15,6 +15,7 @@ import Data.String.Utils
|
|||
|
||||
import Command
|
||||
import qualified Remote
|
||||
import qualified RemoteLog
|
||||
import qualified Types.Remote as R
|
||||
import Types
|
||||
import UUID
|
||||
|
@ -42,7 +43,7 @@ start ws = do
|
|||
|
||||
where
|
||||
name = head ws
|
||||
config = Remote.keyValToConfig $ tail ws
|
||||
config = RemoteLog.keyValToConfig $ tail ws
|
||||
needname = do
|
||||
let err s = error $ "Specify a name for the remote. " ++ s
|
||||
names <- remoteNames
|
||||
|
@ -58,13 +59,13 @@ perform t u c = do
|
|||
|
||||
cleanup :: UUID -> R.RemoteConfig -> CommandCleanup
|
||||
cleanup u c = do
|
||||
Remote.configSet u c
|
||||
RemoteLog.configSet u c
|
||||
return True
|
||||
|
||||
{- Look up existing remote's UUID and config by name, or generate a new one -}
|
||||
findByName :: String -> Annex (UUID, R.RemoteConfig)
|
||||
findByName name = do
|
||||
m <- Remote.readRemoteLog
|
||||
m <- RemoteLog.readRemoteLog
|
||||
maybe generate return $ findByName' name m
|
||||
where
|
||||
generate = do
|
||||
|
@ -83,7 +84,7 @@ findByName' n m = if null matches then Nothing else Just $ head matches
|
|||
|
||||
remoteNames :: Annex [String]
|
||||
remoteNames = do
|
||||
m <- Remote.readRemoteLog
|
||||
m <- RemoteLog.readRemoteLog
|
||||
return $ catMaybes $ map ((M.lookup nameKey) . snd) $ M.toList m
|
||||
|
||||
{- find the specified remote type -}
|
||||
|
|
85
Remote.hs
85
Remote.hs
|
@ -17,7 +17,6 @@ module Remote (
|
|||
|
||||
keyPossibilities,
|
||||
keyPossibilitiesTrusted,
|
||||
forceTrust,
|
||||
remoteTypes,
|
||||
genList,
|
||||
byName,
|
||||
|
@ -27,24 +26,14 @@ module Remote (
|
|||
prettyPrintUUIDs,
|
||||
showTriedRemotes,
|
||||
showLocations,
|
||||
|
||||
remoteLog,
|
||||
readRemoteLog,
|
||||
configSet,
|
||||
keyValToConfig,
|
||||
configToKeyVal,
|
||||
|
||||
prop_idempotent_configEscape
|
||||
forceTrust
|
||||
) where
|
||||
|
||||
import Control.Monad (filterM, liftM2)
|
||||
import Data.List
|
||||
import qualified Data.Map as M
|
||||
import Data.Maybe
|
||||
import Data.Char
|
||||
import Data.String.Utils
|
||||
|
||||
import qualified Branch
|
||||
import Types
|
||||
import Types.Remote
|
||||
import UUID
|
||||
|
@ -53,6 +42,7 @@ import Config
|
|||
import Trust
|
||||
import LocationLog
|
||||
import Messages
|
||||
import RemoteLog
|
||||
|
||||
import qualified Remote.Git
|
||||
import qualified Remote.S3
|
||||
|
@ -215,74 +205,3 @@ forceTrust level remotename = do
|
|||
r <- nameToUUID remotename
|
||||
Annex.changeState $ \s ->
|
||||
s { Annex.forcetrust = (r, level):Annex.forcetrust s }
|
||||
|
||||
{- Filename of remote.log. -}
|
||||
remoteLog :: FilePath
|
||||
remoteLog = "remote.log"
|
||||
|
||||
{- Adds or updates a remote's config in the log. -}
|
||||
configSet :: UUID -> RemoteConfig -> Annex ()
|
||||
configSet u c = do
|
||||
m <- readRemoteLog
|
||||
Branch.change remoteLog $ unlines $ sort $
|
||||
map toline $ M.toList $ M.insert u c m
|
||||
where
|
||||
toline (u', c') = u' ++ " " ++ (unwords $ configToKeyVal c')
|
||||
|
||||
{- Map of remotes by uuid containing key/value config maps. -}
|
||||
readRemoteLog :: Annex (M.Map UUID RemoteConfig)
|
||||
readRemoteLog = return . remoteLogParse =<< Branch.get remoteLog
|
||||
|
||||
remoteLogParse :: String -> M.Map UUID RemoteConfig
|
||||
remoteLogParse s =
|
||||
M.fromList $ catMaybes $ map parseline $ filter (not . null) $ lines s
|
||||
where
|
||||
parseline l
|
||||
| length w > 2 = Just (u, c)
|
||||
| otherwise = Nothing
|
||||
where
|
||||
w = words l
|
||||
u = w !! 0
|
||||
c = keyValToConfig $ tail w
|
||||
|
||||
{- Given Strings like "key=value", generates a RemoteConfig. -}
|
||||
keyValToConfig :: [String] -> RemoteConfig
|
||||
keyValToConfig ws = M.fromList $ map (/=/) ws
|
||||
where
|
||||
(/=/) s = (k, v)
|
||||
where
|
||||
k = takeWhile (/= '=') s
|
||||
v = configUnEscape $ drop (1 + length k) s
|
||||
|
||||
configToKeyVal :: M.Map String String -> [String]
|
||||
configToKeyVal m = map toword $ sort $ M.toList m
|
||||
where
|
||||
toword (k, v) = k ++ "=" ++ configEscape v
|
||||
|
||||
configEscape :: String -> String
|
||||
configEscape = (>>= escape)
|
||||
where
|
||||
escape c
|
||||
| isSpace c || c `elem` "&" = "&" ++ show (ord c) ++ ";"
|
||||
| otherwise = [c]
|
||||
|
||||
configUnEscape :: String -> String
|
||||
configUnEscape = unescape
|
||||
where
|
||||
unescape [] = []
|
||||
unescape (c:rest)
|
||||
| c == '&' = entity rest
|
||||
| otherwise = c : unescape rest
|
||||
entity s = if ok
|
||||
then chr (read num) : unescape rest
|
||||
else '&' : unescape s
|
||||
where
|
||||
num = takeWhile isNumber s
|
||||
r = drop (length num) s
|
||||
rest = drop 1 r
|
||||
ok = not (null num) &&
|
||||
not (null r) && r !! 0 == ';'
|
||||
|
||||
{- for quickcheck -}
|
||||
prop_idempotent_configEscape :: String -> Bool
|
||||
prop_idempotent_configEscape s = s == (configUnEscape $ configEscape s)
|
||||
|
|
97
RemoteLog.hs
Normal file
97
RemoteLog.hs
Normal file
|
@ -0,0 +1,97 @@
|
|||
{- git-annex remote log
|
||||
-
|
||||
- Copyright 2011 Joey Hess <joey@kitenet.net>
|
||||
-
|
||||
- Licensed under the GNU GPL version 3 or higher.
|
||||
-}
|
||||
|
||||
module RemoteLog (
|
||||
remoteLog,
|
||||
readRemoteLog,
|
||||
configSet,
|
||||
keyValToConfig,
|
||||
configToKeyVal,
|
||||
|
||||
prop_idempotent_configEscape
|
||||
) where
|
||||
|
||||
import Data.List
|
||||
import qualified Data.Map as M
|
||||
import Data.Maybe
|
||||
import Data.Char
|
||||
|
||||
import qualified Branch
|
||||
import Types
|
||||
import Types.Remote
|
||||
import UUID
|
||||
|
||||
{- Filename of remote.log. -}
|
||||
remoteLog :: FilePath
|
||||
remoteLog = "remote.log"
|
||||
|
||||
{- Adds or updates a remote's config in the log. -}
|
||||
configSet :: UUID -> RemoteConfig -> Annex ()
|
||||
configSet u c = do
|
||||
m <- readRemoteLog
|
||||
Branch.change remoteLog $ unlines $ sort $
|
||||
map toline $ M.toList $ M.insert u c m
|
||||
where
|
||||
toline (u', c') = u' ++ " " ++ (unwords $ configToKeyVal c')
|
||||
|
||||
{- Map of remotes by uuid containing key/value config maps. -}
|
||||
readRemoteLog :: Annex (M.Map UUID RemoteConfig)
|
||||
readRemoteLog = return . remoteLogParse =<< Branch.get remoteLog
|
||||
|
||||
remoteLogParse :: String -> M.Map UUID RemoteConfig
|
||||
remoteLogParse s =
|
||||
M.fromList $ catMaybes $ map parseline $ filter (not . null) $ lines s
|
||||
where
|
||||
parseline l
|
||||
| length w > 2 = Just (u, c)
|
||||
| otherwise = Nothing
|
||||
where
|
||||
w = words l
|
||||
u = w !! 0
|
||||
c = keyValToConfig $ tail w
|
||||
|
||||
{- Given Strings like "key=value", generates a RemoteConfig. -}
|
||||
keyValToConfig :: [String] -> RemoteConfig
|
||||
keyValToConfig ws = M.fromList $ map (/=/) ws
|
||||
where
|
||||
(/=/) s = (k, v)
|
||||
where
|
||||
k = takeWhile (/= '=') s
|
||||
v = configUnEscape $ drop (1 + length k) s
|
||||
|
||||
configToKeyVal :: M.Map String String -> [String]
|
||||
configToKeyVal m = map toword $ sort $ M.toList m
|
||||
where
|
||||
toword (k, v) = k ++ "=" ++ configEscape v
|
||||
|
||||
configEscape :: String -> String
|
||||
configEscape = (>>= escape)
|
||||
where
|
||||
escape c
|
||||
| isSpace c || c `elem` "&" = "&" ++ show (ord c) ++ ";"
|
||||
| otherwise = [c]
|
||||
|
||||
configUnEscape :: String -> String
|
||||
configUnEscape = unescape
|
||||
where
|
||||
unescape [] = []
|
||||
unescape (c:rest)
|
||||
| c == '&' = entity rest
|
||||
| otherwise = c : unescape rest
|
||||
entity s = if ok
|
||||
then chr (read num) : unescape rest
|
||||
else '&' : unescape s
|
||||
where
|
||||
num = takeWhile isNumber s
|
||||
r = drop (length num) s
|
||||
rest = drop 1 r
|
||||
ok = not (null num) &&
|
||||
not (null r) && r !! 0 == ';'
|
||||
|
||||
{- for quickcheck -}
|
||||
prop_idempotent_configEscape :: String -> Bool
|
||||
prop_idempotent_configEscape s = s == (configUnEscape $ configEscape s)
|
3
test.hs
3
test.hs
|
@ -36,6 +36,7 @@ import qualified LocationLog
|
|||
import qualified UUID
|
||||
import qualified Trust
|
||||
import qualified Remote
|
||||
import qualified RemoteLog
|
||||
import qualified Content
|
||||
import qualified Command.DropUnused
|
||||
import qualified Types.Key
|
||||
|
@ -73,7 +74,7 @@ quickcheck = TestLabel "quickcheck" $ TestList
|
|||
, qctest "prop_idempotent_key_read_show" Types.Key.prop_idempotent_key_read_show
|
||||
, qctest "prop_idempotent_shellEscape" Utility.prop_idempotent_shellEscape
|
||||
, qctest "prop_idempotent_shellEscape_multiword" Utility.prop_idempotent_shellEscape_multiword
|
||||
, qctest "prop_idempotent_configEscape" Remote.prop_idempotent_configEscape
|
||||
, qctest "prop_idempotent_configEscape" RemoteLog.prop_idempotent_configEscape
|
||||
, qctest "prop_parentDir_basics" Utility.prop_parentDir_basics
|
||||
, qctest "prop_relPathDirToFile_basics" Utility.prop_relPathDirToFile_basics
|
||||
, qctest "prop_cost_sane" Config.prop_cost_sane
|
||||
|
|
Loading…
Reference in a new issue