avoid unnecessary Maybe

2012-11-30 00:55:59 -04:00 · 2012-11-30 00:55:59 -04:00 · 020a25abe1
commit 020a25abe1
parent d56a5c9996
13 changed files with 112 additions and 128 deletions
--- a/Remote/Bup.hs
+++ b/Remote/Bup.hs
@ -38,7 +38,7 @@ remote = RemoteType {
 	setup = bupSetup
 }

-gen :: Git.Repo -> UUID -> Maybe RemoteConfig -> Annex Remote
+gen :: Git.Repo -> UUID -> RemoteConfig -> Annex Remote
 gen r u c = do
 	buprepo <- getRemoteConfig r "buprepo" (error "missing buprepo")
 	cst <- remoteCost r (if bupLocal buprepo then semiCheapRemoteCost else expensiveRemoteCost)
--- a/Remote/Directory.hs
+++ b/Remote/Directory.hs
@ -33,7 +33,7 @@ remote = RemoteType {
 	setup = directorySetup
 }

-gen :: Git.Repo -> UUID -> Maybe RemoteConfig -> Annex Remote
+gen :: Git.Repo -> UUID -> RemoteConfig -> Annex Remote
 gen r u c = do
 	dir <- getRemoteConfig r "directory" (error "missing directory")
 	cst <- remoteCost r cheapRemoteCost
@ -52,7 +52,7 @@ gen r u c = do
 			hasKey = checkPresent dir chunksize,
 			hasKeyCheap = True,
 			whereisKey = Nothing,
-			config = Nothing,
+			config = M.empty,
 			repo = r,
 			localpath = Just dir,
 			readonly = False,
--- a/Remote/Git.hs
+++ b/Remote/Git.hs
@ -83,7 +83,7 @@ configRead r = do
 repoCheap :: Git.Repo -> Bool
 repoCheap = not . Git.repoIsUrl

-gen :: Git.Repo -> UUID -> Maybe RemoteConfig -> Annex Remote
+gen :: Git.Repo -> UUID -> RemoteConfig -> Annex Remote
 gen r u _ = new <$> remoteCost r defcst
  where
 	defcst = if repoCheap r then cheapRemoteCost else expensiveRemoteCost
@ -98,7 +98,7 @@ gen r u _ = new <$> remoteCost r defcst
 		, hasKey = inAnnex r
 		, hasKeyCheap = repoCheap r
 		, whereisKey = Nothing
-		, config = Nothing
+		, config = M.empty
 		, localpath = if Git.repoIsLocal r || Git.repoIsLocalUnknown r
 			then Just $ Git.repoPath r
 			else Nothing
--- a/Remote/Glacier.hs
+++ b/Remote/Glacier.hs
@ -36,34 +36,31 @@ remote = RemoteType {
 	setup = glacierSetup
 }

-gen :: Git.Repo -> UUID -> Maybe RemoteConfig -> Annex Remote
-gen r u c = do
-	cst <- remoteCost r veryExpensiveRemoteCost
-	return $ gen' r u c cst
-gen' :: Git.Repo -> UUID -> Maybe RemoteConfig -> Int -> Remote
-gen' r u c cst =
-	encryptableRemote c
+gen :: Git.Repo -> UUID -> RemoteConfig -> Annex Remote
+gen r u c = new <$> remoteCost r veryExpensiveRemoteCost
+  where
+	new cst = encryptableRemote c
 		(storeEncrypted this)
 		(retrieveEncrypted this)
 		this
-  where
-	this = Remote {
-		uuid = u,
-		cost = cst,
-		name = Git.repoDescribe r,
- 		storeKey = store this,
-		retrieveKeyFile = retrieve this,
-		retrieveKeyFileCheap = retrieveCheap this,
-		removeKey = remove this,
-		hasKey = checkPresent this,
-		hasKeyCheap = False,
-		whereisKey = Nothing,
-		config = c,
-		repo = r,
-		localpath = Nothing,
-		readonly = False,
-		remotetype = remote
-	}
+	  where
+		this = Remote {
+			uuid = u,
+			cost = cst,
+			name = Git.repoDescribe r,
+ 			storeKey = store this,
+			retrieveKeyFile = retrieve this,
+			retrieveKeyFileCheap = retrieveCheap this,
+			removeKey = remove this,
+			hasKey = checkPresent this,
+			hasKeyCheap = False,
+			whereisKey = Nothing,
+			config = c,
+			repo = r,
+			localpath = Nothing,
+			readonly = False,
+			remotetype = remote
+		}

 glacierSetup :: UUID -> RemoteConfig -> Annex RemoteConfig
 glacierSetup u c = do
