diff options
| -rw-r--r-- | CabalHelper/Common.hs | 16 | ||||
| -rw-r--r-- | CabalHelper/Main.hs | 23 | ||||
| -rw-r--r-- | Distribution/Helper.hs | 15 |
3 files changed, 41 insertions, 13 deletions
diff --git a/CabalHelper/Common.hs b/CabalHelper/Common.hs index 2e8ff6a..025380f 100644 --- a/CabalHelper/Common.hs +++ b/CabalHelper/Common.hs @@ -63,19 +63,17 @@ align n an str = let -- | @getCabalConfigHeader "dist/setup-config"@ returns the cabal version and -- compiler version -getCabalConfigHeader :: FilePath -> IO (Maybe (Version, Version)) +getCabalConfigHeader :: FilePath -> IO (Maybe (Version, (ByteString, Version))) getCabalConfigHeader file = bracket (openFile file ReadMode) hClose $ \h -> do parseHeader <$> BS.hGetLine h -parseHeader :: ByteString -> Maybe (Version, Version) +parseHeader :: ByteString -> Maybe (Version, (ByteString, Version)) parseHeader header = case BS8.words header of ["Saved", "package", "config", "for", _pkgId , "written", "by", cabalId, "using", compId] - -> liftM2 (,) (ver cabalId) (ver compId) + -> liftM2 (,) (snd <$> parsePkgId cabalId) (parsePkgId compId) _ -> Nothing - where - ver i = snd <$> parsePkgId i parsePkgId :: ByteString -> Maybe (ByteString, Version) parsePkgId bs = @@ -86,11 +84,11 @@ parsePkgId bs = parseVer :: String -> Version parseVer vers = runReadP parseVersion vers --- majorVer :: Version -> Version --- majorVer (Version b _) = Version (take 2 b) [] +majorVer :: Version -> Version +majorVer (Version b _) = Version (take 2 b) [] --- sameMajorVersion :: Version -> Version -> Bool --- sameMajorVersion a b = majorVer a == majorVer b +sameMajorVersionAs :: Version -> Version -> Bool +sameMajorVersionAs a b = majorVer a == majorVer b runReadP :: ReadP t -> String -> t runReadP p i = case filter ((=="") . snd) $ readP_to_S p i of diff --git a/CabalHelper/Main.hs b/CabalHelper/Main.hs index ef3447b..a09a634 100644 --- a/CabalHelper/Main.hs +++ b/CabalHelper/Main.hs @@ -92,6 +92,7 @@ usage = do ++" | ghc-options [--with-inplace]\n" ++" | ghc-src-options [--with-inplace]\n" ++" | ghc-pkg-options [--with-inplace]\n" + ++" | ghc-lang-options [--with-inplace]\n" ++" | entrypoints\n" ++" | source-dirs\n" ++" ) ...\n" @@ -103,6 +104,7 @@ commands = [ "print-bli" , "ghc-options" , "ghc-src-options" , "ghc-pkg-options" + , "ghc-lang-options" , "entrypoints" , "source-dirs"] @@ -178,7 +180,7 @@ main = do opts' = mempty { -- Not really needed but "unexpected package db stack: []" - ghcOptPackageDBs = [GlobalPackageDB], + ghcOptPackageDBs = [GlobalPackageDB, UserPackageDB], ghcOptCppOptions = ghcOptCppOptions opts, ghcOptCppIncludePath = ghcOptCppIncludePath opts, @@ -207,6 +209,25 @@ main = do in renderGhcOptions' lbi v $ opts' `mappend` adopts return $ Just $ ChResponseStrings (res ++ [(ChSetupHsName, [])]) + "ghc-lang-options":flags -> do + res <- componentsMap lbi v distdir $ \c clbi bi -> let + comp = compiler lbi + outdir = componentOutDir lbi c + (clbi', adopts) = case flags of + ["--with-inplace"] -> (clbi, mempty) + [] -> removeInplaceDeps v lbi pd clbi + opts = componentGhcOptions v lbi bi clbi' outdir + + opts' = mempty { + ghcOptPackageDBs = [GlobalPackageDB, UserPackageDB], + + ghcOptLanguage = ghcOptLanguage opts, + ghcOptExtensions = ghcOptExtensions opts, + ghcOptExtensionMap = ghcOptExtensionMap opts + } + in renderGhcOptions' lbi v $ opts' `mappend` adopts + return $ Just $ ChResponseStrings (res ++ [(ChSetupHsName, [])]) + "entrypoints":[] -> do eps <- componentsMap lbi v distdir $ \c clbi bi -> return $ componentEntrypoints c diff --git a/Distribution/Helper.hs b/Distribution/Helper.hs index 1a4bc37..6946465 100644 --- a/Distribution/Helper.hs +++ b/Distribution/Helper.hs @@ -32,6 +32,7 @@ module Distribution.Helper ( , ghcOptions , ghcSrcOptions , ghcPkgOptions + , ghcLangOptions -- * Result types , ChModuleName(..) @@ -87,7 +88,8 @@ data SomeLocalBuildInfo = SomeLocalBuildInfo { slbiSourceDirs :: [(ChComponentName, [String])], slbiGhcOptions :: [(ChComponentName, [String])], slbiGhcSrcOptions :: [(ChComponentName, [String])], - slbiGhcPkgOptions :: [(ChComponentName, [String])] + slbiGhcPkgOptions :: [(ChComponentName, [String])], + slbiGhcLangOptions :: [(ChComponentName, [String])] } deriving (Eq, Ord, Read, Show) -- | Caches helper executable result so it doesn't have to be run more than once @@ -146,11 +148,15 @@ ghcSrcOptions :: MonadIO m => Query m [(ChComponentName, [String])] -- access any home modules. ghcPkgOptions :: MonadIO m => Query m [(ChComponentName, [String])] +-- | Only language related options, i.e. @-XSomeExtension@ +ghcLangOptions :: MonadIO m => Query m [(ChComponentName, [String])] + entrypoints = Query $ slbiEntrypoints `liftM` getSlbi sourceDirs = Query $ slbiSourceDirs `liftM` getSlbi ghcOptions = Query $ slbiGhcOptions `liftM` getSlbi ghcSrcOptions = Query $ slbiGhcSrcOptions `liftM` getSlbi ghcPkgOptions = Query $ slbiGhcPkgOptions `liftM` getSlbi +ghcLangOptions = Query $ slbiGhcLangOptions `liftM` getSlbi -- | Run @cabal configure@ reconfigure :: MonadIO m @@ -181,6 +187,7 @@ getSomeConfigState = ask >>= \(progs, distdir) -> do , "ghc-options" , "ghc-src-options" , "ghc-pkg-options" + , "ghc-lang-options" ] ++ progArgs res <- liftIO $ do @@ -195,9 +202,11 @@ getSomeConfigState = ask >>= \(progs, distdir) -> do Just (ChResponseStrings srcDirs), Just (ChResponseStrings ghcOpts), Just (ChResponseStrings ghcSrcOpts), - Just (ChResponseStrings ghcPkgOpts) ] = res + Just (ChResponseStrings ghcPkgOpts), + Just (ChResponseStrings ghcLangOpts) ] = res - return $ SomeLocalBuildInfo eps srcDirs ghcOpts ghcSrcOpts ghcPkgOpts + return $ SomeLocalBuildInfo + eps srcDirs ghcOpts ghcSrcOpts ghcPkgOpts ghcLangOpts -- | Create @cabal_macros.h@ and @Paths_\<pkg\>@ possibly other generated files -- in the usual place. |