factor out RemoteLog

This commit is contained in:
Joey Hess 2011-07-05 20:16:57 -04:00
parent 9f1577f746
commit 6040d8aed1
4 changed files with 106 additions and 88 deletions

View file

@ -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 -}

View file

@ -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
View 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)

View file

@ -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