@ -115,13 +112,13 @@ retrieveEncrypted r (cipher, enck) k d = metered Nothing k $ \meterupdate ->
 storeHelper :: Remote -> Key -> (Handle -> IO ()) -> Annex Bool
 storeHelper r k feeder = go =<< glacierEnv c u
  where
-	c = fromJust $ config r
+	c = config r
 	u = uuid r
 	params = glacierParams c
 		[ Param "archive"
 		, Param "upload"
 		, Param "--name", Param $ archive r k
-		, Param $ remoteVault r
+		, Param $ getVault $ config r
 		, Param "-"
 		]
 	go Nothing = return False
@ -135,13 +132,13 @@ storeHelper r k feeder = go =<< glacierEnv c u
 retrieveHelper :: Remote -> Key -> (Handle -> IO ()) -> Annex Bool
 retrieveHelper r k reader = go =<< glacierEnv c u
  where
-	c = fromJust $ config r
+	c = config r
 	u = uuid r
 	params = glacierParams c
 		[ Param "archive"
 		, Param "retrieve"
 		, Param "-o-"
-		, Param $ remoteVault r
+		, Param $ getVault $ config r
 		, Param $ archive r k
 		]
 	go Nothing = return False
@ -163,14 +160,14 @@ remove :: Remote -> Key -> Annex Bool
 remove r k = glacierAction r
 	[ Param "archive"
 	, Param "delete"
-	, Param $ remoteVault r
+	, Param $ getVault $ config r
 	, Param $ archive r k
 	]

 checkPresent :: Remote -> Key -> Annex (Either String Bool)
 checkPresent r k = do
 	showAction $ "checking " ++ name r
-	go =<< glacierEnv (fromJust $ config r) (uuid r)
+	go =<< glacierEnv (config r) (uuid r)
  where
 	go Nothing = return $ Left "cannot check glacier"
 	go (Just e) = do
@ -190,7 +187,7 @@ checkPresent r k = do
 	params =
 		[ Param "archive"
 		, Param "checkpresent"
-		, Param $ remoteVault r
+		, Param $ getVault $ config r
 		, Param "--quiet"
 		, Param $ archive r k
 		]
@ -205,7 +202,7 @@ checkPresent r k = do
 		return $ Right False

 glacierAction :: Remote -> [CommandParam] -> Annex Bool
-glacierAction r params = runGlacier (fromJust $ config r) (uuid r) params
+glacierAction r params = runGlacier (config r) (uuid r) params

 runGlacier :: RemoteConfig -> UUID -> [CommandParam] -> Annex Bool
 runGlacier c u params = go =<< glacierEnv c u
@ -231,16 +228,13 @@ glacierEnv c u = go =<< getRemoteCredPairFor "glacier" c creds
 	creds = AWS.creds u
 	(uk, pk) = credPairEnvironment creds

-remoteVault :: Remote -> Vault
-remoteVault = getVault . fromJust . config
-
 getVault :: RemoteConfig -> Vault
 getVault = fromJust . M.lookup "vault"

 archive :: Remote -> Key -> Archive
 archive r k = fileprefix ++ key2file k
  where
-	fileprefix = M.findWithDefault "" "fileprefix" $ fromJust $ config r
+	fileprefix = M.findWithDefault "" "fileprefix" $ config r

 -- glacier vault create will succeed even if the vault already exists.
 genVault :: RemoteConfig -> UUID -> Annex ()
@ -260,11 +254,11 @@ genVault c u = unlessM (runGlacier c u params) $
 - keys when the remote is encrypted.
 -}
 jobList :: Remote -> [Key] -> Annex ([Key], [Key])
-jobList r keys = go =<< glacierEnv (fromJust $ config r) (uuid r)
+jobList r keys = go =<< glacierEnv (config r) (uuid r)
  where
 	params = [ Param "job", Param "list" ]
 	nada = ([], [])
-	myvault = remoteVault r
+	myvault = getVault $ config r

 	go Nothing = return nada
 	go (Just e) = do
