Refactoring World, etc. and fix #387

Language/Haskell/GhcMod/Cradle.hs

@@ -5,16 +5,14 @@ module Language.Haskell.GhcMod.Cradle (
   , cleanupCradle
   ) where
 
-import Language.Haskell.GhcMod.Types
 import Language.Haskell.GhcMod.GhcPkg
+import Language.Haskell.GhcMod.PathsAndFiles
+import Language.Haskell.GhcMod.Types
 
-import Control.Applicative ((<$>))
-import qualified Control.Exception as E
 import Control.Exception.IOChoice ((||>))
-import Control.Monad (filterM)
-import Data.List (isSuffixOf)
-import System.Directory (getCurrentDirectory, getDirectoryContents, doesFileExist, getTemporaryDirectory, removeDirectoryRecursive)
-import System.FilePath ((</>),takeDirectory,pathSeparators,splitDrive)
+import System.Directory (getCurrentDirectory, removeDirectoryRecursive,
+                         getTemporaryDirectory)
+import System.FilePath (takeDirectory,pathSeparators,splitDrive)
 import System.IO.Temp
 
 
@@ -44,25 +42,26 @@ cleanupCradle crdl = removeDirectoryRecursive $ cradleTempDir crdl
 
 cabalCradle :: FilePath -> IO Cradle
 cabalCradle wdir = do
-    (rdir,cfile) <- cabalDir wdir
-    pkgDbStack <- getPackageDbStack rdir
-    tmpDir <- newTempDir rdir
+    Just cabalFile <- findCabalFiles wdir
+    let cabalDir = takeDirectory cabalFile
+    pkgDbStack <- getPackageDbStack cabalDir
+    tmpDir <- newTempDir cabalDir
     return Cradle {
         cradleCurrentDir = wdir
-      , cradleRootDir    = rdir
+      , cradleRootDir    = cabalDir
       , cradleTempDir    = tmpDir
-      , cradleCabalFile  = Just cfile
+      , cradleCabalFile  = Just cabalFile
       , cradlePkgDbStack = pkgDbStack
       }
 
 sandboxCradle :: FilePath -> IO Cradle
 sandboxCradle wdir = do
-    rdir <- getSandboxDir wdir
-    pkgDbStack <- getPackageDbStack rdir
-    tmpDir <- newTempDir rdir
+    Just sbDir <- getSandboxDb wdir
+    pkgDbStack <- getPackageDbStack sbDir
+    tmpDir <- newTempDir sbDir
     return Cradle {
         cradleCurrentDir = wdir
-      , cradleRootDir    = rdir
+      , cradleRootDir    = sbDir
       , cradleTempDir    = tmpDir
       , cradleCabalFile  = Nothing
       , cradlePkgDbStack = pkgDbStack
@@ -84,48 +83,3 @@ findCradleWithoutSandbox :: IO Cradle
 findCradleWithoutSandbox = do
     cradle <- findCradle
     return cradle { cradlePkgDbStack = [GlobalDb]} -- FIXME
-
-----------------------------------------------------------------
-
-cabalSuffix :: String
-cabalSuffix = ".cabal"
-
-cabalSuffixLength :: Int
-cabalSuffixLength = length cabalSuffix
-
--- Finding a Cabal file up to the root directory
--- Input: a directly to investigate
--- Output: (the path to the directory containing a Cabal file
---         ,the path to the Cabal file)
-cabalDir :: FilePath -> IO (FilePath,FilePath)
-cabalDir dir = do
-    cnts <- getCabalFiles dir
-    case cnts of
-        [] | dir' == dir -> E.throwIO $ userError "cabal files not found"
-           | otherwise   -> cabalDir dir'
-        cfile:_          -> return (dir,dir </> cfile)
-  where
-    dir' = takeDirectory dir
-
-getCabalFiles :: FilePath -> IO [FilePath]
-getCabalFiles dir = getFiles >>= filterM doesCabalFileExist
-  where
-    isCabal name = cabalSuffix `isSuffixOf` name
-                && length name > cabalSuffixLength
-    getFiles = filter isCabal <$> getDirectoryContents dir
-    doesCabalFileExist file = doesFileExist $ dir </> file
-
-----------------------------------------------------------------
-
-getSandboxDir :: FilePath -> IO FilePath
-getSandboxDir dir = do
-    exist <- doesFileExist sfile
-    if exist then
-        return dir
-      else if dir == dir' then
-        E.throwIO $ userError "sandbox not found"
-      else
-        getSandboxDir dir'
-  where
-    sfile = dir </> "cabal.sandbox.config"
-    dir' = takeDirectory dir