Merge pull request #28 from khibino/ghc_option

Ghc option - Removed --package-conf and --no-user-package-conf switch

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
+  let orig_ghcopt = ghcOpts orig_opts
-  orig_opts { packageConfs = orig_paths ++ [path] }
+  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/"

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
 
 ----------------------------------------------------------------
 

GHCMod.hs

@@ -2,6 +2,7 @@
 
 module Main where
 
+import CabalDev (modifyOptions)
 import Browse
 import Check
 import Control.Applicative
@@ -20,15 +21,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] <module> [<module> ...]\n"
+        ++ "\t ghc-mod browse" ++ ghcOptHelp ++ "[-l] [-o] <module> [<module> ...]\n"
-        ++ "\t ghc-mod check [-g GHC opt1 -g GHC opt2 ...] <HaskellFile>\n"
+        ++ "\t ghc-mod check" ++ ghcOptHelp ++ "<HaskellFile>\n"
-        ++ "\t ghc-mod type <HaskellFile> <module> <expression>\n"
+        ++ "\t ghc-mod type" ++ ghcOptHelp ++ "<HaskellFile> <module> <expression>\n"
-        ++ "\t ghc-mod info <HaskellFile> <module> <expression>\n"
+        ++ "\t ghc-mod info" ++ ghcOptHelp ++ "<HaskellFile> <module> <expression>\n"
         ++ "\t ghc-mod lint [-h opt] <HaskellFile>\n"
         ++ "\t ghc-mod boot\n"
         ++ "\t ghc-mod help\n"
@@ -41,8 +45,6 @@ defaultOptions = Options {
   , hlintOpts = []
   , ghcOpts = []
   , operators = False
-  , packageConfs = []
-  , useUserPackageConf = True
   }
 
 argspec :: [OptDescr (Options -> Options)]
@@ -58,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])
@@ -86,8 +82,8 @@ instance Exception GHCModError
 main :: IO ()
 main = flip catches handlers $ do
     args <- getArgs
-    let (opt,cmdArg) = parseArgs argspec args
+    let (opt',cmdArg) = parseArgs argspec args
-    res <- case safelist cmdArg 0 of
+    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)

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:

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)
@@ -29,14 +27,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 +53,10 @@ setFlags d idirs = d'
 ghcPackage :: PackageFlag
 ghcPackage = ExposePackage "ghc"
 
-setPackageConfFlags :: Options -> DynFlags -> DynFlags
+setGhcFlags :: Monad m => Options -> DynFlags -> m DynFlags
-setPackageConfFlags
+setGhcFlags opt flagset =
-  Options { packageConfs = confs, useUserPackageConf = useUser }
+  do (flagset',_,_) <- parseDynamicFlags flagset (map noLoc (ghcOpts opt))
-  flagset@DynFlags { extraPkgConfs = extra, flags = origFlags }
+     return flagset'
-  = flagset { extraPkgConfs = extra', flags = flags' }
-  where
-    extra' = confs ++ extra
-    flags' = if useUser then
-                 origFlags
-             else
-                 filter (/=Opt_ReadUserPackageConf) origFlags
 
 ----------------------------------------------------------------
 

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))))
 

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)))
+     `(,@(ghc-make-ghc-options) "check" ,file)))
-       `(,@gopts "check" ,file))))
 
 (defun ghc-flymake-toggle-command ()
   (interactive)

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)

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)))