diff options
author | Joey Hess <joey@kitenet.net> | 2011-05-15 02:49:43 -0400 |
---|---|---|
committer | Joey Hess <joey@kitenet.net> | 2011-05-15 03:38:08 -0400 |
commit | cad0e1c8b7eb21f8dceca8dd9fa3bc1d1aa7eabd (patch) | |
tree | b6be12dc1cc83a35ca7d89a862d85e6d71c38572 | |
parent | efa7f544050c0d5be6bc1b0fc0125278e475c213 (diff) |
simplified a bunch of Maybe handling
-rw-r--r-- | Backend.hs | 29 | ||||
-rw-r--r-- | Base64.hs | 6 | ||||
-rw-r--r-- | Command.hs | 26 | ||||
-rw-r--r-- | Command/DropUnused.hs | 9 | ||||
-rw-r--r-- | Command/InitRemote.hs | 17 | ||||
-rw-r--r-- | Command/Map.hs | 16 | ||||
-rw-r--r-- | Command/Unused.hs | 14 | ||||
-rw-r--r-- | Content.hs | 10 | ||||
-rw-r--r-- | Crypto.hs | 6 | ||||
-rw-r--r-- | Dot.hs | 5 | ||||
-rw-r--r-- | GitRepo.hs | 13 | ||||
-rw-r--r-- | LocationLog.hs | 4 | ||||
-rw-r--r-- | Remote/Bup.hs | 5 | ||||
-rw-r--r-- | Remote/Directory.hs | 5 | ||||
-rw-r--r-- | Remote/Encryptable.hs | 9 | ||||
-rw-r--r-- | Remote/Hook.hs | 15 | ||||
-rw-r--r-- | Remote/Rsync.hs | 5 | ||||
-rw-r--r-- | Remote/S3real.hs | 16 | ||||
-rw-r--r-- | Utility.hs | 11 |
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 @@ -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 () @@ -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) @@ -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. - |