Cleanup project type handling
This commit is contained in:
parent
a94d8977a9
commit
28f06e035d
@ -3,6 +3,7 @@
|
||||
module Language.Haskell.GhcMod (
|
||||
-- * Cradle
|
||||
Cradle(..)
|
||||
, ProjectType(..)
|
||||
, findCradle
|
||||
-- * Options
|
||||
, Options(..)
|
||||
|
@ -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
|
||||
|
@ -26,9 +26,9 @@ debugInfo = do
|
||||
Cradle {..} <- cradle
|
||||
|
||||
cabal <-
|
||||
case cradleCabalFile of
|
||||
Just _ -> cabalDebug
|
||||
Nothing -> return []
|
||||
case cradleProjectType of
|
||||
CabalProject -> cabalDebug
|
||||
_ -> return []
|
||||
|
||||
pkgOpts <- packageGhcOptions
|
||||
|
||||
|
@ -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
|
||||
|
||||
|
@ -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
|
||||
|
@ -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
|
||||
|
@ -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
|
||||
|
Loading…
Reference in New Issue
Block a user