--- a/Remote/Helper/Chunked.hs
+++ b/Remote/Helper/Chunked.hs
@ -20,9 +20,8 @@ import qualified Control.Exception as E
 type ChunkSize = Maybe Int64

 {- Gets a remote's configured chunk size. -}
-chunkSize :: Maybe RemoteConfig -> ChunkSize
-chunkSize Nothing = Nothing
-chunkSize (Just m) =
+chunkSize :: RemoteConfig -> ChunkSize
+chunkSize m =
 	case M.lookup "chunksize" m of
 		Nothing -> Nothing
 		Just v -> case readSize dataUnits v of
--- a/Remote/Helper/Encryptable.hs
+++ b/Remote/Helper/Encryptable.hs
@ -44,7 +44,7 @@ encryptionSetup c = case (M.lookup "encryption" c, extractCipher c) of
 - Two additional functions must be provided by the remote,
 - to support storing and retrieving encrypted content. -}
 encryptableRemote
-	:: Maybe RemoteConfig
+	:: RemoteConfig
 	-> ((Cipher, Key) -> Key -> MeterUpdate -> Annex Bool)
 	-> ((Cipher, Key) -> Key -> FilePath -> Annex Bool)
 	-> Remote
@ -103,9 +103,8 @@ embedCreds c
 	| otherwise = False

 {- Gets encryption Cipher, and encrypted version of Key. -}
-cipherKey :: Maybe RemoteConfig -> Key -> Annex (Maybe (Cipher, Key))
-cipherKey Nothing _ = return Nothing
-cipherKey (Just c) k = maybe Nothing make <$> remoteCipher c
+cipherKey :: RemoteConfig -> Key -> Annex (Maybe (Cipher, Key))
+cipherKey c k = maybe Nothing make <$> remoteCipher c
  where
 	make ciphertext = Just (ciphertext, encryptKey ciphertext k)

--- a/Remote/Hook.hs
+++ b/Remote/Hook.hs
@ -29,7 +29,7 @@ remote = RemoteType {
 	setup = hookSetup
 }

-gen :: Git.Repo -> UUID -> Maybe RemoteConfig -> Annex Remote
+gen :: Git.Repo -> UUID -> RemoteConfig -> Annex Remote
 gen r u c = do
 	hooktype <- getRemoteConfig r "hooktype" (error "missing hooktype")
 	cst <- remoteCost r expensiveRemoteCost
@ -47,7 +47,7 @@ gen r u c = do
 			hasKey = checkPresent r hooktype,
 			hasKeyCheap = False,
 			whereisKey = Nothing,
-			config = Nothing,
+			config = M.empty,
 			localpath = Nothing,
 			repo = r,
 			readonly = False,
--- a/Remote/List.hs
+++ b/Remote/List.hs
@ -81,7 +81,7 @@ remoteListRefresh = do
 remoteGen :: (M.Map UUID RemoteConfig) -> RemoteType -> Git.Repo -> Annex Remote
 remoteGen m t r = do
 	u <- getRepoUUID r
-	addHooks =<< generate t r u (M.lookup u m)
+	addHooks =<< generate t r u (fromMaybe M.empty $ M.lookup u m)

 {- Updates a local git Remote, re-reading its git config. -}
 updateRemote :: Remote -> Annex Remote
--- a/Remote/Rsync.hs
+++ b/Remote/Rsync.hs
@ -38,7 +38,7 @@ remote = RemoteType {
 	setup = rsyncSetup
 }

-gen :: Git.Repo -> UUID -> Maybe RemoteConfig -> Annex Remote
+gen :: Git.Repo -> UUID -> RemoteConfig -> Annex Remote
 gen r u c = do
 	o <- genRsyncOpts r c
 	cst <- remoteCost r expensiveRemoteCost
@ -56,7 +56,7 @@ gen r u c = do
 			, hasKey = checkPresent r o
 			, hasKeyCheap = False
 			, whereisKey = Nothing
-			, config = Nothing
+			, config = M.empty
 			, repo = r
 			, localpath = if rsyncUrlIsPath $ rsyncUrl o
 				then Just $ rsyncUrl o
@ -65,12 +65,12 @@ gen r u c = do
 			, remotetype = remote
 			}

-genRsyncOpts :: Git.Repo -> Maybe RemoteConfig -> Annex RsyncOpts
+genRsyncOpts :: Git.Repo -> RemoteConfig -> Annex RsyncOpts
 genRsyncOpts r c = do
 	url <- getRemoteConfig r "rsyncurl" (error "missing rsyncurl")
 	opts <- map Param . filter safe . words
 		<$> getRemoteConfig r "rsync-options" ""
-	let escape = maybe True (\m -> M.lookup "shellescape" m /= Just "no") c
+	let escape = M.lookup "shellescape" c /= Just "no"
 	return $ RsyncOpts url opts escape
  where
 	safe o
