support remote config values with spaces and other characters
This commit is contained in:
parent
ceff04ff3e
commit
93c5fb5da7
3 changed files with 36 additions and 5 deletions
|
@ -37,8 +37,6 @@ start ws = notBareRepo $ do
|
||||||
(u, c) <- findByName name
|
(u, c) <- findByName name
|
||||||
let fullconfig = M.union config c
|
let fullconfig = M.union config c
|
||||||
t <- findType fullconfig
|
t <- findType fullconfig
|
||||||
|
|
||||||
liftIO $ putStrLn $ show fullconfig
|
|
||||||
|
|
||||||
showStart "initremote" name
|
showStart "initremote" name
|
||||||
next $ perform t u $ M.union config c
|
next $ perform t u $ M.union config c
|
||||||
|
|
38
Remote.hs
38
Remote.hs
|
@ -25,7 +25,10 @@ module Remote (
|
||||||
remoteLog,
|
remoteLog,
|
||||||
readRemoteLog,
|
readRemoteLog,
|
||||||
configSet,
|
configSet,
|
||||||
keyValToConfig
|
keyValToConfig,
|
||||||
|
configToKeyVal,
|
||||||
|
|
||||||
|
prop_idempotent_configEscape
|
||||||
) where
|
) where
|
||||||
|
|
||||||
import Control.Monad.State (liftIO)
|
import Control.Monad.State (liftIO)
|
||||||
|
@ -33,6 +36,7 @@ import Control.Monad (when, liftM, filterM)
|
||||||
import Data.List
|
import Data.List
|
||||||
import qualified Data.Map as M
|
import qualified Data.Map as M
|
||||||
import Data.Maybe
|
import Data.Maybe
|
||||||
|
import Data.Char
|
||||||
|
|
||||||
import RemoteClass
|
import RemoteClass
|
||||||
import Types
|
import Types
|
||||||
|
@ -176,9 +180,37 @@ keyValToConfig ws = M.fromList $ map (/=/) ws
|
||||||
(/=/) s = (k, v)
|
(/=/) s = (k, v)
|
||||||
where
|
where
|
||||||
k = takeWhile (/= '=') s
|
k = takeWhile (/= '=') s
|
||||||
v = drop (1 + length k) s
|
v = configUnEscape $ drop (1 + length k) s
|
||||||
|
|
||||||
configToKeyVal :: M.Map String String -> [String]
|
configToKeyVal :: M.Map String String -> [String]
|
||||||
configToKeyVal m = map toword $ sort $ M.toList m
|
configToKeyVal m = map toword $ sort $ M.toList m
|
||||||
where
|
where
|
||||||
toword (k, v) = k ++ "=" ++ v
|
toword (k, v) = k ++ "=" ++ configEscape v
|
||||||
|
|
||||||
|
configEscape :: String -> String
|
||||||
|
configEscape = concat . (map 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)
|
||||||
|
|
1
test.hs
1
test.hs
|
@ -75,6 +75,7 @@ quickcheck = TestLabel "quickcheck" $ TestList
|
||||||
, qctest "prop_idempotent_key_read_show" Key.prop_idempotent_key_read_show
|
, qctest "prop_idempotent_key_read_show" Key.prop_idempotent_key_read_show
|
||||||
, qctest "prop_idempotent_shellEscape" Utility.prop_idempotent_shellEscape
|
, qctest "prop_idempotent_shellEscape" Utility.prop_idempotent_shellEscape
|
||||||
, qctest "prop_idempotent_shellEscape_multiword" Utility.prop_idempotent_shellEscape_multiword
|
, qctest "prop_idempotent_shellEscape_multiword" Utility.prop_idempotent_shellEscape_multiword
|
||||||
|
, qctest "prop_idempotent_configEscape" Remote.prop_idempotent_configEscape
|
||||||
, qctest "prop_parentDir_basics" Utility.prop_parentDir_basics
|
, qctest "prop_parentDir_basics" Utility.prop_parentDir_basics
|
||||||
, qctest "prop_relPathDirToFile_basics" Utility.prop_relPathDirToFile_basics
|
, qctest "prop_relPathDirToFile_basics" Utility.prop_relPathDirToFile_basics
|
||||||
, qctest "prop_cost_sane" Config.prop_cost_sane
|
, qctest "prop_cost_sane" Config.prop_cost_sane
|
||||||
|
|
Loading…
Add table
Add a link
Reference in a new issue