git-annex/RemoteLog.hs
Joey Hess f77979b8b5 improved git-annex branch changing
All changes to files in the branch are now made via pure functions that
transform the old file into the new. This will allow adding locking
to prevent read/write races. It also makes the code nicer, and purer.

I noticed a behavior change, really a sort of bug fix. Before,
'git annex untrust foo --trust bar' would change both trust levels
permanantly, now the --trust doesn't get stored.
2011-10-03 15:41:25 -04:00

97 lines
2.4 KiB
Haskell

{- 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 Control.Applicative
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 = Branch.change remoteLog $
serialize . M.insert u c . remoteLogParse
where
serialize = unlines . sort . map toline . M.toList
toline (u', c') = u' ++ " " ++ unwords (configToKeyVal c')
{- Map of remotes by uuid containing key/value config maps. -}
readRemoteLog :: Annex (M.Map UUID RemoteConfig)
readRemoteLog = remoteLogParse <$> Branch.get remoteLog
remoteLogParse :: String -> M.Map UUID RemoteConfig
remoteLogParse s =
M.fromList $ mapMaybe parseline $ filter (not . null) $ lines s
where
parseline l
| length w > 2 = Just (u, c)
| otherwise = Nothing
where
w = words l
u = head w
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) && head r == ';'
{- for quickcheck -}
prop_idempotent_configEscape :: String -> Bool
prop_idempotent_configEscape s = s == (configUnEscape . configEscape) s