--- a/Remote/S3.hs
+++ b/Remote/S3.hs
@ -36,34 +36,31 @@ remote = RemoteType {
 	setup = s3Setup
 }

-gen :: Git.Repo -> UUID -> Maybe RemoteConfig -> Annex Remote
-gen r u c = do
-	cst <- remoteCost r expensiveRemoteCost
-	return $ gen' r u c cst
-gen' :: Git.Repo -> UUID -> Maybe RemoteConfig -> Int -> Remote
-gen' r u c cst =
-	encryptableRemote c
+gen :: Git.Repo -> UUID -> RemoteConfig -> Annex Remote
+gen r u c = new <$> remoteCost r expensiveRemoteCost
+  where
+	new cst = encryptableRemote c
 		(storeEncrypted this)
 		(retrieveEncrypted this)
 		this
-  where
-	this = Remote {
-		uuid = u,
-		cost = cst,
-		name = Git.repoDescribe r,
- 		storeKey = store this,
-		retrieveKeyFile = retrieve this,
-		retrieveKeyFileCheap = retrieveCheap this,
-		removeKey = remove this,
-		hasKey = checkPresent this,
-		hasKeyCheap = False,
-		whereisKey = Nothing,
-		config = c,
-		repo = r,
-		localpath = Nothing,
-		readonly = False,
-		remotetype = remote
-	}
+	  where
+		this = Remote {
+			uuid = u,
+			cost = cst,
+			name = Git.repoDescribe r,
+ 			storeKey = store this,
+			retrieveKeyFile = retrieve this,
+			retrieveKeyFileCheap = retrieveCheap this,
+			removeKey = remove this,
+			hasKey = checkPresent this,
+			hasKeyCheap = False,
+			whereisKey = Nothing,
+			config = c,
+			repo = r,
+			localpath = Nothing,
+			readonly = False,
+			remotetype = remote
+		}

 s3Setup :: UUID -> RemoteConfig -> Annex RemoteConfig
 s3Setup u c = handlehost $ M.lookup "host" c
@ -143,13 +140,13 @@ storeHelper (conn, bucket) r k p file = do
 			sendObject conn object
  where
 	storageclass =
-		case fromJust $ M.lookup "storageclass" $ fromJust $ config r of
+		case fromJust $ M.lookup "storageclass" $ config r of
 			"REDUCED_REDUNDANCY" -> REDUCED_REDUNDANCY
 			_ -> STANDARD

 	getsize = liftIO $ fromIntegral . fileSize <$> getFileStatus file
 	
-	xheaders = filter isxheader $ M.assocs $ fromJust $ config r
+	xheaders = filter isxheader $ M.assocs $ config r
 	isxheader (h, _) = "x-amz-" `isPrefixOf` h

 retrieve :: Remote -> Key -> AssociatedFile -> FilePath -> Annex Bool
@ -207,10 +204,8 @@ s3Bool (Left e) = s3Warning e

 s3Action :: Remote -> a -> ((AWSConnection, String) -> Annex a) -> Annex a
 s3Action r noconn action = do
-	when (isNothing $ config r) $
-		error $ "Missing configuration for special remote " ++ name r
-	let bucket = M.lookup "bucket" $ fromJust $ config r
-	conn <- s3Connection (fromJust $ config r) (uuid r)
+	let bucket = M.lookup "bucket" $ config r
+	conn <- s3Connection (config r) (uuid r)
 	case (bucket, conn) of
 		(Just b, Just c) -> action (c, b)
 		_ -> return noconn
@ -222,7 +217,7 @@ bucketFile r = munge . key2file
 		Just "ia" -> iaMunge $ fileprefix ++ s
 		_ -> fileprefix ++ s
 	fileprefix = M.findWithDefault "" "fileprefix" c
-	c = fromJust $ config r
+	c = config r

 bucketKey :: Remote -> String -> Key -> S3Object
 bucketKey r bucket k = S3Object bucket (bucketFile r k) "" [] L.empty
--- a/Remote/Web.hs
+++ b/Remote/Web.hs
@ -17,6 +17,8 @@ import Logs.Web
 import qualified Utility.Url as Url
 import Types.Key

