introducing -i, -g, and -p.

Browse.hs

@@ -1,5 +1,6 @@
 module Browse (browseModule) where
 
+import Control.Applicative hiding ((<|>), many)
 import Data.Char
 import Data.List
 import Language.Haskell.Exts.Extension
@@ -7,19 +8,18 @@ import Language.Haskell.Exts.Parser hiding (parse)
 import Language.Haskell.Exts.Syntax
 import System.IO
 import System.Process
-import Text.ParserCombinators.Parsec
+import Text.Parsec
+import Text.Parsec.String
+import Param
 
 ----------------------------------------------------------------
 
-browseModule :: String -> IO [String]
+browseModule :: Options -> String -> IO String
-browseModule mname = do
+browseModule opt mname = convert opt . nub . sort . parseSyntax . preprocess <$> getSyntax opt mname
-    xs <- getSyntax mname
-    let ys = preprocess xs
-    return $ parseSyntax ys
 
-getSyntax :: String -> IO String
+getSyntax :: Options -> String -> IO String
-getSyntax mname  = do
+getSyntax opt mname  = do
-    (inp,out,_,_) <- runInteractiveProcess "ghci" [] Nothing Nothing
+    (inp,out,_,_) <- runInteractiveProcess (ghci opt) [] Nothing Nothing
     mapM_ setFD [inp,out]
     hPutStrLn inp ":set prompt \"\""
     hPutStrLn inp "1"
@@ -42,7 +42,6 @@ parseSyntax xs = do
         res = parseModuleWithMode mode xs
     case res of
       ParseOk x       -> identifiers x
---      e               -> error $ show e
       _               -> []
 
 
@@ -54,17 +53,17 @@ preprocess cs = case parse remove "remove" cs of
                   Left  e -> error $ show e
 
 modName :: Parser String
-modName = do c <- oneOf ['A'..'Z']
+modName = (:) <$> (oneOf ['A'..'Z'])
-             cs <- many1 $ oneOf $ ['A'..'Z'] ++ ['a'..'z'] ++ ['0'..'9'] ++ "_'#"
+              <*> (many . oneOf $ ['A'..'Z'] ++ ['a'..'z'] ++ ['0'..'9'] ++ "_'#")
-             return $ c:cs
 
 anyName :: Parser String
-anyName = many1 $ oneOf $ ['A'..'Z'] ++ ['a'..'z'] ++ ['0'..'9'] ++ "_'#"
+anyName = many1 . oneOf $ ['A'..'Z'] ++ ['a'..'z'] ++ ['0'..'9'] ++ "_'#"
 
 manyBefore :: Show tok => GenParser tok st a -> GenParser tok st [tok] -> GenParser tok st [a]
 manyBefore p anchor = manyTill p (eof <|> try anc)
     where
-      anc = do pos <- getPosition
+      anc = do
+          pos <- getPosition
           s <- anchor
           ss <- getInput
           setInput $ s ++ ss
@@ -72,28 +71,22 @@ manyBefore p anchor = manyTill p (eof <|> try anc)
           return ()
 
 keyword :: Parser String
-keyword = do ms <- modName
+keyword = (++) <$> modName <*> string "."
-             char '.'
-             return $ ms ++ ['.']
 
 ghcName :: Parser String
-ghcName = do keyword
+ghcName = do 
+    keyword
     try sep <|> end
   where
-   sep = do
+   sep = last <$> sepBy1 anyName (char '.')
-       ws <- sepBy1 anyName (char '.')
+   end = "" <$ endBy1 anyName (char '.')
-       return $ last ws
-   end = do
-       endBy1 anyName (char '.')
-       return ""
 
 nonGhcName :: Parser String
-nonGhcName = do c <- anyChar  -- making this func non-empty
+nonGhcName = (:) <$> anyChar <*> manyBefore anyChar keyword
-                cs <- manyBefore anyChar keyword
-                return $ c:cs
 
 remove :: Parser String
