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.
This commit is contained in:
		
					parent
					
						
							
								2a84deb271
							
						
					
				
			
			
				commit
				
					
						8a2d1988d3
					
				
			
		
					 19 changed files with 30 additions and 32 deletions
				
			
		| 
						 | 
					@ -30,7 +30,7 @@ import Utility.Base64
 | 
				
			||||||
 - refs, per git-check-ref-format.
 | 
					 - refs, per git-check-ref-format.
 | 
				
			||||||
 -}
 | 
					 -}
 | 
				
			||||||
toTaggedBranch :: UUID -> Maybe String -> Git.Branch -> Git.Branch
 | 
					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 "refs/synced"
 | 
				
			||||||
	, Just $ fromUUID u
 | 
						, Just $ fromUUID u
 | 
				
			||||||
	, toB64 <$> info
 | 
						, toB64 <$> info
 | 
				
			||||||
| 
						 | 
					
 | 
				
			||||||
| 
						 | 
					@ -105,11 +105,11 @@ removeAuthorizedKeys rsynconly dir pubkey = do
 | 
				
			||||||
 - present.
 | 
					 - present.
 | 
				
			||||||
 -}
 | 
					 -}
 | 
				
			||||||
addAuthorizedKeysCommand :: Bool -> FilePath -> SshPubKey -> String
 | 
					addAuthorizedKeysCommand :: Bool -> FilePath -> SshPubKey -> String
 | 
				
			||||||