+import qualified Data.Map as M
+
 remote :: RemoteType
 remote = RemoteType {
 	typename = "web",
@ -33,7 +35,7 @@ list = do
 	r <- liftIO $ Git.Construct.remoteNamed "web" Git.Construct.fromUnknown
 	return [r]

-gen :: Git.Repo -> UUID -> Maybe RemoteConfig -> Annex Remote
+gen :: Git.Repo -> UUID -> RemoteConfig -> Annex Remote
 gen r _ _ = 
 	return Remote {
 		uuid = webUUID,
@ -46,7 +48,7 @@ gen r _ _ =
 		hasKey = checkKey,
 		hasKeyCheap = False,
 		whereisKey = Just getUrls,
-		config = Nothing,
+		config = M.empty,
 		localpath = Nothing,
 		repo = r,
 		readonly = True,
--- a/Remote/WebDAV.hs
+++ b/Remote/WebDAV.hs
@ -45,34 +45,31 @@ remote = RemoteType {
 	setup = webdavSetup
 }

-gen :: Git.Repo -> UUID -> Maybe RemoteConfig -> Annex Remote
-gen r u c = do
-	cst <- remoteCost r expensiveRemoteCost
-	return $ gen' r u c cst
-gen' :: Git.Repo -> UUID -> Maybe RemoteConfig -> Int -> Remote
-gen' r u c cst =
-	encryptableRemote c
+gen :: Git.Repo -> UUID -> RemoteConfig -> Annex Remote
+gen r u c = new <$> remoteCost r expensiveRemoteCost
+  where
+	new cst = encryptableRemote c
 		(storeEncrypted this)
 		(retrieveEncrypted this)
 		this
-  where
-	this = Remote {
-		uuid = u,
-		cost = cst,
-		name = Git.repoDescribe r,
- 		storeKey = store this,
-		retrieveKeyFile = retrieve this,
-		retrieveKeyFileCheap = retrieveCheap this,
-		removeKey = remove this,
-		hasKey = checkPresent this,
-		hasKeyCheap = False,
-		whereisKey = Nothing,
-		config = c,
-		repo = r,
-		localpath = Nothing,
-		readonly = False,
-		remotetype = remote
-	}
+	  where
+		this = Remote {
+			uuid = u,
+			cost = cst,
+			name = Git.repoDescribe r,
+ 			storeKey = store this,
+			retrieveKeyFile = retrieve this,
+			retrieveKeyFileCheap = retrieveCheap this,
+			removeKey = remove this,
+			hasKey = checkPresent this,
+			hasKeyCheap = False,
+			whereisKey = Nothing,
+			config = c,
+			repo = r,
+			localpath = Nothing,
+			readonly = False,
+			remotetype = remote
+		}

 webdavSetup :: UUID -> RemoteConfig -> Annex RemoteConfig
 webdavSetup u c = do
@ -201,14 +198,12 @@ withStoredFiles r k baseurl user pass onerr a
 	keyurl = davLocation baseurl k ++ keyFile k

 davAction :: Remote -> a -> ((DavUrl, DavUser, DavPass) -> Annex a) -> Annex a
-davAction r unconfigured action = case config r of
-	Nothing -> return unconfigured
-	Just c -> do
-		mcreds <- getCreds c (uuid r)
-		case (mcreds, M.lookup "url" c) of
-			(Just (user, pass), Just url) ->
-				action (url, toDavUser user, toDavPass pass)
-			_ -> return unconfigured
+davAction r unconfigured action = do
+	mcreds <- getCreds (config r) (uuid r)
+	case (mcreds, M.lookup "url" $ config r) of
+		(Just (user, pass), Just url) ->
+			action (url, toDavUser user, toDavPass pass)
+		_ -> return unconfigured

 toDavUser :: String -> DavUser
 toDavUser = B8.fromString
--- a/Types/Remote.hs
+++ b/Types/Remote.hs
@ -27,7 +27,7 @@ data RemoteTypeA a = RemoteType {
 	-- enumerates remotes of this type
 	enumerate :: a [Git.Repo],
 	-- generates a remote of this type
-	generate :: Git.Repo -> UUID -> Maybe RemoteConfig -> a (RemoteA a),
+	generate :: Git.Repo -> UUID -> RemoteConfig -> a (RemoteA a),
 	-- initializes or changes a remote
 	setup :: UUID -> RemoteConfig -> a RemoteConfig
 }
@ -62,8 +62,8 @@ data RemoteA a = Remote {
 	hasKeyCheap :: Bool,
 	-- Some remotes can provide additional details for whereis.
 	whereisKey :: Maybe (Key -> a [String]),
-	-- a Remote can have a persistent configuration store
-	config :: Maybe RemoteConfig,
+	-- a Remote has a persistent configuration store
+	config :: RemoteConfig,
 	-- git configuration for the remote
 	repo :: Git.Repo,
 	-- a Remote can be assocated with a specific local filesystem path