-remove = do l1 <- try ghcName <|> return ""
+remove = do
+    l1 <- try ghcName <|> return ""
     l2 <- nonGhcName
     ll <- many (do x <- ghcName
                    y <- nonGhcName

Check.hs

@@ -3,21 +3,23 @@ module Check (checkSyntax) where
 import Control.Applicative
 import Data.Char
 import Data.List
+import Param
 import System.IO
 import System.Process
 
 ----------------------------------------------------------------
 
-checkSyntax :: String -> IO String
+checkSyntax :: Options -> String -> IO String
-checkSyntax file = do
+checkSyntax opt file = do
-    (_,_,herr,_) <- runInteractiveProcess "ghc" ["--make","-Wall",file] Nothing Nothing
+    (_,_,herr,_) <- runInteractiveProcess (ghc opt) ["--make","-Wall",file] Nothing Nothing
     refine <$> hGetContents herr
   where
    refine = unfoldLines start . map (dropWhile isSpace) . filter (/="") . lines
    start = (file `isPrefixOf`)
 
 unfoldLines :: (String -> Bool) -> [String] -> String
-unfoldLines p = drop 1 . unfold
+unfoldLines _ [] = ""
+unfoldLines p (x:xs) = x ++ unfold xs
   where
     unfold [] = "\n"
     unfold (l:ls)

GHCMod.hs

@@ -2,17 +2,13 @@ module Main where
 
 import Browse
 import Check
-import Control.Applicative
 import Control.Exception hiding (try)
-import Data.List
 import List
+import Param
 import Prelude hiding (catch)
 import System.Console.GetOpt
-import System.Directory
 import System.Environment (getArgs)
-import System.FilePath
 import System.IO
-import System.Posix.Env
 
 ----------------------------------------------------------------
 
@@ -26,17 +22,26 @@ usage =    "ghc-mod version 0.2.0\n"
 
 ----------------------------------------------------------------
 
-data Options   = Options { optToLisp :: Bool
-                         } deriving Show
-
 defaultOptions :: Options
-defaultOptions = Options { optToLisp = False
+defaultOptions = Options { convert = toPlain
+                         , ghc     = "ghc"
+                         , ghci    = "ghci"
+                         , ghcPkg  = "ghc-pkg"
                          }
 
 argspec :: [OptDescr (Options -> Options)]
 argspec = [ Option ['l'] ["tolisp"]
-            (NoArg (\opts -> opts { optToLisp = True }))
+            (NoArg (\opts -> opts { convert = toLisp }))
             "print as a list of Lisp"
+          , Option ['g'] ["ghc"]
+            (ReqArg (\str opts -> opts { ghc = str }) "ghc")
+            "GHC path"
+          , Option ['i'] ["ghci"]
+            (ReqArg (\str opts -> opts { ghci = str }) "ghci")
+            "ghci path"
+          , Option ['p'] ["ghc-pkg"]
+            (ReqArg (\str opts -> opts { ghcPkg = str }) "ghc-pkg")
+            "ghc-pkg path"
           ]
 
 parseArgs :: [OptDescr (Options -> Options)] -> [String] -> (Options, [String])
@@ -50,31 +55,17 @@ parseArgs spec argv
 main :: IO ()
 main = flip catch handler $ do
     args <- getArgs
-    setPath
     let (opt,cmdArg) = parseArgs argspec args
-        transform = if optToLisp opt then toLisp else toPlain
+    res <- case cmdArg !! 0 of
-        refine = transform . nub . sort
+      "browse" -> browseModule opt (cmdArg !! 1)
-    case cmdArg !! 0 of
+      "list"   -> listModules opt
-      cmd | cmd == "browse" -> refine <$> browseModule (cmdArg !! 1) >>= putStr
+      "check"  -> checkSyntax opt (cmdArg !! 1)
-          | cmd == "list"   -> refine <$> listModules >>= putStr
-          | cmd == "check"  -> checkSyntax (cmdArg !! 1) >>= putStr
       _        -> error usage
-    hFlush stdout
+    putStr res
   where
     handler :: ErrorCall -> IO ()
     handler _ = putStr usage
 
-setPath :: IO ()
-setPath = do
-  home <- getHomeDirectory
-  mpath <- getEnv "PATH"
-  let path = maybe "/usr/bin:/bin" id mpath
-      newpath = "/usr/local/bin:/opt/local/bin:"
-             ++ (home </> ".cabal/bin") ++ ":"
-             ++ (home </> "bin") ++ ":"
-             ++ path
-  setEnv "PATH" newpath True
-
 ----------------------------------------------------------------
 toLisp :: [String] -> String
 toLisp ms = "(" ++ unwords quoted ++ ")\n"

List.hs

@@ -3,17 +3,18 @@ module List (listModules) where
 import Control.Applicative
 import Data.Char
 import Data.List
+import Param
 import System.IO
 import System.Process
 
 ----------------------------------------------------------------
 
-listModules :: IO [String]
+listModules :: Options -> IO String
-listModules = exposedModules <$> getDump
+listModules opt = convert opt . nub . sort . exposedModules <$> getDump opt
 
-getDump :: IO String
+getDump :: Options -> IO String
-getDump = do
+getDump opt = do
-  (_,hout,_,_) <- runInteractiveProcess "ghc-pkg" ["dump"] Nothing Nothing
+  (_,hout,_,_) <- runInteractiveProcess (ghcPkg opt) ["dump"] Nothing Nothing
   hGetContents hout
 
 exposedModules :: String -> [String]

elisp/ghc-comp.el

@@ -15,8 +15,6 @@
 ;;; Customize Variables
 ;;;
 
-(defvar ghc-module-command "ghc-mod")
-
 (defvar ghc-idle-timer-interval 30)
 
 ;; must be sorted
@@ -66,7 +64,8 @@
      (lambda ()
        (let ((msg (mapconcat 'identity (cons ghc-module-command args) " ")))
 	 (message "Executing \"%s\"..." msg)
-	 (apply 'call-process ghc-module-command nil t nil (cons "-l" args))
+	 (apply 'call-process ghc-module-command nil t nil
+		(append '("-l") (ghc-module-command-args) args))
 	 (message "Executing \"%s\"...done" msg))))))
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

elisp/ghc-flymake.el

@@ -18,6 +18,7 @@
          (local-file (file-relative-name
                       temp-file
                       (file-name-directory buffer-file-name))))
-    (list "ghc-mod" (list "check" local-file))))
+    (list "ghc-mod" (append (ghc-module-command-args)
+			    (list "check" local-file)))))
 
 (provide 'ghc-flymake)

elisp/ghc-func.el

@@ -49,4 +49,16 @@
 (defun ghc-read-module-name (def)
   (read-from-minibuffer "Module name: " def ghc-input-map))
 
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(defvar ghc-module-command "ghc-mod")
+(defvar ghc-ghc-command     (ghc-which "ghc"))
+(defvar ghc-ghci-command    (ghc-which "ghci"))
+(defvar ghc-ghc-pkg-command (ghc-which "ghc-pkg"))
+
+(defun ghc-module-command-args ()
+  (list "-g" ghc-ghc-command
+	"-i" ghc-ghci-command
+	"-p" ghc-ghc-pkg-command))
+
 (provide 'ghc-func)

ghc-mod.cabal

@@ -24,7 +24,7 @@ Executable ghc-mod
   Other-Modules:        List Browse
   GHC-Options:          -Wall
   Build-Depends:        base >= 4.0 && < 10,
-                        parsec, process, haskell-src-exts,
+                        parsec >= 3, process, haskell-src-exts,
                         unix, directory, filepath
 Source-Repository head
   Type:                 git