diff options
author | Joey Hess <joey@kitenet.net> | 2013-04-22 20:24:53 -0400 |
---|---|---|
committer | Joey Hess <joey@kitenet.net> | 2013-04-22 20:24:53 -0400 |
commit | 4d376b47b7aa506c4f4a4c5ccc83ca2ef1aeacc2 (patch) | |
tree | 33ab2e7c4b72d8a7fce40a0e93f63f3d50a6c3ab | |
parent | f672c39279366a8927abfcde3050952365f5e0ee (diff) |
expose Control.Monad.join
I think I've been looking for that function for some time.
Ie, I remember wanting to collapse Just Nothing to Nothing.
-rw-r--r-- | Annex/TaggedPush.hs | 2 | ||||
-rw-r--r-- | Assistant/Ssh.hs | 10 | ||||
-rw-r--r-- | Assistant/XMPP/Git.hs | 2 | ||||
-rw-r--r-- | Backend/SHA.hs | 2 | ||||
-rw-r--r-- | Command/AddUrl.hs | 2 | ||||
-rw-r--r-- | Command/InitRemote.hs | 2 | ||||
-rw-r--r-- | Command/TransferKeys.hs | 2 | ||||
-rw-r--r-- | Command/Version.hs | 6 | ||||
-rw-r--r-- | Common.hs | 4 | ||||
-rw-r--r-- | Git/Construct.hs | 3 | ||||
-rw-r--r-- | Git/Queue.hs | 3 | ||||
-rw-r--r-- | Messages.hs | 2 | ||||
-rw-r--r-- | Remote.hs | 2 | ||||
-rw-r--r-- | Remote/Bup.hs | 2 | ||||
-rw-r--r-- | Remote/Helper/Encryptable.hs | 2 | ||||
-rw-r--r-- | Upgrade/V1.hs | 6 | ||||
-rw-r--r-- | Utility/Lsof.hs | 2 | ||||
-rw-r--r-- | Utility/Rsync.hs | 2 |
18 files changed, 27 insertions, 29 deletions
diff --git a/Annex/TaggedPush.hs b/Annex/TaggedPush.hs index 4f5125ce0..5dac345f2 100644 --- a/Annex/TaggedPush.hs +++ b/Annex/TaggedPush.hs @@ -30,7 +30,7 @@ import Utility.Base64 - refs, per git-check-ref-format. -} toTaggedBranch :: UUID -> Maybe String -> Git.Branch -> Git.Branch -toTaggedBranch u info b = Git.Ref $ join "/" $ catMaybes +toTaggedBranch u info b = Git.Ref $ intercalate "/" $ catMaybes [ Just "refs/synced" , Just $ fromUUID u , toB64 <$> info diff --git a/Assistant/Ssh.hs b/Assistant/Ssh.hs index 5312eaf77..c7543d3bd 100644 --- a/Assistant/Ssh.hs +++ b/Assistant/Ssh.hs @@ -105,11 +105,11 @@ removeAuthorizedKeys rsynconly dir pubkey = do - present. -} addAuthorizedKeysCommand :: Bool -> FilePath -> SshPubKey -> String -addAuthorizedKeysCommand rsynconly dir pubkey = join "&&" +addAuthorizedKeysCommand rsynconly dir pubkey = intercalate "&&" [ "mkdir -p ~/.ssh" - , join "; " + , intercalate "; " [ "if [ ! -e " ++ wrapper ++ " ]" - , "then (" ++ join ";" (map echoval script) ++ ") > " ++ wrapper + , "then (" ++ intercalate ";" (map echoval script) ++ ") > " ++ wrapper , "fi" ] , "chmod 700 " ++ wrapper @@ -217,7 +217,7 @@ mangleSshHostName :: SshData -> String mangleSshHostName sshdata = "git-annex-" ++ T.unpack (sshHostName sshdata) ++ "-" ++ filter safe extra where - extra = join "_" $ map T.unpack $ catMaybes + extra = intercalate "_" $ map T.unpack $ catMaybes [ sshUserName sshdata , Just $ sshDirectory sshdata ] @@ -229,7 +229,7 @@ mangleSshHostName sshdata = "git-annex-" ++ T.unpack (sshHostName sshdata) {- Extracts the real hostname from a mangled ssh hostname. -} unMangleSshHostName :: String -> String unMangleSshHostName h = case split "-" h of - ("git":"annex":rest) -> join "-" (beginning rest) + ("git":"annex":rest) -> intercalate "-" (beginning rest) _ -> h {- Does ssh have known_hosts data for a hostname? -} diff --git a/Assistant/XMPP/Git.hs b/Assistant/XMPP/Git.hs index 808fbbc53..68362c848 100644 --- a/Assistant/XMPP/Git.hs +++ b/Assistant/XMPP/Git.hs @@ -97,7 +97,7 @@ xmppPush cid gitpush handledeferred = runPush SendPack cid handledeferred $ do env <- liftIO getEnvironment path <- liftIO getSearchPath let myenv = M.fromList - [ ("PATH", join [searchPathSeparator] $ tmpdir:path) + [ ("PATH", intercalate [searchPathSeparator] $ tmpdir:path) , (relayIn, show inf) , (relayOut, show outf) , (relayControl, show controlf) diff --git a/Backend/SHA.hs b/Backend/SHA.hs index 34faa4922..77bd2c124 100644 --- a/Backend/SHA.hs +++ b/Backend/SHA.hs @@ -121,7 +121,7 @@ keyValueE size source = keyValue size source >>= maybe (return Nothing) addE selectExtension :: FilePath -> String selectExtension f | null es = "" - | otherwise = join "." ("":es) + | otherwise = intercalate "." ("":es) where es = filter (not . null) $ reverse $ take 2 $ takeWhile shortenough $ diff --git a/Command/AddUrl.hs b/Command/AddUrl.hs index db003d4ef..c4062068a 100644 --- a/Command/AddUrl.hs +++ b/Command/AddUrl.hs @@ -156,7 +156,7 @@ url2file url pathdepth = case pathdepth of | otherwise -> error "bad --pathdepth" where fullurl = uriRegName auth ++ uriPath url ++ uriQuery url - frombits a = join "/" $ a urlbits + frombits a = intercalate "/" $ a urlbits urlbits = map (filesize . escape) $ filter (not . null) $ split "/" fullurl auth = fromMaybe (error $ "bad url " ++ show url) $ uriAuthority url filesize = take 255 diff --git a/Command/InitRemote.hs b/Command/InitRemote.hs index c82dc9ddf..5d48e9715 100644 --- a/Command/InitRemote.hs +++ b/Command/InitRemote.hs @@ -31,7 +31,7 @@ start [] = do error $ "Specify a name for the remote. " ++ if null names then "" - else "Either a new name, or one of these existing special remotes: " ++ join " " names + else "Either a new name, or one of these existing special remotes: " ++ intercalate " " names start (name:ws) = do (u, c) <- findByName name let fullconfig = config `M.union` c diff --git a/Command/TransferKeys.hs b/Command/TransferKeys.hs index 9334fd08f..2f5ea1fe4 100644 --- a/Command/TransferKeys.hs +++ b/Command/TransferKeys.hs @@ -95,7 +95,7 @@ runRequests readh writeh a = do sendRequest :: Transfer -> AssociatedFile -> Handle -> IO () sendRequest t f h = do - hPutStr h $ join fieldSep + hPutStr h $ intercalate fieldSep [ serialize (transferDirection t) , serialize (transferUUID t) , serialize (transferKey t) diff --git a/Command/Version.hs b/Command/Version.hs index 9d2399b86..549d89028 100644 --- a/Command/Version.hs +++ b/Command/Version.hs @@ -27,12 +27,10 @@ start = do showPackageVersion putStrLn $ "local repository version: " ++ fromMaybe "unknown" v putStrLn $ "default repository version: " ++ defaultVersion - putStrLn $ "supported repository versions: " ++ vs supportedVersions - putStrLn $ "upgrade supported from repository versions: " ++ vs upgradableVersions + putStrLn $ "supported repository versions: " ++ unwords supportedVersions + putStrLn $ "upgrade supported from repository versions: " ++ unwords upgradableVersions putStrLn $ "build flags: " ++ unwords buildFlags stop - where - vs = join " " showPackageVersion :: IO () showPackageVersion = putStrLn $ "git-annex version: " ++ SysConfig.packageversion @@ -2,7 +2,7 @@ module Common (module X) where -import Control.Monad as X hiding (join) +import Control.Monad as X import Control.Monad.IfElse as X import Control.Applicative as X import "mtl" Control.Monad.State.Strict as X (liftIO) @@ -10,7 +10,7 @@ import Control.Exception.Extensible as X (IOException) import Data.Maybe as X import Data.List as X hiding (head, tail, init, last) -import Data.String.Utils as X +import Data.String.Utils as X hiding (join) import "MissingH" System.Path as X import System.FilePath as X diff --git a/Git/Construct.hs b/Git/Construct.hs index 7500617a0..633e50b6b 100644 --- a/Git/Construct.hs +++ b/Git/Construct.hs @@ -130,7 +130,8 @@ remoteNamed n constructor = do remoteNamedFromKey :: String -> IO Repo -> IO Repo remoteNamedFromKey k = remoteNamed basename where - basename = join "." $ reverse $ drop 1 $ reverse $ drop 1 $ split "." k + basename = intercalate "." $ + reverse $ drop 1 $ reverse $ drop 1 $ split "." k {- Constructs a new Repo for one of a Repo's remotes using a given - location (ie, an url). -} diff --git a/Git/Queue.hs b/Git/Queue.hs index 712d476cd..d88c71880 100644 --- a/Git/Queue.hs +++ b/Git/Queue.hs @@ -20,7 +20,6 @@ module Git.Queue ( import qualified Data.Map as M import System.IO import System.Process -import Data.String.Utils import Utility.SafeCommand import Common @@ -151,7 +150,7 @@ runAction repo (UpdateIndexAction streamers) = runAction repo action@(CommandAction {}) = withHandle StdinHandle createProcessSuccess p $ \h -> do fileEncoding h - hPutStr h $ join "\0" $ getFiles action + hPutStr h $ intercalate "\0" $ getFiles action hClose h where p = (proc "xargs" params) { env = gitEnv repo } diff --git a/Messages.hs b/Messages.hs index cc82b9050..68bd92673 100644 --- a/Messages.hs +++ b/Messages.hs @@ -179,7 +179,7 @@ fileNotFound file = do [ "git-annex:", file, "not found" ] indent :: String -> String -indent = join "\n" . map (\l -> " " ++ l) . lines +indent = intercalate "\n" . map (\l -> " " ++ l) . lines {- Shows a JSON fragment only when in json mode. -} maybeShowJSON :: JSON a => [(String, a)] -> Annex () @@ -238,7 +238,7 @@ showTriedRemotes :: [Remote] -> Annex () showTriedRemotes [] = noop showTriedRemotes remotes = showLongNote $ "Unable to access these remotes: " ++ - join ", " (map name remotes) + intercalate ", " (map name remotes) forceTrust :: TrustLevel -> String -> Annex () forceTrust level remotename = do diff --git a/Remote/Bup.hs b/Remote/Bup.hs index 77d506d7c..f5c802e09 100644 --- a/Remote/Bup.hs +++ b/Remote/Bup.hs @@ -257,7 +257,7 @@ bup2GitRemote r where bits = split ":" r host = Prelude.head bits - dir = join ":" $ drop 1 bits + dir = intercalate ":" $ drop 1 bits -- "host:~user/dir" is not supported specially by bup; -- "host:dir" is relative to the home directory; -- "host:" goes in ~/.bup diff --git a/Remote/Helper/Encryptable.hs b/Remote/Helper/Encryptable.hs index b9a08bea6..5c6d70e9b 100644 --- a/Remote/Helper/Encryptable.hs +++ b/Remote/Helper/Encryptable.hs @@ -123,7 +123,7 @@ storeCipher c (SharedCipher t) = M.insert "cipher" (toB64 t) c storeCipher c (EncryptedCipher t ks) = M.insert "cipher" (toB64 t) $ M.insert "cipherkeys" (showkeys ks) c where - showkeys (KeyIds l) = join "," l + showkeys (KeyIds l) = intercalate "," l {- Extracts an StorableCipher from a remote's configuration. -} extractCipher :: RemoteConfig -> Maybe StorableCipher diff --git a/Upgrade/V1.hs b/Upgrade/V1.hs index f356e2cc0..e048b3db8 100644 --- a/Upgrade/V1.hs +++ b/Upgrade/V1.hs @@ -143,7 +143,7 @@ oldlog2key l -- as the v2 key that it is. readKey1 :: String -> Key readKey1 v - | mixup = fromJust $ file2key $ join ":" $ Prelude.tail bits + | mixup = fromJust $ file2key $ intercalate ":" $ Prelude.tail bits | otherwise = Key { keyName = n , keyBackendName = b @@ -153,7 +153,7 @@ readKey1 v where bits = split ":" v b = Prelude.head bits - n = join ":" $ drop (if wormy then 3 else 1) bits + n = intercalate ":" $ drop (if wormy then 3 else 1) bits t = if wormy then Just (Prelude.read (bits !! 1) :: EpochTime) else Nothing @@ -165,7 +165,7 @@ readKey1 v showKey1 :: Key -> String showKey1 Key { keyName = n , keyBackendName = b, keySize = s, keyMtime = t } = - join ":" $ filter (not . null) [b, showifhere t, showifhere s, n] + intercalate ":" $ filter (not . null) [b, showifhere t, showifhere s, n] where showifhere Nothing = "" showifhere (Just v) = show v diff --git a/Utility/Lsof.hs b/Utility/Lsof.hs index 8db514d79..31da6781e 100644 --- a/Utility/Lsof.hs +++ b/Utility/Lsof.hs @@ -32,7 +32,7 @@ setupLsof = do when (isAbsolute cmd) $ do path <- getSearchPath let path' = takeDirectory cmd : path - setEnv "PATH" (join [searchPathSeparator] path') True + setEnv "PATH" (intercalate [searchPathSeparator] path') True {- Checks each of the files in a directory to find open files. - Note that this will find hard links to files elsewhere that are open. -} diff --git a/Utility/Rsync.hs b/Utility/Rsync.hs index a36c6076f..d4eeddc8c 100644 --- a/Utility/Rsync.hs +++ b/Utility/Rsync.hs @@ -22,7 +22,7 @@ rsyncShell command = [Param "-e", Param $ unwords $ map escape (toCommand comman {- rsync requires some weird, non-shell like quoting in - here. A doubled single quote inside the single quoted - string is a single quote. -} - escape s = "'" ++ join "''" (split "'" s) ++ "'" + escape s = "'" ++ intercalate "''" (split "'" s) ++ "'" {- Runs rsync in server mode to send a file. -} rsyncServerSend :: [CommandParam] -> FilePath -> IO Bool |