addAuthorizedKeysCommand rsynconly dir pubkey = join "&&"
 | 
					addAuthorizedKeysCommand rsynconly dir pubkey = intercalate "&&"
 | 
				
			||||||
	[ "mkdir -p ~/.ssh"
 | 
						[ "mkdir -p ~/.ssh"
 | 
				
			||||||
	, join "; "
 | 
						, intercalate "; "
 | 
				
			||||||
		[ "if [ ! -e " ++ wrapper ++ " ]"
 | 
							[ "if [ ! -e " ++ wrapper ++ " ]"
 | 
				
			||||||
		, "then (" ++ join ";" (map echoval script) ++ ") > " ++ wrapper
 | 
							, "then (" ++ intercalate ";" (map echoval script) ++ ") > " ++ wrapper
 | 
				
			||||||
		, "fi"
 | 
							, "fi"
 | 
				
			||||||
		]
 | 
							]
 | 
				
			||||||
	, "chmod 700 " ++ wrapper
 | 
						, "chmod 700 " ++ wrapper
 | 
				
			||||||
| 
						 | 
					@ -217,7 +217,7 @@ mangleSshHostName :: SshData -> String
 | 
				
			||||||
mangleSshHostName sshdata = "git-annex-" ++ T.unpack (sshHostName sshdata)
 | 
					mangleSshHostName sshdata = "git-annex-" ++ T.unpack (sshHostName sshdata)
 | 
				
			||||||
	++ "-" ++ filter safe extra
 | 
						++ "-" ++ filter safe extra
 | 
				
			||||||
  where
 | 
					  where
 | 
				
			||||||
	extra = join "_" $ map T.unpack $ catMaybes
 | 
						extra = intercalate "_" $ map T.unpack $ catMaybes
 | 
				
			||||||
		[ sshUserName sshdata
 | 
							[ sshUserName sshdata
 | 
				
			||||||
		, Just $ sshDirectory 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. -}
 | 
					{- Extracts the real hostname from a mangled ssh hostname. -}
 | 
				
			||||||
unMangleSshHostName :: String -> String
 | 
					unMangleSshHostName :: String -> String
 | 
				
			||||||
unMangleSshHostName h = case split "-" h of
 | 
					unMangleSshHostName h = case split "-" h of
 | 
				
			||||||
	("git":"annex":rest) -> join "-" (beginning rest)
 | 
						("git":"annex":rest) -> intercalate "-" (beginning rest)
 | 
				
			||||||
	_ -> h
 | 
						_ -> h
 | 
				
			||||||
 | 
					
 | 
				
			||||||
{- Does ssh have known_hosts data for a hostname? -}
 | 
					{- Does ssh have known_hosts data for a hostname? -}
 | 
				
			||||||
| 
						 | 
					
 | 
				
			||||||
| 
						 | 
					@ -205,7 +205,7 @@ testServer sshinput@(SshInput { inputHostname = Just hn }) = do
 | 
				
			||||||
		, rsyncOnly = status == UsableRsyncServer
 | 
							, rsyncOnly = status == UsableRsyncServer
 | 
				
			||||||
		}
 | 
							}
 | 
				
			||||||
	probe extraopts = do
 | 
						probe extraopts = do
 | 
				
			||||||
		let remotecommand = shellWrap $ join ";"
 | 
							let remotecommand = shellWrap $ intercalate ";"
 | 
				
			||||||
			[ report "loggedin"
 | 
								[ report "loggedin"
 | 
				
			||||||
			, checkcommand "git-annex-shell"
 | 
								, checkcommand "git-annex-shell"
 | 
				
			||||||
			, checkcommand "rsync"
 | 
								, checkcommand "rsync"
 | 
				
			||||||
| 
						 | 
					@ -287,7 +287,7 @@ makeSsh' rsync setup sshdata keypair =
 | 
				
			||||||
  where
 | 
					  where
 | 
				
			||||||
	sshhost = genSshHost (sshHostName sshdata) (sshUserName sshdata)
 | 
						sshhost = genSshHost (sshHostName sshdata) (sshUserName sshdata)
 | 
				
			||||||
	remotedir = T.unpack $ sshDirectory sshdata
 | 
						remotedir = T.unpack $ sshDirectory sshdata
 | 
				
			||||||
	remoteCommand = shellWrap $ join "&&" $ catMaybes
 | 
						remoteCommand = shellWrap $ intercalate "&&" $ catMaybes
 | 
				
			||||||
		[ Just $ "mkdir -p " ++ shellEscape remotedir
 | 
							[ Just $ "mkdir -p " ++ shellEscape remotedir
 | 
				
			||||||
		, Just $ "cd " ++ shellEscape remotedir
 | 
							, Just $ "cd " ++ shellEscape remotedir
 | 
				
			||||||
		, if rsync then Nothing else Just "if [ ! -d .git ]; then git init --bare --shared; fi"
 | 
							, if rsync then Nothing else Just "if [ ! -d .git ]; then git init --bare --shared; fi"
 | 
				
			||||||
| 
						 | 
					@ -353,7 +353,7 @@ makeRsyncNet sshinput reponame setup = do
 | 
				
			||||||
	 - one recommended by rsync.net documentation. I touch the file first
 | 
						 - one recommended by rsync.net documentation. I touch the file first
 | 
				
			||||||
	 - to not need to use a different method to create it.
 | 
						 - to not need to use a different method to create it.
 | 
				
			||||||
	 -}
 | 
						 -}
 | 
				
			||||||
	let remotecommand = join ";"
 | 
						let remotecommand = intercalate ";"
 | 
				
			||||||
		[ "mkdir -p .ssh"
 | 
							[ "mkdir -p .ssh"
 | 
				
			||||||
		, "touch .ssh/authorized_keys"
 | 
							, "touch .ssh/authorized_keys"
 | 
				
			||||||
		, "dd of=.ssh/authorized_keys oflag=append conv=notrunc"
 | 
							, "dd of=.ssh/authorized_keys oflag=append conv=notrunc"
 | 
				
			||||||
| 
						 | 
					
 | 
				
			||||||
| 
						 | 
					@ -97,7 +97,7 @@ xmppPush cid gitpush handledeferred = runPush SendPack cid handledeferred $ do
 | 
				
			||||||
	env <- liftIO getEnvironment
 | 
						env <- liftIO getEnvironment
 | 
				
			||||||
	path <- liftIO getSearchPath
 | 
						path <- liftIO getSearchPath
 | 
				
			||||||
	let myenv = M.fromList
 | 
						let myenv = M.fromList
 | 
				
			||||||
		[ ("PATH", join [searchPathSeparator] $ tmpdir:path)
 | 
							[ ("PATH", intercalate [searchPathSeparator] $ tmpdir:path)
 | 
				
			||||||
		, (relayIn, show inf)
 | 
							, (relayIn, show inf)
 | 
				
			||||||
		, (relayOut, show outf)
 | 
							, (relayOut, show outf)
 | 
				
			||||||
		, (relayControl, show controlf)
 | 
							, (relayControl, show controlf)
 | 
				
			||||||
| 
						 | 
					
 | 
				
			||||||
| 
						 | 
					@ -121,7 +121,7 @@ keyValueE size source = keyValue size source >>= maybe (return Nothing) addE
 | 
				
			||||||
selectExtension :: FilePath -> String
 | 
					selectExtension :: FilePath -> String
 | 
				
			||||||
selectExtension f
 | 
					selectExtension f
 | 
				
			||||||
	| null es = ""
 | 
						| null es = ""
 | 
				
			||||||
	| otherwise = join "." ("":es)
 | 
						| otherwise = intercalate "." ("":es)
 | 
				
			||||||
  where
 | 
					  where
 | 
				
			||||||
	es = filter (not . null) $ reverse $
 | 
						es = filter (not . null) $ reverse $
 | 
				
			||||||
		take 2 $ takeWhile shortenough $
 | 
							take 2 $ takeWhile shortenough $
 | 
				
			||||||
| 
						 | 
					
 | 
				
			||||||
| 
						 | 
					@ -156,7 +156,7 @@ url2file url pathdepth = case pathdepth of
 | 
				
			||||||
		| otherwise -> error "bad --pathdepth"
 | 
							| otherwise -> error "bad --pathdepth"
 | 
				
			||||||
  where
 | 
					  where
 | 
				
			||||||
	fullurl = uriRegName auth ++ uriPath url ++ uriQuery url
 | 
						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
 | 
						urlbits = map (filesize . escape) $ filter (not . null) $ split "/" fullurl
 | 
				
			||||||
	auth = fromMaybe (error $ "bad url " ++ show url) $ uriAuthority url
 | 
						auth = fromMaybe (error $ "bad url " ++ show url) $ uriAuthority url
 | 
				
			||||||
	filesize = take 255
 | 
						filesize = take 255
 | 
				
			||||||
| 
						 | 
					
 | 
				
			||||||
| 
						 | 
					@ -31,7 +31,7 @@ start [] = do
 | 
				
			||||||
	error $ "Specify a name for the remote. " ++
 | 
						error $ "Specify a name for the remote. " ++
 | 
				
			||||||
		if null names
 | 
							if null names
 | 
				
			||||||
			then ""
 | 
								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
 | 
					start (name:ws) = do
 | 
				
			||||||
	(u, c) <- findByName name
 | 
						(u, c) <- findByName name
 | 
				
			||||||
	let fullconfig = config `M.union` c	
 | 
						let fullconfig = config `M.union` c	
 | 
				
			||||||
| 
						 | 
					
 | 
				
			||||||
| 
						 | 
					@ -95,7 +95,7 @@ runRequests readh writeh a = do
 | 
				
			||||||
 | 
					
 | 
				
			||||||
sendRequest :: Transfer -> AssociatedFile -> Handle -> IO ()
 | 
					sendRequest :: Transfer -> AssociatedFile -> Handle -> IO ()
 | 
				
			||||||
sendRequest t f h = do
 | 
					sendRequest t f h = do
 | 
				
			||||||
	hPutStr h $ join fieldSep
 | 
						hPutStr h $ intercalate fieldSep
 | 
				
			||||||
		[ serialize (transferDirection t)
 | 
							[ serialize (transferDirection t)
 | 
				
			||||||
		, serialize (transferUUID t)
 | 
							, serialize (transferUUID t)
 | 
				
			||||||
		, serialize (transferKey t)
 | 
							, serialize (transferKey t)
 | 
				
			||||||
| 
						 | 
					
 | 
				
			||||||
| 
						 | 
					@ -27,12 +27,10 @@ start = do
 | 
				
			||||||
		showPackageVersion
 | 
							showPackageVersion
 | 
				
			||||||
		putStrLn $ "local repository version: " ++ fromMaybe "unknown" v
 | 
							putStrLn $ "local repository version: " ++ fromMaybe "unknown" v
 | 
				
			||||||
		putStrLn $ "default repository version: " ++ defaultVersion
 | 
							putStrLn $ "default repository version: " ++ defaultVersion
 | 
				
			||||||
		putStrLn $ "supported repository versions: " ++ vs supportedVersions
 | 
							putStrLn $ "supported repository versions: " ++ unwords supportedVersions
 | 
				
			||||||
		putStrLn $ "upgrade supported from repository versions: " ++ vs upgradableVersions
 | 
							putStrLn $ "upgrade supported from repository versions: " ++ unwords upgradableVersions
 | 
				
			||||||
		putStrLn $ "build flags: " ++ unwords buildFlags
 | 
							putStrLn $ "build flags: " ++ unwords buildFlags
 | 
				
			||||||
	stop
 | 
						stop
 | 
				
			||||||
  where
 | 
					 | 
				
			||||||
	vs = join " "
 | 
					 | 
				
			||||||
 | 
					
 | 
				
			||||||
showPackageVersion :: IO ()
 | 
					showPackageVersion :: IO ()
 | 
				
			||||||
showPackageVersion = putStrLn $ "git-annex version: " ++ SysConfig.packageversion
 | 
					showPackageVersion = putStrLn $ "git-annex version: " ++ SysConfig.packageversion
 | 
				
			||||||
| 
						 | 
					
 | 
				
			||||||
| 
						 | 
					@ -2,7 +2,7 @@
 | 
				
			||||||
 | 
					
 | 
				
			||||||
module Common (module X) where
 | 
					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.Monad.IfElse as X
 | 
				
			||||||
import Control.Applicative as X
 | 
					import Control.Applicative as X
 | 
				
			||||||
import "mtl" Control.Monad.State.Strict as X (liftIO)
 | 
					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.Maybe as X
 | 
				
			||||||
import Data.List as X hiding (head, tail, init, last)
 | 
					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 "MissingH" System.Path as X
 | 
				
			||||||
import System.FilePath as X
 | 
					import System.FilePath as X
 | 
				
			||||||
| 
						 | 
					
 | 
				
			||||||
| 
						 | 
					@ -130,7 +130,8 @@ remoteNamed n constructor = do
 | 
				
			||||||
remoteNamedFromKey :: String -> IO Repo -> IO Repo
 | 
					remoteNamedFromKey :: String -> IO Repo -> IO Repo
 | 
				
			||||||
remoteNamedFromKey k = remoteNamed basename
 | 
					remoteNamedFromKey k = remoteNamed basename
 | 
				
			||||||
  where
 | 
					  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
 | 
					{- Constructs a new Repo for one of a Repo's remotes using a given
 | 
				
			||||||
 - location (ie, an url). -}
 | 
					 - location (ie, an url). -}
 | 
				
			||||||
| 
						 | 
					
 | 
				
			||||||
| 
						 | 
					@ -20,7 +20,6 @@ module Git.Queue (
 | 
				
			||||||
import qualified Data.Map as M
 | 
					import qualified Data.Map as M
 | 
				
			||||||
import System.IO
 | 
					import System.IO
 | 
				
			||||||
import System.Process
 | 
					import System.Process
 | 
				
			||||||
import Data.String.Utils
 | 
					 | 
				
			||||||
 | 
					
 | 
				
			||||||
import Utility.SafeCommand
 | 
					import Utility.SafeCommand
 | 
				
			||||||
import Common
 | 
					import Common
 | 
				
			||||||
| 
						 | 
					@ -151,7 +150,7 @@ runAction repo (UpdateIndexAction streamers) =
 | 
				
			||||||
runAction repo action@(CommandAction {}) =
 | 
					runAction repo action@(CommandAction {}) =
 | 
				
			||||||
	withHandle StdinHandle createProcessSuccess p $ \h -> do
 | 
						withHandle StdinHandle createProcessSuccess p $ \h -> do
 | 
				
			||||||
		fileEncoding h
 | 
							fileEncoding h
 | 
				
			||||||
		hPutStr h $ join "\0" $ getFiles action
 | 
							hPutStr h $ intercalate "\0" $ getFiles action
 | 
				
			||||||
		hClose h
 | 
							hClose h
 | 
				
			||||||
  where
 | 
					  where
 | 
				
			||||||
	p = (proc "xargs" params) { env = gitEnv repo }
 | 
						p = (proc "xargs" params) { env = gitEnv repo }
 | 
				
			||||||
| 
						 | 
					
 | 
				
			||||||
| 
						 | 
					@ -179,7 +179,7 @@ fileNotFound file = do
 | 
				
			||||||
			[ "git-annex:", file, "not found" ]
 | 
								[ "git-annex:", file, "not found" ]
 | 
				
			||||||
 | 
					
 | 
				
			||||||
indent :: String -> String
 | 
					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. -}
 | 
					{- Shows a JSON fragment only when in json mode. -}
 | 
				
			||||||
maybeShowJSON :: JSON a => [(String, a)] -> Annex ()
 | 
					maybeShowJSON :: JSON a => [(String, a)] -> Annex ()
 | 
				
			||||||
| 
						 | 
					
 | 
				
			||||||
| 
						 | 
					@ -238,7 +238,7 @@ showTriedRemotes :: [Remote] -> Annex ()
 | 
				
			||||||
showTriedRemotes [] = noop
 | 
					showTriedRemotes [] = noop
 | 
				
			||||||
showTriedRemotes remotes =
 | 
					showTriedRemotes remotes =
 | 
				
			||||||
	showLongNote $ "Unable to access these remotes: " ++
 | 
						showLongNote $ "Unable to access these remotes: " ++
 | 
				
			||||||
		join ", " (map name remotes)
 | 
							intercalate ", " (map name remotes)
 | 
				
			||||||
 | 
					
 | 
				
			||||||
forceTrust :: TrustLevel -> String -> Annex ()
 | 
					forceTrust :: TrustLevel -> String -> Annex ()
 | 
				
			||||||
forceTrust level remotename = do
 | 
					forceTrust level remotename = do
 | 
				
			||||||
| 
						 | 
					
 | 
				
			||||||
| 
						 | 
					@ -257,7 +257,7 @@ bup2GitRemote r
 | 
				
			||||||
  where
 | 
					  where
 | 
				
			||||||
	bits = split ":" r
 | 
						bits = split ":" r
 | 
				
			||||||
	host = Prelude.head bits
 | 
						host = Prelude.head bits
 | 
				
			||||||
	dir = join ":" $ drop 1 bits
 | 
						dir = intercalate ":" $ drop 1 bits
 | 
				
			||||||
	-- "host:~user/dir" is not supported specially by bup;
 | 
						-- "host:~user/dir" is not supported specially by bup;
 | 
				
			||||||
	-- "host:dir" is relative to the home directory;
 | 
						-- "host:dir" is relative to the home directory;
 | 
				
			||||||
	-- "host:" goes in ~/.bup
 | 
						-- "host:" goes in ~/.bup
 | 
				
			||||||
| 
						 | 
					
 | 
				
			||||||
| 
						 | 
					@ -123,7 +123,7 @@ storeCipher c (SharedCipher t) = M.insert "cipher" (toB64 t) c
 | 
				
			||||||
storeCipher c (EncryptedCipher t ks) = 
 | 
					storeCipher c (EncryptedCipher t ks) = 
 | 
				
			||||||
	M.insert "cipher" (toB64 t) $ M.insert "cipherkeys" (showkeys ks) c
 | 
						M.insert "cipher" (toB64 t) $ M.insert "cipherkeys" (showkeys ks) c
 | 
				
			||||||
  where
 | 
					  where
 | 
				
			||||||
	showkeys (KeyIds l) = join "," l
 | 
						showkeys (KeyIds l) = intercalate "," l
 | 
				
			||||||
 | 
					
 | 
				
			||||||
{- Extracts an StorableCipher from a remote's configuration. -}
 | 
					{- Extracts an StorableCipher from a remote's configuration. -}
 | 
				
			||||||
extractCipher :: RemoteConfig -> Maybe StorableCipher
 | 
					extractCipher :: RemoteConfig -> Maybe StorableCipher
 | 
				
			||||||
| 
						 | 
					
 | 
				
			||||||
| 
						 | 
					@ -143,7 +143,7 @@ oldlog2key l
 | 
				
			||||||
-- as the v2 key that it is.
 | 
					-- as the v2 key that it is.
 | 
				
			||||||
readKey1 :: String -> Key
 | 
					readKey1 :: String -> Key
 | 
				
			||||||
readKey1 v
 | 
					readKey1 v
 | 
				
			||||||
	| mixup = fromJust $ file2key $ join ":" $ Prelude.tail bits
 | 
						| mixup = fromJust $ file2key $ intercalate ":" $ Prelude.tail bits
 | 
				
			||||||
	| otherwise = Key
 | 
						| otherwise = Key
 | 
				
			||||||
		{ keyName = n
 | 
							{ keyName = n
 | 
				
			||||||
		, keyBackendName = b
 | 
							, keyBackendName = b
 | 
				
			||||||
| 
						 | 
					@ -153,7 +153,7 @@ readKey1 v
 | 
				
			||||||
  where
 | 
					  where
 | 
				
			||||||
	bits = split ":" v
 | 
						bits = split ":" v
 | 
				
			||||||
	b = Prelude.head bits
 | 
						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
 | 
						t = if wormy
 | 
				
			||||||
		then Just (Prelude.read (bits !! 1) :: EpochTime)
 | 
							then Just (Prelude.read (bits !! 1) :: EpochTime)
 | 
				
			||||||
		else Nothing
 | 
							else Nothing
 | 
				
			||||||
| 
						 | 
					@ -165,7 +165,7 @@ readKey1 v
 | 
				
			||||||
 | 
					
 | 
				
			||||||
showKey1 :: Key -> String
 | 
					showKey1 :: Key -> String
 | 
				
			||||||
showKey1 Key { keyName = n , keyBackendName = b, keySize = s, keyMtime = t } =
 | 
					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
 | 
					  where
 | 
				
			||||||
	showifhere Nothing = ""
 | 
						showifhere Nothing = ""
 | 
				
			||||||
	showifhere (Just v) = show v
 | 
						showifhere (Just v) = show v
 | 
				
			||||||
| 
						 | 
					
 | 
				
			||||||
| 
						 | 
					@ -32,7 +32,7 @@ setupLsof = do
 | 
				
			||||||
	when (isAbsolute cmd) $ do
 | 
						when (isAbsolute cmd) $ do
 | 
				
			||||||
		path <- getSearchPath
 | 
							path <- getSearchPath
 | 
				
			||||||
		let path' = takeDirectory cmd : path
 | 
							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.
 | 
					{- 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. -}
 | 
					 - Note that this will find hard links to files elsewhere that are open. -}
 | 
				
			||||||
| 
						 | 
					
 | 
				
			||||||
| 
						 | 
					@ -22,7 +22,7 @@ rsyncShell command = [Param "-e", Param $ unwords $ map escape (toCommand comman
 | 
				
			||||||
	{- rsync requires some weird, non-shell like quoting in
 | 
						{- rsync requires some weird, non-shell like quoting in
 | 
				
			||||||
	- here. A doubled single quote inside the single quoted
 | 
						- here. A doubled single quote inside the single quoted
 | 
				
			||||||
	- string is a single quote. -}
 | 
						- string is a single quote. -}
 | 
				
			||||||
	escape s = "'" ++  join "''" (split "'" s) ++ "'"
 | 
						escape s = "'" ++  intercalate "''" (split "'" s) ++ "'"
 | 
				
			||||||
 | 
					
 | 
				
			||||||
{- Runs rsync in server mode to send a file. -}
 | 
					{- Runs rsync in server mode to send a file. -}
 | 
				
			||||||
rsyncServerSend :: [CommandParam] -> FilePath -> IO Bool
 | 
					rsyncServerSend :: [CommandParam] -> FilePath -> IO Bool
 | 
				
			||||||
| 
						 | 
					
 | 
				
			||||||
		Loading…
	
	Add table
		Add a link
		
	
		Reference in a new issue