diff --git a/Language/Haskell/GhcMod.hs b/Language/Haskell/GhcMod.hs index 516ffa2..c4386a1 100644 --- a/Language/Haskell/GhcMod.hs +++ b/Language/Haskell/GhcMod.hs @@ -3,6 +3,7 @@ module Language.Haskell.GhcMod ( -- * Cradle Cradle(..) + , ProjectType(..) , findCradle -- * Options , Options(..) diff --git a/Language/Haskell/GhcMod/Cradle.hs b/Language/Haskell/GhcMod/Cradle.hs index 4a23fab..78e041d 100644 --- a/Language/Haskell/GhcMod/Cradle.hs +++ b/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 diff --git a/Language/Haskell/GhcMod/Debug.hs b/Language/Haskell/GhcMod/Debug.hs index fb5de2e..42abedb 100644 --- a/Language/Haskell/GhcMod/Debug.hs +++ b/Language/Haskell/GhcMod/Debug.hs @@ -26,9 +26,9 @@ debugInfo = do Cradle {..} <- cradle cabal <- - case cradleCabalFile of - Just _ -> cabalDebug - Nothing -> return [] + case cradleProjectType of + CabalProject -> cabalDebug + _ -> return [] pkgOpts <- packageGhcOptions diff --git a/Language/Haskell/GhcMod/GhcPkg.hs b/Language/Haskell/GhcMod/GhcPkg.hs index f5ca4b0..2908c82 100644 --- a/Language/Haskell/GhcMod/GhcPkg.hs +++ b/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 - then do - getPackageDbStack - else do - mdb <- liftIO $ getSandboxDb $ cradleRootDir crdl - return $ case mdb of - Just db -> [db] - Nothing -> [GlobalDb, UserDb] + pkgDbStack <- case cradleProjectType crdl of + PlainProject -> + return [GlobalDb, UserDb] + SandboxProject -> do + Just db <- liftIO $ getSandboxDb $ cradleRootDir crdl + return $ [GlobalDb, db] + CabalProject -> + getPackageDbStack catMaybes <$> (liftIO . resolvePackageConfig sysPkgCfg) `mapM` pkgDbStack diff --git a/Language/Haskell/GhcMod/Target.hs b/Language/Haskell/GhcMod/Target.hs index a51e906..2b9379d 100644 --- a/Language/Haskell/GhcMod/Target.hs +++ b/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 - Just _ -> cabalOpts crdl - Nothing -> sandboxOpts crdl + case cradleProjectType crdl of + CabalProject -> cabalOpts 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 - Just _ -> getGhcMergedPkgOptions - Nothing -> sandboxOpts crdl + case cradleProjectType crdl of + CabalProject -> getGhcMergedPkgOptions + _ -> sandboxOpts crdl +-- also works for plain projects! sandboxOpts :: MonadIO m => Cradle -> m [String] sandboxOpts crdl = do pkgDbStack <- liftIO $ getSandboxPackageDbStack $ cradleRootDir crdl diff --git a/Language/Haskell/GhcMod/Types.hs b/Language/Haskell/GhcMod/Types.hs index 02532a2..9156425 100644 --- a/Language/Haskell/GhcMod/Types.hs +++ b/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 diff --git a/src/GHCMod.hs b/src/GHCMod.hs index 2f11b9f..a81f938 100644 --- a/src/GHCMod.hs +++ b/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