Changing GHCMod as a library.

Language/Haskell/GhcMod/Cradle.hs

@@ -0,0 +1,73 @@
+module Language.Haskell.GhcMod.Cradle (findCradle) where
+
+import Control.Applicative ((<$>))
+import Control.Exception (throwIO)
+import Control.Monad
+import Data.List (isSuffixOf)
+import Language.Haskell.GhcMod.Types
+import System.Directory
+import System.FilePath ((</>),takeDirectory)
+
+-- An error would be thrown
+findCradle :: Maybe FilePath -> String -> IO Cradle
+findCradle (Just sbox) strver = do
+    pkgConf <- checkPackageConf sbox strver
+    wdir <- getCurrentDirectory
+    cfiles <- cabalDir wdir
+    return $ case cfiles of
+        Nothing -> Cradle {
+            cradleCurrentDir  = wdir
+          , cradleCabalDir    = Nothing
+          , cradleCabalFile   = Nothing
+          , cradlePackageConf = Just pkgConf
+          }
+        Just (cdir,cfile) -> Cradle {
+            cradleCurrentDir  = wdir
+          , cradleCabalDir    = Just cdir
+          , cradleCabalFile   = Just cfile
+          , cradlePackageConf = Just pkgConf
+          }
+findCradle Nothing strver = do
+    wdir <- getCurrentDirectory
+    cfiles <- cabalDir wdir
+    case cfiles of
+        Nothing -> return Cradle {
+            cradleCurrentDir  = wdir
+          , cradleCabalDir    = Nothing
+          , cradleCabalFile   = Nothing
+          , cradlePackageConf = Nothing
+          }
+        Just (cdir,cfile) -> do
+            let sbox = cdir </> "cabal-dev"
+                pkgConf = packageConfName sbox strver
+            exist <- doesDirectoryExist pkgConf
+            return Cradle {
+                cradleCurrentDir  = wdir
+              , cradleCabalDir    = Just cdir
+              , cradleCabalFile   = Just cfile
+              , cradlePackageConf = if exist then Just pkgConf else Nothing
+              }
+
+cabalDir :: FilePath -> IO (Maybe (FilePath,FilePath))
+cabalDir dir = do
+    cnts <- (filter isCabal <$> getDirectoryContents dir)
+            >>= filterM (\file -> doesFileExist (dir </> file))
+    let dir' = takeDirectory dir
+    case cnts of
+        [] | dir' == dir -> return Nothing
+           | otherwise   -> cabalDir dir'
+        cfile:_          -> return $ Just (dir,dir </> cfile)
+  where
+    isCabal name = ".cabal" `isSuffixOf` name && length name > 6
+
+packageConfName :: FilePath -> String -> FilePath
+packageConfName path ver = path </> "packages-" ++ ver ++ ".conf"
+
+checkPackageConf :: FilePath -> String -> IO FilePath
+checkPackageConf path ver = do
+    let conf = packageConfName path ver
+    exist <- doesDirectoryExist conf
+    if exist then
+        return conf
+      else
+        throwIO $ userError $ conf ++ " not found"