From 21441da080995376d264bd031b70dd886bcd6bf1 Mon Sep 17 00:00:00 2001 From: HIBINO Kei Date: Mon, 14 Nov 2011 18:12:18 +0900 Subject: [PATCH 1/5] Switch from packageConfs and useUserPackageConf into ghcOpts. --- GHCMod.hs | 13 ++++++++----- Types.hs | 19 ++++++------------- 2 files changed, 14 insertions(+), 18 deletions(-) diff --git a/GHCMod.hs b/GHCMod.hs index 8c6e244..2953651 100644 --- a/GHCMod.hs +++ b/GHCMod.hs @@ -20,15 +20,18 @@ import Types ---------------------------------------------------------------- +ghcOptHelp :: String +ghcOptHelp = " [-g GHC_opt1 -g GHC_opt2 ...] " + usage :: String usage = "ghc-mod version 1.0.0\n" ++ "Usage:\n" - ++ "\t ghc-mod list [-l]\n" + ++ "\t ghc-mod list" ++ ghcOptHelp ++ "[-l]\n" ++ "\t ghc-mod lang [-l]\n" - ++ "\t ghc-mod browse [-l] [-o] [ ...]\n" - ++ "\t ghc-mod check [-g GHC opt1 -g GHC opt2 ...] \n" - ++ "\t ghc-mod type \n" - ++ "\t ghc-mod info \n" + ++ "\t ghc-mod browse" ++ ghcOptHelp ++ "[-l] [-o] [ ...]\n" + ++ "\t ghc-mod check" ++ ghcOptHelp ++ "\n" + ++ "\t ghc-mod type" ++ ghcOptHelp ++ " \n" + ++ "\t ghc-mod info" ++ ghcOptHelp ++ " \n" ++ "\t ghc-mod lint [-h opt] \n" ++ "\t ghc-mod boot\n" ++ "\t ghc-mod help\n" diff --git a/Types.hs b/Types.hs index d45ceee..5fbe6ed 100644 --- a/Types.hs +++ b/Types.hs @@ -29,14 +29,14 @@ withGHC body = ghandle ignore $ runGhc (Just libdir) body initSession0 :: Options -> Ghc [PackageId] initSession0 opt = getSessionDynFlags >>= - setSessionDynFlags . setPackageConfFlags opt + (>>= setSessionDynFlags) . setGhcFlags opt initSession :: Options -> [String] -> [FilePath] -> Bool -> Ghc LogReader initSession opt cmdOpts idirs logging = do dflags <- getSessionDynFlags let opts = map noLoc cmdOpts (dflags',_,_) <- parseDynamicFlags dflags opts - (dflags'',readLog) <- liftIO . setLogger logging . setPackageConfFlags opt . setFlags dflags' $ idirs + (dflags'',readLog) <- liftIO . (>>= setLogger logging) . setGhcFlags opt . setFlags dflags' $ idirs setSessionDynFlags dflags'' return readLog @@ -55,17 +55,10 @@ setFlags d idirs = d' ghcPackage :: PackageFlag ghcPackage = ExposePackage "ghc" -setPackageConfFlags :: Options -> DynFlags -> DynFlags -setPackageConfFlags - Options { packageConfs = confs, useUserPackageConf = useUser } - flagset@DynFlags { extraPkgConfs = extra, flags = origFlags } - = flagset { extraPkgConfs = extra', flags = flags' } - where - extra' = confs ++ extra - flags' = if useUser then - origFlags - else - filter (/=Opt_ReadUserPackageConf) origFlags +setGhcFlags :: Monad m => Options -> DynFlags -> m DynFlags +setGhcFlags opt flagset = + do (flagset',_,_) <- parseDynamicFlags flagset (map noLoc (ghcOpts opt)) + return flagset' ---------------------------------------------------------------- From 748c57f0c1419e48c1c73586d84979f91e53e147 Mon Sep 17 00:00:00 2001 From: HIBINO Kei Date: Mon, 14 Nov 2011 19:20:02 +0900 Subject: [PATCH 2/5] Switch when using cabal-dev case. Bugfix of cabal-dev case. --- CabalDev.hs | 8 ++++---- Check.hs | 4 +--- GHCMod.hs | 5 +++-- 3 files changed, 8 insertions(+), 9 deletions(-) diff --git a/CabalDev.hs b/CabalDev.hs index 1e4be52..8aa202f 100644 --- a/CabalDev.hs +++ b/CabalDev.hs @@ -9,7 +9,7 @@ options ghc-mod uses to check the source. Otherwise just pass it on. import Data.Maybe (listToMaybe) import System.FilePath.Find -import System.FilePath.Posix (splitPath,joinPath) +import System.FilePath.Posix (splitPath,joinPath,()) import System.Posix.Directory (getWorkingDirectory) import System.Directory @@ -29,8 +29,8 @@ findCabalDev = addPath :: Options -> String -> Options addPath orig_opts path = do - let orig_paths = packageConfs orig_opts - orig_opts { packageConfs = orig_paths ++ [path] } + let orig_ghcopt = ghcOpts orig_opts + orig_opts { ghcOpts = orig_ghcopt ++ ["-package-conf", path] } searchIt :: [FilePath] -> IO (Maybe FilePath) searchIt [] = return Nothing @@ -42,4 +42,4 @@ searchIt path = do else return Nothing where - mpath a = joinPath a ++ "cabal-dev/" + mpath a = joinPath a "cabal-dev/" diff --git a/Check.hs b/Check.hs index 66fa9bd..4dd9cf1 100644 --- a/Check.hs +++ b/Check.hs @@ -1,7 +1,6 @@ module Check (checkSyntax) where import Cabal -import CabalDev (modifyOptions) import Control.Applicative import CoreMonad import ErrMsg @@ -14,8 +13,7 @@ import Types checkSyntax :: Options -> String -> IO String checkSyntax opt file = do - opt' <- modifyOptions opt - unlines <$> check opt' file + unlines <$> check opt file ---------------------------------------------------------------- diff --git a/GHCMod.hs b/GHCMod.hs index 2953651..567d47d 100644 --- a/GHCMod.hs +++ b/GHCMod.hs @@ -2,6 +2,7 @@ module Main where +import CabalDev (modifyOptions) import Browse import Check import Control.Applicative @@ -89,8 +90,8 @@ instance Exception GHCModError main :: IO () main = flip catches handlers $ do args <- getArgs - let (opt,cmdArg) = parseArgs argspec args - res <- case safelist cmdArg 0 of + let (opt',cmdArg) = parseArgs argspec args + res <- modifyOptions opt' >>= \opt -> case safelist cmdArg 0 of "browse" -> concat <$> mapM (browseModule opt) (tail cmdArg) "list" -> listModules opt "check" -> withFile (checkSyntax opt) (safelist cmdArg 1) From 21c5072e37c0343c3631e62cd193833bf2dabb5e Mon Sep 17 00:00:00 2001 From: HIBINO Kei Date: Mon, 14 Nov 2011 19:28:34 +0900 Subject: [PATCH 3/5] Expire unreferenced switches. --- GHCMod.hs | 8 -------- Types.hs | 2 -- 2 files changed, 10 deletions(-) diff --git a/GHCMod.hs b/GHCMod.hs index 567d47d..2ab156f 100644 --- a/GHCMod.hs +++ b/GHCMod.hs @@ -45,8 +45,6 @@ defaultOptions = Options { , hlintOpts = [] , ghcOpts = [] , operators = False - , packageConfs = [] - , useUserPackageConf = True } argspec :: [OptDescr (Options -> Options)] @@ -62,12 +60,6 @@ argspec = [ Option "l" ["tolisp"] , Option "o" ["operators"] (NoArg (\opts -> opts { operators = True })) "print operators, too" - , Option "" ["package-conf"] - (ReqArg (\p opts -> opts { packageConfs = p : packageConfs opts }) "path") - "additional package database" - , Option "" ["no-user-package-conf"] - (NoArg (\opts -> opts{ useUserPackageConf = False })) - "do not read the user package database" ] parseArgs :: [OptDescr (Options -> Options)] -> [String] -> (Options, [String]) diff --git a/Types.hs b/Types.hs index 5fbe6ed..301ff36 100644 --- a/Types.hs +++ b/Types.hs @@ -15,8 +15,6 @@ data Options = Options { , hlintOpts :: [String] , ghcOpts :: [String] , operators :: Bool - , packageConfs :: [FilePath] - , useUserPackageConf :: Bool } withGHC :: (MonadPlus m) => Ghc (m a) -> IO (m a) From fe13f74c1686385e986d3dbc261c566bc86956f3 Mon Sep 17 00:00:00 2001 From: HIBINO Kei Date: Tue, 15 Nov 2011 20:40:25 +0900 Subject: [PATCH 4/5] Update elisps enable to pass ghc options widely. --- elisp/ghc-comp.el | 2 +- elisp/ghc-flymake.el | 5 ++--- elisp/ghc-func.el | 5 +++++ elisp/ghc-info.el | 6 ++++-- 4 files changed, 12 insertions(+), 6 deletions(-) diff --git a/elisp/ghc-comp.el b/elisp/ghc-comp.el index 2e2471b..56df544 100644 --- a/elisp/ghc-comp.el +++ b/elisp/ghc-comp.el @@ -87,7 +87,7 @@ unloaded modules are loaded") (lambda () (message "Loading names...") (apply 'call-process ghc-module-command nil t nil - (cons "-l" (cons "browse" mods))) + `(,@(ghc-make-ghc-options) "-l" "browse" ,@mods)) (message "Loading names...done")) (length mods)))) diff --git a/elisp/ghc-flymake.el b/elisp/ghc-flymake.el index 4af0c56..4b91d63 100644 --- a/elisp/ghc-flymake.el +++ b/elisp/ghc-flymake.el @@ -9,11 +9,11 @@ ;;; Code: (require 'flymake) +(require 'ghc-func) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (defvar ghc-hlint-options nil "*Hlint options") -(defvar ghc-ghc-options nil "*GHC options") ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; @@ -47,8 +47,7 @@ (if ghc-flymake-command (let ((hopts (ghc-mapconcat (lambda (x) (list "-h" x)) ghc-hlint-options))) `(,@hopts "lint" ,file)) - (let ((gopts (ghc-mapconcat (lambda (x) (list "-g" x)) ghc-ghc-options))) - `(,@gopts "check" ,file)))) + `(,@(ghc-make-ghc-options) "check" ,file))) (defun ghc-flymake-toggle-command () (interactive) diff --git a/elisp/ghc-func.el b/elisp/ghc-func.el index 009b4f2..bb02e00 100644 --- a/elisp/ghc-func.el +++ b/elisp/ghc-func.el @@ -11,6 +11,8 @@ (defvar ghc-module-command "ghc-mod" "*The command name of \"ghc-mod\"") +(defvar ghc-ghc-options nil "*GHC options") + ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (defun ghc-replace-character (string from to) @@ -135,4 +137,7 @@ (fset getter (list 'lambda '(struct) (list 'nth i 'struct))) (setq keys (cdr keys))))) +(defun ghc-make-ghc-options () + (ghc-mapconcat (lambda (x) (list "-g" x)) ghc-ghc-options)) + (provide 'ghc-func) diff --git a/elisp/ghc-info.el b/elisp/ghc-info.el index bb4b5d9..33e022b 100644 --- a/elisp/ghc-info.el +++ b/elisp/ghc-info.el @@ -26,7 +26,8 @@ (file (buffer-name))) (with-temp-buffer (cd cdir) - (call-process ghc-module-command nil t nil "type" file modname expr) + (apply 'call-process ghc-module-command nil t nil + `(,@(ghc-make-ghc-options) "type" ,file ,modname ,expr)) (message (buffer-substring (point-min) (1- (point-max))))))) (defun ghc-show-info (&optional ask) @@ -49,7 +50,8 @@ (insert (with-temp-buffer (cd cdir) - (call-process ghc-module-command nil t nil "info" file modname expr) + (apply 'call-process ghc-module-command nil t nil + `(,@(ghc-make-ghc-options) "info" ,file ,modname ,expr)) (buffer-substring (point-min) (1- (point-max)))))) (display-buffer buf))) From 07bb2d32ddde186300239c2a272c20654b0bf7a2 Mon Sep 17 00:00:00 2001 From: HIBINO Kei Date: Wed, 16 Nov 2011 22:34:38 +0900 Subject: [PATCH 5/5] Update Changes in README. --- README | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/README b/README index a75204f..a37432c 100644 --- a/README +++ b/README @@ -35,7 +35,7 @@ Changes: (setq ghc-ghc-options '("-idir1:dir2")) - Now, you can simply pass GHC options to ghc-mod check command. + Now, you can simply pass GHC options to ghc-mod sub-commands. For more information, see: