Cleanup project type handling

Language/Haskell/GhcMod.hs

@@ -3,6 +3,7 @@
 module Language.Haskell.GhcMod (
   -- * Cradle
     Cradle(..)
+  , ProjectType(..)
   , findCradle
   -- * Options
   , Options(..)

Language/Haskell/GhcMod/Cradle.hs

@@ -29,7 +29,7 @@ findCradle = findCradle' =<< getCurrentDirectory
 
 findCradle' :: FilePath -> IO Cradle
 findCradle' dir = run $ do
-    (customCradle dir `mplus` cabalCradle dir `mplus`  sandboxCradle dir `mplus` plainCradle dir)
+    (cabalCradle dir `mplus`  sandboxCradle dir `mplus` plainCradle dir)
  where run a = fillTempDir =<< (fromJust <$> runMaybeT a)
 
 findSpecCradle :: FilePath -> IO Cradle
@@ -53,17 +53,6 @@ fillTempDir crdl = do
   tmpDir <- liftIO $ newTempDir (cradleRootDir crdl)
   return crdl { cradleTempDir = tmpDir }
 
-customCradle :: FilePath -> MaybeT IO Cradle
-customCradle wdir = do
-    cabalFile <- MaybeT $ findCabalFile wdir
-    let cabalDir = takeDirectory cabalFile
-    return Cradle {
-        cradleCurrentDir = wdir
-      , cradleRootDir    = cabalDir
-      , cradleTempDir    = error "tmpDir"
-      , cradleCabalFile  = Just cabalFile
-      }
-
 cabalCradle :: FilePath -> MaybeT IO Cradle
 cabalCradle wdir = do
     cabalFile <- MaybeT $ findCabalFile wdir
@@ -71,7 +60,8 @@ cabalCradle wdir = do
     let cabalDir = takeDirectory cabalFile
 
     return Cradle {
-        cradleCurrentDir = wdir
+        cradleProjectType = CabalProject
+      , cradleCurrentDir = wdir
       , cradleRootDir    = cabalDir
       , cradleTempDir    = error "tmpDir"
       , cradleCabalFile  = Just cabalFile
@@ -81,7 +71,8 @@ sandboxCradle :: FilePath -> MaybeT IO Cradle
 sandboxCradle wdir = do
     sbDir <- MaybeT $ findCabalSandboxDir wdir
     return Cradle {
-        cradleCurrentDir = wdir
+        cradleProjectType = SandboxProject
+      , cradleCurrentDir = wdir
       , cradleRootDir    = sbDir
       , cradleTempDir    = error "tmpDir"
       , cradleCabalFile  = Nothing
@@ -90,7 +81,8 @@ sandboxCradle wdir = do
 plainCradle :: FilePath -> MaybeT IO Cradle
 plainCradle wdir = do
     return $ Cradle {
-        cradleCurrentDir = wdir
+        cradleProjectType = PlainProject
+      , cradleCurrentDir = wdir
       , cradleRootDir    = wdir
       , cradleTempDir    = error "tmpDir"
       , cradleCabalFile  = Nothing

Language/Haskell/GhcMod/Debug.hs

@@ -26,9 +26,9 @@ debugInfo = do
     Cradle {..} <- cradle
 
     cabal <-
-        case cradleCabalFile of
+        case cradleProjectType of
-          Just _ -> cabalDebug
+          CabalProject -> cabalDebug
-          Nothing -> return []
+          _ -> return []
 
     pkgOpts <- packageGhcOptions
 

Language/Haskell/GhcMod/GhcPkg.hs

@@ -61,14 +61,14 @@ ghcDbOpt (PackageDb pkgDb)
 getPackageCachePaths :: IOish m => FilePath -> GhcModT m [FilePath]
 getPackageCachePaths sysPkgCfg = do
   crdl <- cradle
-  pkgDbStack <- if isJust $ cradleCabalFile crdl
+  pkgDbStack <- case cradleProjectType crdl of
-     then do
+    PlainProject ->
-       getPackageDbStack
+        return [GlobalDb, UserDb]
-     else do
+    SandboxProject -> do
-         mdb <- liftIO $ getSandboxDb $ cradleRootDir crdl
+        Just db <- liftIO $ getSandboxDb $ cradleRootDir crdl
-         return $ case mdb of
+        return $ [GlobalDb, db]
-           Just db -> [db]
+    CabalProject ->
-           Nothing -> [GlobalDb, UserDb]
+        getPackageDbStack
 
   catMaybes <$> (liftIO . resolvePackageConfig sysPkgCfg) `mapM` pkgDbStack
 

Language/Haskell/GhcMod/Target.hs

@@ -176,9 +176,9 @@ targetGhcOptions :: forall m. IOish m
 targetGhcOptions crdl sefnmn = do
     when (Set.null sefnmn) $ error "targetGhcOptions: no targets given"
 
-    case cradleCabalFile crdl of
+    case cradleProjectType crdl of
-      Just _ -> cabalOpts crdl
+      CabalProject -> cabalOpts crdl
-      Nothing -> sandboxOpts crdl
+      _ -> sandboxOpts crdl
  where
    zipMap f l = l `zip` (f `map` l)
 
@@ -288,10 +288,11 @@ packageGhcOptions :: (Applicative m, IOish m, GmEnv m, GmState m, GmLog m)
                   => m [GHCOption]
 packageGhcOptions = do
     crdl <- cradle
-    case cradleCabalFile crdl of
+    case cradleProjectType crdl of
-      Just _ -> getGhcMergedPkgOptions
+      CabalProject -> getGhcMergedPkgOptions
-      Nothing -> sandboxOpts crdl
+      _ -> sandboxOpts crdl
 
+-- also works for plain projects!
 sandboxOpts :: MonadIO m => Cradle -> m [String]
 sandboxOpts crdl = do
     pkgDbStack <- liftIO $ getSandboxPackageDbStack $ cradleRootDir crdl

Language/Haskell/GhcMod/Types.hs

@@ -109,10 +109,14 @@ defaultOptions = Options {
 
 ----------------------------------------------------------------
 
+data ProjectType = CabalProject | SandboxProject | PlainProject
+                 deriving (Eq, Show)
+
 -- | The environment where this library is used.
 data Cradle = Cradle {
+    cradleProjectType:: ProjectType
   -- | The directory where this library is executed.
-    cradleCurrentDir :: FilePath
+  , cradleCurrentDir :: FilePath
   -- | The project root directory.
   , cradleRootDir    :: FilePath
   -- | Per-Project temporary directory

src/GHCMod.hs

@@ -589,10 +589,9 @@ nukeCaches = do
   chdir <- liftIO $ (</> "cabal-helper") <$> getAppUserDataDirectory "ghc-mod"
   c <- cradle
 
-  when (isJust $ cradleCabalFile c) $ do
+  when (cradleProjectType c == CabalProject) $ do
     let root = cradleRootDir c
-    when (isJust $ cradleCabalFile c) $
+    liftIO $ (trySome . removeDirectoryRecursive) `mapM_` [chdir, root </> "dist"]
-      liftIO $ (trySome . removeDirectoryRecursive) `mapM_` [chdir, root </> "dist"]
 
 trySome :: IO a -> IO (Either SomeException a)
 trySome = try