ghc-mod/Language/Haskell/GhcMod/CabalHelper.hs

137 lines
5.1 KiB
Haskell
Raw Normal View History

-- ghc-mod: Making Haskell development *more* fun
-- Copyright (C) 2015 Daniel Gröber <dxld ÄT darkboxed DOT org>
--
-- This program is free software: you can redistribute it and/or modify
-- it under the terms of the GNU Affero General Public License as published by
-- the Free Software Foundation, either version 3 of the License, or
-- (at your option) any later version.
--
-- This program is distributed in the hope that it will be useful,
-- but WITHOUT ANY WARRANTY; without even the implied warranty of
-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-- GNU Affero General Public License for more details.
--
-- You should have received a copy of the GNU Affero General Public License
-- along with this program. If not, see <http://www.gnu.org/licenses/>.
2015-03-28 01:33:42 +00:00
{-# LANGUAGE CPP #-}
module Language.Haskell.GhcMod.CabalHelper (
2015-03-15 19:48:55 +00:00
getComponents
, getGhcMergedPkgOptions
) where
import Control.Applicative
import Control.Monad
import Data.Monoid
import Data.Version
2015-06-07 01:36:50 +00:00
import Data.Serialize (Serialize)
2015-03-15 19:48:55 +00:00
import Distribution.Helper
import qualified Language.Haskell.GhcMod.Types as T
import Language.Haskell.GhcMod.Types hiding (ghcProgram, ghcPkgProgram,
cabalProgram)
import Language.Haskell.GhcMod.Monad.Types
import Language.Haskell.GhcMod.Utils
import Language.Haskell.GhcMod.World
import Language.Haskell.GhcMod.PathsAndFiles
import System.FilePath
2015-08-03 01:09:56 +00:00
import Prelude
2015-03-28 01:33:42 +00:00
import Paths_ghc_mod as GhcMod
-- | Only package related GHC options, sufficient for things that don't need to
-- access home modules
getGhcMergedPkgOptions :: (Applicative m, MonadIO m, GmEnv m, GmLog m)
=> m [GHCOption]
getGhcMergedPkgOptions = chCached Cached {
cacheFile = mergedPkgOptsCacheFile,
cachedAction = \ _ (progs, root, _) _ -> do
opts <- withCabal $ runQuery' progs root $ ghcMergedPkgOptions
return ([setupConfigPath], opts)
}
2015-03-15 19:48:55 +00:00
helperProgs :: Options -> Programs
helperProgs opts = Programs {
cabalProgram = T.cabalProgram opts,
ghcProgram = T.ghcProgram opts,
ghcPkgProgram = T.ghcPkgProgram opts
}
-- | Primary interface to cabal-helper and intended single entrypoint to
-- constructing 'GmComponent's
--
-- The Component\'s 'gmcHomeModuleGraph' will be empty and has to be resolved by
-- 'resolveGmComponents'.
getComponents :: (Applicative m, MonadIO m, GmEnv m, GmLog m)
2015-08-03 01:09:56 +00:00
=> m [GmComponent 'GMCRaw ChEntrypoint]
getComponents = chCached cabalHelperCache
2015-06-07 01:36:50 +00:00
chCached :: (Applicative m, MonadIO m, GmEnv m, GmLog m, Serialize a)
=> Cached m (Programs, FilePath, (Version, [Char])) a -> m a
chCached c = do
root <- cradleRootDir <$> cradle
d <- cacheInputData root
withCabal $ cached root c d
where
cacheInputData root = do
opt <- options
return $ ( helperProgs opt
, root </> "dist"
, (gmVer, chVer)
)
gmVer = GhcMod.version
chVer = VERSION_cabal_helper
2015-03-15 19:48:55 +00:00
cabalHelperCache
:: (Functor m, Applicative m, MonadIO m)
2015-08-03 01:09:56 +00:00
=> Cached m (Programs, FilePath, (Version, String)) [GmComponent 'GMCRaw ChEntrypoint]
cabalHelperCache = Cached {
cacheFile = cabalHelperCacheFile,
2015-04-12 00:39:18 +00:00
cachedAction = \ _ (progs, root, _) _ ->
runQuery' progs root $ do
q <- join7
<$> ghcOptions
<*> ghcPkgOptions
<*> ghcSrcOptions
<*> ghcLangOptions
<*> entrypoints
<*> entrypoints
<*> sourceDirs
2015-05-05 12:44:42 +00:00
let cs = flip map q $ curry8 (GmComponent mempty)
return ([setupConfigPath], cs)
}
2015-03-15 19:48:55 +00:00
where
2015-05-05 12:44:42 +00:00
curry8 fn (a, (b, (c, (d, (e, (f, (g, h))))))) = fn a b c d e f g h
join7 a b c d e f = join' a . join' b . join' c . join' d . join' e . join' f
2015-03-15 19:48:55 +00:00
join' :: Eq a => [(a,b)] -> [(a,c)] -> [(a,(b,c))]
join' lb lc = [ (a, (b, c))
| (a, b) <- lb
2015-05-05 12:44:42 +00:00
, (a', c) <- lc
, a == a'
]
2015-03-28 01:33:42 +00:00
withCabal :: (MonadIO m, GmEnv m) => m a -> m a
withCabal action = do
crdl <- cradle
opts <- options
liftIO $ whenM (isSetupConfigOutOfDate <$> getCurrentWorld crdl) $
withDirectory_ (cradleRootDir crdl) $ do
let pkgDbArgs = "--package-db=clear" : map pkgDbArg (cradlePkgDbStack crdl)
2015-03-03 11:18:54 +00:00
progOpts =
2015-03-15 19:48:55 +00:00
[ "--with-ghc=" ++ T.ghcProgram opts ]
-- Only pass ghc-pkg if it was actually set otherwise we
-- might break cabal's guessing logic
2015-03-15 19:48:55 +00:00
++ if T.ghcPkgProgram opts /= T.ghcPkgProgram defaultOptions
then [ "--with-ghc-pkg=" ++ T.ghcPkgProgram opts ]
else []
2015-03-03 11:18:54 +00:00
++ pkgDbArgs
2015-03-15 19:48:55 +00:00
void $ readProcess (T.cabalProgram opts) ("configure":progOpts) ""
writeAutogenFiles $ cradleRootDir crdl </> "dist"
action
2015-03-03 11:18:54 +00:00
pkgDbArg :: GhcPkgDb -> String
pkgDbArg GlobalDb = "--package-db=global"
pkgDbArg UserDb = "--package-db=user"
pkgDbArg (PackageDb p) = "--package-db=" ++ p