summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorGravatar Joey Hess <joey@kitenet.net>2011-05-15 02:49:43 -0400
committerGravatar Joey Hess <joey@kitenet.net>2011-05-15 03:38:08 -0400
commitcad0e1c8b7eb21f8dceca8dd9fa3bc1d1aa7eabd (patch)
treeb6be12dc1cc83a35ca7d89a862d85e6d71c38572
parentefa7f544050c0d5be6bc1b0fc0125278e475c213 (diff)
simplified a bunch of Maybe handling
-rw-r--r--Backend.hs29
-rw-r--r--Base64.hs6
-rw-r--r--Command.hs26
-rw-r--r--Command/DropUnused.hs9
-rw-r--r--Command/InitRemote.hs17
-rw-r--r--Command/Map.hs16
-rw-r--r--Command/Unused.hs14
-rw-r--r--Content.hs10
-rw-r--r--Crypto.hs6
-rw-r--r--Dot.hs5
-rw-r--r--GitRepo.hs13
-rw-r--r--LocationLog.hs4
-rw-r--r--Remote/Bup.hs5
-rw-r--r--Remote/Directory.hs5
-rw-r--r--Remote/Encryptable.hs9
-rw-r--r--Remote/Hook.hs15
-rw-r--r--Remote/Rsync.hs5
-rw-r--r--Remote/S3real.hs16
-rw-r--r--Utility.hs11
19 files changed, 81 insertions, 140 deletions
diff --git a/Backend.hs b/Backend.hs
index aec87ce66..6140664ce 100644
--- a/Backend.hs
+++ b/Backend.hs
@@ -76,10 +76,9 @@ list = do
{- Looks up a backend in a list. May fail if unknown. -}
lookupBackendName :: [Backend Annex] -> String -> Backend Annex
-lookupBackendName bs s =
- case maybeLookupBackendName bs s of
- Just b -> b
- Nothing -> error $ "unknown backend " ++ s
+lookupBackendName bs s = maybe unknown id $ maybeLookupBackendName bs s
+ where
+ unknown = error $ "unknown backend " ++ s
maybeLookupBackendName :: [Backend Annex] -> String -> Maybe (Backend Annex)
maybeLookupBackendName bs s =
if 1 /= length matches
@@ -91,23 +90,18 @@ maybeLookupBackendName bs s =
storeFileKey :: FilePath -> Maybe (Backend Annex) -> Annex (Maybe (Key, Backend Annex))
storeFileKey file trybackend = do
bs <- list
- let bs' = case trybackend of
- Nothing -> bs
- Just backend -> backend:bs
+ let bs' = maybe bs (:bs) trybackend
storeFileKey' bs' file
storeFileKey' :: [Backend Annex] -> FilePath -> Annex (Maybe (Key, Backend Annex))
storeFileKey' [] _ = return Nothing
-storeFileKey' (b:bs) file = do
- result <- (B.getKey b) file
- case result of
- Nothing -> nextbackend
- Just key -> do
+storeFileKey' (b:bs) file = maybe nextbackend store =<< (B.getKey b) file
+ where
+ nextbackend = storeFileKey' bs file
+ store key = do
stored <- (B.storeFileKey b) file key
if (not stored)
then nextbackend
else return $ Just (key, b)
- where
- nextbackend = storeFileKey' bs file
{- Attempts to retrieve an key from one of the backends, saving it to
- a specified location. -}
@@ -148,11 +142,8 @@ lookupFile file = do
getsymlink = do
l <- readSymbolicLink file
return $ takeFileName l
- makekey bs l =
- case fileKey l of
- Just k -> makeret k l bs
- Nothing -> return Nothing
- makeret k l bs =
+ makekey bs l = maybe (return Nothing) (makeret bs l) (fileKey l)
+ makeret bs l k =
case maybeLookupBackendName bs bname of
Just backend -> return $ Just (k, backend)
Nothing -> do
diff --git a/Base64.hs b/Base64.hs
index cc6346b41..153049751 100644
--- a/Base64.hs
+++ b/Base64.hs
@@ -14,7 +14,5 @@ toB64 :: String -> String
toB64 = encode . s2w8
fromB64 :: String -> String
-fromB64 s =
- case decode s of
- Nothing -> error "bad base64 encoded data"
- Just ws -> w82s ws
+fromB64 s = maybe bad w82s $ decode s
+ where bad = error "bad base64 encoded data"
diff --git a/Command.hs b/Command.hs
index 0e3958c18..c6c1fe5c5 100644
--- a/Command.hs
+++ b/Command.hs
@@ -14,6 +14,7 @@ import Control.Monad (filterM, liftM, when)
import System.Path.WildMatch
import Text.Regex.PCRE.Light.Char8
import Data.List
+import Data.Maybe
import Types
import qualified Backend
@@ -106,18 +107,10 @@ doCommand start = do
return c
notAnnexed :: FilePath -> Annex (Maybe a) -> Annex (Maybe a)
-notAnnexed file a = do
- r <- Backend.lookupFile file
- case r of
- Just _ -> return Nothing
- Nothing -> a
+notAnnexed file a = maybe a (const $ return Nothing) =<< Backend.lookupFile file
isAnnexed :: FilePath -> ((Key, Backend Annex) -> Annex (Maybe a)) -> Annex (Maybe a)
-isAnnexed file a = do
- r <- Backend.lookupFile file
- case r of
- Just v -> a v
- Nothing -> return Nothing
+isAnnexed file a = maybe (return Nothing) a =<< Backend.lookupFile file
notBareRepo :: Annex a -> Annex a
notBareRepo a = do
@@ -183,9 +176,7 @@ withFilesUnlocked' typechanged a params = do
withKeys :: CommandSeekKeys
withKeys a params = return $ map a $ map parse params
where
- parse p = case readKey p of
- Just k -> k
- Nothing -> error "bad key"
+ parse p = maybe (error "bad key") id $ readKey p
withTempFile :: CommandSeekStrings
withTempFile a params = return $ map a params
withNothing :: CommandSeekNothing
@@ -206,9 +197,7 @@ filterFiles l = do
else return $ filter (notExcluded $ wildsRegex exclude) l'
where
notState f = not $ stateDir `isPrefixOf` f
- notExcluded r f = case match r f [] of
- Nothing -> True
- Just _ -> False
+ notExcluded r f = isJust $ match r f []
wildsRegex :: [String] -> Regex
wildsRegex ws = compile regex []
@@ -257,11 +246,10 @@ cmdlineKey = do
case k of
Nothing -> nokey
Just "" -> nokey
- Just kstring -> case readKey kstring of
- Nothing -> error "bad key"
- Just key -> return key
+ Just kstring -> maybe badkey return $ readKey kstring
where
nokey = error "please specify the key with --key"
+ badkey = error "bad key"
{- Given an original list of files, and an expanded list derived from it,
- ensures that the original list's ordering is preserved.
diff --git a/Command/DropUnused.hs b/Command/DropUnused.hs
index 861c78c90..965a99ed5 100644
--- a/Command/DropUnused.hs
+++ b/Command/DropUnused.hs
@@ -58,14 +58,13 @@ start (unused, unusedbad, unusedtmp) s = notBareRepo $ search
next $ a key
perform :: Key -> CommandPerform
-perform key = do
- from <- Annex.getState Annex.fromremote
- case from of
- Just name -> do
+perform key = maybe droplocal dropremote =<< Annex.getState Annex.fromremote
+ where
+ dropremote name = do
r <- Remote.byName name
showNote $ "from " ++ Remote.name r ++ "..."
next $ Command.Move.fromCleanup r True key
- _ -> do
+ droplocal = do
backend <- keyBackend key
Command.Drop.perform key backend (Just 0) -- force drop
diff --git a/Command/InitRemote.hs b/Command/InitRemote.hs
index eda50ee5d..261ccdc8b 100644
--- a/Command/InitRemote.hs
+++ b/Command/InitRemote.hs
@@ -68,11 +68,11 @@ cleanup u c = do
findByName :: String -> Annex (UUID, RemoteClass.RemoteConfig)
findByName name = do
m <- Remote.readRemoteLog
- case findByName' name m of
- Just i -> return i
- Nothing -> do
+ maybe generate return $ findByName' name m
+ where
+ generate = do
uuid <- liftIO $ genUUID
- return $ (uuid, M.insert nameKey name M.empty)
+ return (uuid, M.insert nameKey name M.empty)
findByName' :: String -> M.Map UUID RemoteClass.RemoteConfig -> Maybe (UUID, RemoteClass.RemoteConfig)
findByName' n m = if null matches then Nothing else Just $ head matches
@@ -86,12 +86,13 @@ findByName' n m = if null matches then Nothing else Just $ head matches
{- find the specified remote type -}
findType :: RemoteClass.RemoteConfig -> Annex (RemoteClass.RemoteType Annex)
-findType config =
- case M.lookup typeKey config of
- Nothing -> error "Specify the type of remote with type="
- Just s -> case filter (\i -> RemoteClass.typename i == s) Remote.remoteTypes of
+findType config = maybe unspecified specified $ M.lookup typeKey config
+ where
+ unspecified = error "Specify the type of remote with type="
+ specified s = case filter (findtype s) Remote.remoteTypes of
[] -> error $ "Unknown remote type " ++ s
(t:_) -> return t
+ findtype s i = RemoteClass.typename i == s
{- The name of a configured remote is stored in its config using this key. -}
nameKey :: String
diff --git a/Command/Map.hs b/Command/Map.hs
index 3c94fc75b..7a9121b69 100644
--- a/Command/Map.hs
+++ b/Command/Map.hs
@@ -84,10 +84,7 @@ repoName umap r
| otherwise = M.findWithDefault fallback repouuid umap
where
repouuid = getUncachedUUID r
- fallback =
- case (Git.repoRemoteName r) of
- Just n -> n
- Nothing -> "unknown"
+ fallback = maybe "unknown" id $ Git.repoRemoteName r
{- A unique id for the node for a repo. Uses the annex.uuid if available. -}
nodeId :: Git.Repo -> String
@@ -121,13 +118,10 @@ edge umap fullinfo from to =
{- Only name an edge if the name is different than the name
- that will be used for the destination node, and is
- different from its hostname. (This reduces visual clutter.) -}
- edgename =
- case (Git.repoRemoteName to) of
- Nothing -> Nothing
- Just n ->
- if (n == repoName umap fullto || n == hostname fullto)
- then Nothing
- else Just n
+ edgename = maybe Nothing calcname $ Git.repoRemoteName to
+ calcname n
+ | n == repoName umap fullto || n == hostname fullto = Nothing
+ | otherwise = Just n
unreachable :: String -> String
unreachable = Dot.fillColor "red"
diff --git a/Command/Unused.hs b/Command/Unused.hs
index 7570dfe90..a2e1c86de 100644
--- a/Command/Unused.hs
+++ b/Command/Unused.hs
@@ -41,12 +41,7 @@ start = notBareRepo $ do
perform :: CommandPerform
perform = do
- from <- Annex.getState Annex.fromremote
- case from of
- Just name -> do
- r <- Remote.byName name
- checkRemoteUnused r
- _ -> checkUnused
+ maybe checkUnused checkRemoteUnused =<< Annex.getState Annex.fromremote
next $ return True
checkUnused :: Annex ()
@@ -63,8 +58,11 @@ checkUnused = do
writeUnusedFile file unusedlist
return $ length l
-checkRemoteUnused :: Remote.Remote Annex -> Annex ()
-checkRemoteUnused r = do
+checkRemoteUnused :: String -> Annex ()
+checkRemoteUnused name = checkRemoteUnused' =<< Remote.byName name
+
+checkRemoteUnused' :: Remote.Remote Annex -> Annex ()
+checkRemoteUnused' r = do
g <- Annex.gitRepo
showNote $ "checking for unused data on " ++ Remote.name r ++ "..."
referenced <- getKeysReferenced
diff --git a/Content.hs b/Content.hs
index ade936da3..9040383be 100644
--- a/Content.hs
+++ b/Content.hs
@@ -57,11 +57,11 @@ calcGitLink :: FilePath -> Key -> Annex FilePath
calcGitLink file key = do
g <- Annex.gitRepo
cwd <- liftIO $ getCurrentDirectory
- let absfile = case absNormPath cwd file of
- Just f -> f
- Nothing -> error $ "unable to normalize " ++ file
+ let absfile = maybe whoops id $ absNormPath cwd file
return $ relPathDirToFile (parentDir absfile)
(Git.workTree g) </> ".git" </> annexLocation key
+ where
+ whoops = error $ "unable to normalize " ++ file
{- Updates the LocationLog when a key's presence changes in the current
- repository.
@@ -148,9 +148,7 @@ checkDiskSpace' :: Integer -> Key -> Annex ()
checkDiskSpace' adjustment key = do
g <- Annex.gitRepo
r <- getConfig g "diskreserve" ""
- let reserve = case readSize dataUnits r of
- Nothing -> megabyte
- Just v -> v
+ let reserve = maybe megabyte id $ readSize dataUnits r
stats <- liftIO $ getFileSystemStats (gitAnnexDir g)
case (stats, keySize key) of
(Nothing, _) -> return ()
diff --git a/Crypto.hs b/Crypto.hs
index 53cd48dd5..42f138950 100644
--- a/Crypto.hs
+++ b/Crypto.hs
@@ -238,10 +238,8 @@ configKeyIds c = do
keyIdField s = (split ":" s) !! 4
configGet :: RemoteConfig -> String -> String
-configGet c key =
- case M.lookup key c of
- Just v -> v
- Nothing -> error $ "missing " ++ key ++ " in remote config"
+configGet c key = maybe missing id $ M.lookup key c
+ where missing = error $ "missing " ++ key ++ " in remote config"
hmacWithCipher :: Cipher -> String -> String
hmacWithCipher c = hmacWithCipher' (cipherHmac c)
diff --git a/Dot.hs b/Dot.hs
index 592b21f69..deba10201 100644
--- a/Dot.hs
+++ b/Dot.hs
@@ -20,10 +20,7 @@ graphNode nodeid desc = label desc $ quote nodeid
{- an edge between two nodes -}
graphEdge :: String -> String -> Maybe String -> String
-graphEdge fromid toid desc = indent $
- case desc of
- Nothing -> edge
- Just d -> label d edge
+graphEdge fromid toid desc = indent $ maybe edge (\d -> label d edge) desc
where
edge = quote fromid ++ " -> " ++ quote toid
diff --git a/GitRepo.hs b/GitRepo.hs
index 49024abe0..b20ff7db3 100644
--- a/GitRepo.hs
+++ b/GitRepo.hs
@@ -122,9 +122,8 @@ repoFromUrl url
| startswith "file://" url = repoFromAbsPath $ uriPath u
| otherwise = return $ newFrom $ Url u
where
- u = case (parseURI url) of
- Just v -> v
- Nothing -> error $ "bad url " ++ url
+ u = maybe bad id $ parseURI url
+ bad = error $ "bad url " ++ url
{- Creates a repo that has an unknown location. -}
repoFromUnknown :: Repo
@@ -264,9 +263,7 @@ workTreeFile repo@(Repo { location = Dir d }) file = do
absrepo = case (absNormPath "/" d) of
Just f -> addTrailingPathSeparator f
Nothing -> error $ "bad repo" ++ repoDescribe repo
- absfile c = case (secureAbsNormPath c file) of
- Just f -> f
- Nothing -> file
+ absfile c = maybe file id $ secureAbsNormPath c file
inrepo f = absrepo `isPrefixOf` f
workTreeFile repo _ = assertLocal repo $ error "internal"
@@ -352,9 +349,7 @@ reap :: IO ()
reap = do
-- throws an exception when there are no child processes
r <- catch (getAnyProcessStatus False True) (\_ -> return Nothing)
- case r of
- Nothing -> return ()
- Just _ -> reap
+ maybe (return ()) (const reap) r
{- Scans for files that are checked into git at the specified locations. -}
inRepo :: Repo -> [FilePath] -> IO [FilePath]
diff --git a/LocationLog.hs b/LocationLog.hs
index e0ccb642b..6759b47fe 100644
--- a/LocationLog.hs
+++ b/LocationLog.hs
@@ -71,9 +71,7 @@ instance Read LogLine where
-- Such lines have a status of Undefined.
readsPrec _ string =
if length w == 3
- then case pdate of
- Just v -> good v
- Nothing -> bad
+ then maybe bad good pdate
else bad
where
w = words string
diff --git a/Remote/Bup.hs b/Remote/Bup.hs
index 0aaff06b2..d2b771bf7 100644
--- a/Remote/Bup.hs
+++ b/Remote/Bup.hs
@@ -68,9 +68,8 @@ gen r u c = do
bupSetup :: UUID -> RemoteConfig -> Annex RemoteConfig
bupSetup u c = do
-- verify configuration is sane
- let buprepo = case M.lookup "buprepo" c of
- Nothing -> error "Specify buprepo="
- Just r -> r
+ let buprepo = maybe (error "Specify buprepo=") id $
+ M.lookup "buprepo" c
c' <- encryptionSetup c
-- bup init will create the repository.
diff --git a/Remote/Directory.hs b/Remote/Directory.hs
index c680d6121..0cd3760d6 100644
--- a/Remote/Directory.hs
+++ b/Remote/Directory.hs
@@ -60,9 +60,8 @@ gen r u c = do
directorySetup :: UUID -> RemoteConfig -> Annex RemoteConfig
directorySetup u c = do
-- verify configuration is sane
- let dir = case M.lookup "directory" c of
- Nothing -> error "Specify directory="
- Just d -> d
+ let dir = maybe (error "Specify directory=") id $
+ M.lookup "directory" c
e <- liftIO $ doesDirectoryExist dir
when (not e) $ error $ "Directory does not exist: " ++ dir
c' <- encryptionSetup c
diff --git a/Remote/Encryptable.hs b/Remote/Encryptable.hs
index 31ef1f37a..f9b388c8a 100644
--- a/Remote/Encryptable.hs
+++ b/Remote/Encryptable.hs
@@ -73,11 +73,10 @@ encryptableRemote c storeKeyEncrypted retrieveKeyFileEncrypted r =
{- Gets encryption Cipher. The decrypted Cipher is cached in the Annex
- state. -}
remoteCipher :: RemoteConfig -> Annex (Maybe Cipher)
-remoteCipher c = do
- cache <- Annex.getState Annex.cipher
- case cache of
- Just cipher -> return $ Just cipher
- Nothing -> case extractCipher c of
+remoteCipher c = maybe expensive cached =<< Annex.getState Annex.cipher
+ where
+ cached cipher = return $ Just cipher
+ expensive = case extractCipher c of
Nothing -> return Nothing
Just encipher -> do
showNote "gpg"
diff --git a/Remote/Hook.hs b/Remote/Hook.hs
index ba38355ca..7f2d5dbee 100644
--- a/Remote/Hook.hs
+++ b/Remote/Hook.hs
@@ -61,9 +61,8 @@ gen r u c = do
hookSetup :: UUID -> RemoteConfig -> Annex RemoteConfig
hookSetup u c = do
- let hooktype = case M.lookup "hooktype" c of
- Nothing -> error "Specify hooktype="
- Just r -> r
+ let hooktype = maybe (error "Specify hooktype=") id $
+ M.lookup "hooktype" c
c' <- encryptionSetup c
gitConfigSpecialRemote u c' "hooktype" hooktype
return c'
@@ -94,14 +93,12 @@ lookupHook hooktype hook =do
hookname = hooktype ++ "-" ++ hook ++ "-hook"
runHook :: String -> String -> Key -> Maybe FilePath -> Annex Bool -> Annex Bool
-runHook hooktype hook k f a = do
- command <- lookupHook hooktype hook
- case command of
- Nothing -> return False
- Just c -> do
+runHook hooktype hook k f a = maybe (return False) run =<< lookupHook hooktype hook
+ where
+ run command = do
showProgress -- make way for hook output
res <- liftIO $ boolSystemEnv
- "sh" [Param "-c", Param c] $ hookEnv k f
+ "sh" [Param "-c", Param command] $ hookEnv k f
if res
then a
else do
diff --git a/Remote/Rsync.hs b/Remote/Rsync.hs
index 682c96174..c15ab37a7 100644
--- a/Remote/Rsync.hs
+++ b/Remote/Rsync.hs
@@ -82,9 +82,8 @@ genRsyncOpts r = do
rsyncSetup :: UUID -> RemoteConfig -> Annex RemoteConfig
rsyncSetup u c = do
-- verify configuration is sane
- let url = case M.lookup "rsyncurl" c of
- Nothing -> error "Specify rsyncurl="
- Just d -> d
+ let url = maybe (error "Specify rsyncurl=") id $
+ M.lookup "rsyncurl" c
c' <- encryptionSetup c
-- The rsyncurl is stored in git config, not only in this remote's
diff --git a/Remote/S3real.hs b/Remote/S3real.hs
index b0371eb5e..eaa6590b1 100644
--- a/Remote/S3real.hs
+++ b/Remote/S3real.hs
@@ -123,11 +123,7 @@ storeHelper (conn, bucket) r k file = do
content <- liftIO $ L.readFile file
-- size is provided to S3 so the whole content does not need to be
-- buffered to calculate it
- size <- case keySize k of
- Just s -> return $ fromIntegral s
- Nothing -> do
- s <- liftIO $ getFileStatus file
- return $ fileSize s
+ size <- maybe getsize (return . fromIntegral) $ keySize k
let object = setStorageClass storageclass $
S3Object bucket (show k) ""
[("Content-Length",(show size))] content
@@ -137,6 +133,9 @@ storeHelper (conn, bucket) r k file = do
case fromJust $ M.lookup "storageclass" $ fromJust $ config r of
"REDUCED_REDUNDANCY" -> REDUCED_REDUNDANCY
_ -> STANDARD
+ getsize = do
+ s <- liftIO $ getFileStatus file
+ return $ fileSize s
retrieve :: Remote Annex -> Key -> FilePath -> Annex Bool
retrieve r k f = s3Action r False $ \(conn, bucket) -> do
@@ -201,11 +200,8 @@ bucketKey :: String -> Key -> S3Object
bucketKey bucket k = S3Object bucket (show k) "" [] L.empty
s3ConnectionRequired :: RemoteConfig -> Annex AWSConnection
-s3ConnectionRequired c = do
- conn <- s3Connection c
- case conn of
- Nothing -> error "Cannot connect to S3"
- Just conn' -> return conn'
+s3ConnectionRequired c =
+ maybe (error "Cannot connect to S3") return =<< s3Connection c
s3Connection :: RemoteConfig -> Annex (Maybe AWSConnection)
s3Connection c = do
diff --git a/Utility.hs b/Utility.hs
index 0dab37104..44c8cdd65 100644
--- a/Utility.hs
+++ b/Utility.hs
@@ -165,9 +165,7 @@ prop_parentDir_basics dir
dirContains :: FilePath -> FilePath -> Bool
dirContains a b = a == b || a' == b' || (a'++"/") `isPrefixOf` b'
where
- norm p = case (absNormPath p ".") of
- Just r -> r
- Nothing -> ""
+ norm p = maybe "" id $ absNormPath p "."
a' = norm a
b' = norm b
@@ -180,10 +178,9 @@ absPath file = do
{- Converts a filename into a normalized, absolute path
- from the specified cwd. -}
absPathFrom :: FilePath -> FilePath -> FilePath
-absPathFrom cwd file =
- case absNormPath cwd file of
- Just f -> f
- Nothing -> error $ "unable to normalize " ++ file
+absPathFrom cwd file = maybe bad id $ absNormPath cwd file
+ where
+ bad = error $ "unable to normalize " ++ file
{- Constructs a relative path from the CWD to a file.
-