Removing the anti-pattern: IO (Maybe a).

This commit is contained in:
Kazu Yamamoto 2012-02-14 18:37:45 +09:00
parent 13013445e3
commit 1b1245577e

View File

@ -6,32 +6,31 @@ module CabalDev (modifyOptions) where
-} -}
import Control.Applicative ((<$>)) import Control.Applicative ((<$>))
import Control.Exception (SomeException, throwIO)
import Data.List (find) import Data.List (find)
import System.FilePath (splitPath,joinPath,(</>)) import GHC (gcatch)
import System.Directory import System.Directory
import System.FilePath (splitPath,joinPath,(</>))
import Text.Regex.Posix ((=~)) import Text.Regex.Posix ((=~))
import Types import Types
modifyOptions :: Options -> IO Options modifyOptions :: Options -> IO Options
modifyOptions opts = modifyOptions opts = found `gcatch` notFound
fmap (has_cdev opts) findCabalDev
where where
has_cdev :: Options -> Maybe String -> Options found = addPath opts <$> findCabalDev
has_cdev op Nothing = op notFound :: SomeException -> IO Options
has_cdev op (Just path) = addPath op path notFound _ = return opts
findCabalDev :: IO (Maybe String) findCabalDev :: IO String
findCabalDev = findCabalDev = getCurrentDirectory >>= searchIt . splitPath
getCurrentDirectory >>= searchIt . splitPath
addPath :: Options -> String -> Options addPath :: Options -> String -> Options
addPath orig_opts path = do addPath orig_opts path = do
let orig_ghcopt = ghcOpts orig_opts let orig_ghcopt = ghcOpts orig_opts
orig_opts { ghcOpts = orig_ghcopt ++ ["-package-conf", path] } orig_opts { ghcOpts = orig_ghcopt ++ ["-package-conf", path] }
searchIt :: [FilePath] -> IO (Maybe FilePath) searchIt :: [FilePath] -> IO FilePath
searchIt [] = return Nothing searchIt [] = throwIO $ userError "Not found"
searchIt path = do searchIt path = do
a <- doesDirectoryExist (mpath path) a <- doesDirectoryExist (mpath path)
if a then if a then
@ -41,7 +40,7 @@ searchIt path = do
where where
mpath a = joinPath a </> "cabal-dev/" mpath a = joinPath a </> "cabal-dev/"
findConf :: FilePath -> IO (Maybe FilePath) findConf :: FilePath -> IO FilePath
findConf path = do findConf path = do
f <- find (=~ "packages.*\\.conf") <$> getDirectoryContents path Just f <- find (=~ "packages.*\\.conf") <$> getDirectoryContents path
return ((path </>) <$> f) return $ path </> f