summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorGravatar Joey Hess <joey@kitenet.net>2011-07-05 20:16:57 -0400
committerGravatar Joey Hess <joey@kitenet.net>2011-07-05 20:16:57 -0400
commit6040d8aed17de582f5d5c179040e29c599315e31 (patch)
treebb524b386d740353e35a99c235a5d9b6af1f4ddb
parent9f1577f74684d8d627e75d3021eb1ff50ef7492f (diff)
factor out RemoteLog
-rw-r--r--Command/InitRemote.hs9
-rw-r--r--Remote.hs85
-rw-r--r--RemoteLog.hs97
-rw-r--r--test.hs3
4 files changed, 106 insertions, 88 deletions
diff --git a/Command/InitRemote.hs b/Command/InitRemote.hs
index a3054630c..15962ad99 100644
--- a/Command/InitRemote.hs
+++ b/Command/InitRemote.hs
@@ -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 -}
diff --git a/Remote.hs b/Remote.hs
index 623b85733..a86e1022c 100644
--- a/Remote.hs
+++ b/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)
diff --git a/RemoteLog.hs b/RemoteLog.hs
new file mode 100644
index 000000000..c2065db9d
--- /dev/null
+++ b/RemoteLog.hs
@@ -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)
diff --git a/test.hs b/test.hs
index 76ffe4047..9dad37e0c 100644
--- a/test.hs
+++ b/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