Start rolling ghc-modi into the ghc-mod executable

elisp/ghc-process.el

@@ -20,7 +20,7 @@
 (defvar-local ghc-process-callback nil)
 (defvar-local ghc-process-hook nil)
 
-(defvar ghc-interactive-command "ghc-modi")
+(defvar ghc-command "ghc-modi")
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
@@ -35,7 +35,7 @@
     (if hook1 (funcall hook1))
     (let* ((cbuf (current-buffer))
 	   (name ghc-process-process-name)
-	   (buf (get-buffer-create (concat " ghc-modi:" name)))
+	   (buf (get-buffer-create (concat " ghc-mod:" name)))
 	   (file (buffer-file-name))
 	   (cpro (get-process name)))
       (ghc-with-current-buffer buf
@@ -63,8 +63,8 @@
    (t cpro)))
 
 (defun ghc-start-process (name buf)
-  (let* ((opts (append '("-b" "\n" "-l") (ghc-make-ghc-options)))
+  (let* ((opts (append '("--legacy-interactive" "-b" "\n" "-l") (ghc-make-ghc-options)))
-	 (pro (apply 'start-file-process name buf ghc-interactive-command opts)))
+	 (pro (apply 'start-file-process name buf ghc-command opts)))
     (set-process-filter pro 'ghc-process-filter)
     (set-process-sentinel pro 'ghc-process-sentinel)
     (set-process-query-on-exit-flag pro nil)

src/GHCMod.hs

@@ -30,16 +30,10 @@ import Text.PrettyPrint
 
 import Misc
 
-
-
 progVersion :: String
 progVersion =
-    progName ++ " version " ++ showVersion version ++ " compiled by GHC "
+    "ghc-mod version " ++ showVersion version ++ " compiled by GHC "
-                            ++ cProjectVersion ++ "\n"
+                       ++ cProjectVersion ++ "\n"
-
--- TODO: remove (ghc) version prefix!
-progName :: String
-progName = unsafePerformIO $ takeFileName <$> getProgName
 
 optionUsage :: (String -> String) -> [OptDescr a] -> [String]
 optionUsage indent opts = concatMap optUsage opts
@@ -64,15 +58,9 @@ optionUsage indent opts = concatMap optUsage opts
             ReqArg _ label -> s ++ label
             OptArg _ label -> s ++ "["++label++"]"
 
+-- TODO: Generate the stuff below automatically
 usage :: String
 usage =
-    case progName of
-      "ghc-modi" -> ghcModiUsage
-      _ -> ghcModUsage
-
--- TODO: Generate the stuff below automatically
-ghcModUsage :: String
-ghcModUsage =
  "Usage: ghc-mod [OPTIONS...] COMMAND [CMD_ARGS...] \n\
  \*Global Options (OPTIONS)*\n\
  \    Global options can be specified before and after the command and\n\
@@ -200,32 +188,12 @@ ghcModUsage =
  \        Debugging information related to cabal component resolution.\n\
  \\n\
  \    - boot\n\
- \         Internal command used by the emacs frontend.\n"
+ \         Internal command used by the emacs frontend.\n\
- -- "\n\
- -- \The following forms are supported so ghc-mod can be invoked by\n\
- -- \`cabal repl':\n\
- -- \\n\
- -- \     ghc-mod --make GHC_OPTIONS\n\
- -- \         Pass all options through to the GHC executable.\n\
- -- \\n\
- -- \     ghc-mod --interactive GHC_OPTIONS [--ghc-mod]\n\
- -- \         Start ghci emulation mode. GHC_OPTIONS are passed to the\n\
- -- \         GHC API. If `--ghc-mod' is given ghc-mod specific extensions\n\
- -- \         are enabled.\n"
- where
-   indent = ("    "++)
-
-ghcModiUsage :: String
-ghcModiUsage =
- "Usage: ghc-modi [OPTIONS...] COMMAND\n\
- \*Options*\n"
-   ++ (unlines $ indent <$> optionUsage indent globalArgSpec) ++
- "*Commands*\n\
- \    - version | --version\n\
- \        Print the version of the program.\n\
  \\n\
- \    - help | --help\n\
+ \    - legacy-interactive [OPTIONS...]\n\
- \       Print this help message.\n"
+ \         ghc-modi compatibility mode.\n\
+ \      *Options*\n"
+   ++ (unlines $ indent <$> optionUsage indent globalArgSpec)
  where
    indent = ("    "++)
 
@@ -255,6 +223,9 @@ cmdUsage cmd realUsage =
       unindent l = l
   in unlines $ unindent <$> c
 
+ghcModStyle :: Style
+ghcModStyle = style { lineLength = 80, ribbonsPerLine = 1.2 }
+
 ----------------------------------------------------------------
 
 option :: [Char] -> [String] -> String -> ArgDescr a -> OptDescr a
@@ -280,7 +251,7 @@ globalArgSpec =
       , option "b" ["boundary"] "Output line separator"$
                reqArg "SEP" $ \s o -> o { lineSeparator = LineSeparator s }
 
-      , option "g" ["ghcOpt"] "Option to be passed to GHC" $
+      , option "g" ["ghcOpt", "ghc-option"] "Option to be passed to GHC" $
                reqArg "OPT" $ \g o ->
                    o { ghcUserOptions = g : ghcUserOptions o }
 
@@ -297,10 +268,14 @@ globalArgSpec =
 
 parseGlobalArgs :: [String] -> Either InvalidCommandLine (Options, [String])
 parseGlobalArgs argv
-    = case O.getOpt RequireOrder globalArgSpec argv of
+    = case O.getOpt' Permute globalArgSpec argv of
-        (o,r,[]  ) -> Right $ (foldr id defaultOptions o, r)
+        (o,r,u,[]) -> Right $ (foldr id defaultOptions o, u ++ r)
-        (_,_,errs) -> Left $ InvalidCommandLine $ Right $
+        (_,_,u,e)  -> Left $ InvalidCommandLine $ Right $
-            "Parsing command line options failed: " ++ concat errs
+            "Parsing command line options failed: "
+               ++ concat (e ++ map errUnrec u)
+ where
+   errUnrec :: String -> String
+   errUnrec optStr = "unrecognized option `" ++ optStr ++ "'\n"
 
 parseCommandArgs :: [OptDescr (Options -> Options)]
                  -> [String]
@@ -322,8 +297,6 @@ data CmdError = UnknownCommand String
 
 instance Exception CmdError
 
-----------------------------------------------------------------
-
 data InteractiveOptions = InteractiveOptions {
       ghcModExtensions :: Bool
     }
@@ -338,9 +311,9 @@ handler = flip catches $
                 case e of
                   Left cmd ->
                       exitError $ "Usage for `"++cmd++"' command:\n\n"
-                                  ++ (cmdUsage cmd ghcModUsage) ++ "\n"
+                                  ++ (cmdUsage cmd usage) ++ "\n"
-                                  ++ progName ++ ": Invalid command line form."
+                                  ++ "ghc-mod: Invalid command line form."
-                  Right msg -> exitError $ progName ++ ": " ++ msg
+                  Right msg -> exitError $ "ghc-mod: " ++ msg
           ]
 
 main :: IO ()
@@ -362,78 +335,19 @@ main = handler $ do
 
 progMain :: (Options,[String]) -> IO ()
 progMain (globalOptions,cmdArgs) = do
-    -- let (ghcArgs, modArgs) = second stripSeperator $ span (/="--") args
+    (res,_) <- runGhcModT globalOptions $ ghcCommands cmdArgs
-    --     _realGhcArgs = filter (/="--ghc-mod") ghcArgs
-
-    --     (globalOptions,_cmdArgs) = parseGlobalArgs modArgs
-
-    --     stripSeperator ("--":rest) = rest
-    --     stripSeperator l = l
-
-    case progName of
-      "ghc-modi" -> do
-          legacyInteractive globalOptions =<< emptyNewUnGetLine
-
-
-      _
-          -- | "--numeric-version" `elem` ghcArgs || "--make" `elem` ghcArgs -> do
-          --     rawSystem (ghcProgram globalOptions) realGhcArgs >>= exitWith
-
-          -- | "--interactive" `elem` ghcArgs -> do
-          --     let interactiveOptions = if "--ghc-mod" `elem` ghcArgs
-          --                              then def { ghcModExtensions = True }
-          --                              else def
-
-          --     -- TODO: pass ghcArgs' to ghc API
-          --     putStrLn "\ninteractive\n"
-          --     --print realGhcArgs
-          --     (res, _) <- runGhcModT globalOptions $ undefined
-          --     case res of
-          --       Right s -> putStr s
-          --       Left e -> exitError $ render (gmeDoc e)
-
-
-          | otherwise -> do
-                  (res,_) <- runGhcModT globalOptions $ ghcCommands cmdArgs
-                  case res of
-                    Right s -> putStr s
-                    Left e -> exitError $
-                        renderStyle style { ribbonsPerLine = 1.2 } (gmeDoc e)
-
-              -- Obtain ghc options by letting ourselfs be executed by
-              -- @cabal repl@
-              -- TODO: need to do something about non-cabal projects
-              -- exe <- ghcModExecutable
-              -- let cabalArgs = ["repl", "-v0", "--with-ghc="++exe]
-              --              ++ (("--ghc-option="++) `map` ("--ghc-mod":"--":args))
-
-              -- print cabalArgs
-
-              -- rawSystem "cabal" cabalArgs >>= exitWith
-
-
-
--- ghc-modi
-legacyInteractive :: Options -> UnGetLine -> IO ()
-legacyInteractive opt ref = flip catches handlers $ do
-    (res,_) <- runGhcModT opt $ do
-             symdbreq <- liftIO $ newSymDbReq opt
-             world <- liftIO . getCurrentWorld =<< cradle
-             legacyInteractiveLoop symdbreq ref world
-
     case res of
       Right () -> return ()
-      Left e -> putStrLn $ notGood $ render (gmeDoc e)
+      Left e -> exitError $ renderStyle ghcModStyle (gmeDoc e)
-
- where
-   handlers = [ Handler $ \Restart -> legacyInteractive opt ref ]
-
-isExitCodeException :: SomeException -> Bool
-isExitCodeException e = isJust mExitCode
- where
-   mExitCode :: Maybe ExitCode
-   mExitCode = fromException e
 
+-- ghc-modi
+legacyInteractive :: IOish m => GhcModT m ()
+legacyInteractive =
+  liftIO emptyNewUnGetLine >>= \ref -> do
+    opt <- options
+    symdbreq <- liftIO $ newSymDbReq opt
+    world <- liftIO . getCurrentWorld =<< cradle
+    legacyInteractiveLoop symdbreq ref world
 
 bug :: String -> IO ()
 bug msg = do
@@ -449,7 +363,6 @@ escapeNewlines = replace "\n" "\\n" . replace "\\n" "\\\\n"
 replace :: String -> String -> String -> String
 replace needle replacement = intercalate replacement . splitOn needle
 
-
 legacyInteractiveLoop :: IOish m
                       => SymDbReq -> UnGetLine -> World -> GhcModT m ()
 legacyInteractiveLoop symdbreq ref world = do
@@ -465,8 +378,6 @@ legacyInteractiveLoop symdbreq ref world = do
         liftIO $ ungetCommand ref cmdArg
         throw Restart
 
-    liftIO . prepareAutogen =<< cradle
-
     let (cmd':args') = split (keepDelimsR $ condense $ whenElt isSpace) cmdArg
         arg = concat args'
         cmd = dropWhileEnd isSpace cmd'
@@ -497,7 +408,6 @@ legacyInteractiveLoop symdbreq ref world = do
     liftIO $ putStr res >> putStrLn "OK" >> hFlush stdout
     legacyInteractiveLoop symdbreq ref world
 
-
 globalCommands :: [String] -> Maybe String
 globalCommands []      = Nothing
 globalCommands (cmd:_) = case cmd of
@@ -505,11 +415,12 @@ globalCommands (cmd:_) = case cmd of
     _ | cmd == "version" || cmd == "--version" -> Just progVersion
     _                                          -> Nothing
 
-ghcCommands :: IOish m => [String] -> GhcModT m String
+ghcCommands :: IOish m => [String] -> GhcModT m ()
 ghcCommands []         = fatalError "No command given (try --help)"
-ghcCommands (cmd:args) = fn args
+ghcCommands (cmd:args) = do
+    liftIO . putStr =<< action args
  where
-   fn = case cmd of
+   action = case cmd of
      _ | cmd == "list" || cmd == "modules" -> modulesCmd
      "lang"    -> languagesCmd
      "flag"    -> flagsCmd
@@ -530,8 +441,11 @@ ghcCommands (cmd:args) = fn args
      "doc"     -> pkgDocCmd
      "dumpsym" -> dumpSymbolCmd
      "boot"    -> bootCmd
+     "legacy-interactive" -> legacyInteractiveCmd
      _         -> fatalError $ "unknown command: `" ++ cmd ++ "'"
 
+
+
 newtype FatalError = FatalError String deriving (Show, Typeable)
 instance Exception FatalError
 
@@ -543,7 +457,7 @@ exitError :: String -> IO a
 exitError msg = hPutStrLn stderr (dropWhileEnd (=='\n') msg) >> exitFailure
 
 fatalError :: String -> a
-fatalError s = throw $ FatalError $ progName ++ ": " ++ s
+fatalError s = throw $ FatalError $ "ghc-mod: " ++ s
 
 withParseCmd :: IOish m
              => [OptDescr (Options -> Options)]
@@ -569,8 +483,9 @@ catchArgs cmd action =
         throw $ InvalidCommandLine (Left cmd)
 
 modulesCmd, languagesCmd, flagsCmd, browseCmd, checkSyntaxCmd, expandTemplateCmd,
-  debugInfoCmd, componentInfoCmd, infoCmd, typesCmd, splitsCmd, sigCmd, refineCmd, autoCmd,
+  debugInfoCmd, componentInfoCmd, infoCmd, typesCmd, splitsCmd, sigCmd,
-  findSymbolCmd, lintCmd, rootInfoCmd, pkgDocCmd, dumpSymbolCmd, bootCmd
+  refineCmd, autoCmd, findSymbolCmd, lintCmd, rootInfoCmd, pkgDocCmd,
+  dumpSymbolCmd, bootCmd, legacyInteractiveCmd
   :: IOish m => [String] -> GhcModT m String
 
 modulesCmd    = withParseCmd' "modules" s $ \[] -> modules
@@ -604,6 +519,8 @@ infoCmd       = withParseCmd [] $ action
         action [file,expr]   = info file expr
         action _ = throw $ InvalidCommandLine (Left "info")
 
+legacyInteractiveCmd = withParseCmd [] $ \[] -> legacyInteractive >> return ""
+
 checkAction :: ([t] -> a) -> [t] -> a
 checkAction _ []         = throw $ InvalidCommandLine (Right "No files given.")
 checkAction action files = action files

src/GHCModi.hs

@@ -1,262 +1,16 @@
 {-# LANGUAGE ScopedTypeVariables, DeriveDataTypeable #-}
 
 -- | WARNING
--- This program in the process of being deprecated, use `ghc-mod --interactive`
+-- This program is deprecated, use `ghc-mod legacy-interactive` instead.
--- instead.
-
--- Commands:
---  check <file>
---  find <symbol>
---  info <file> <expr>
---  type <file> <line> <column>
---  lint [hlint options] <file>
---     the format of hlint options is [String] because they may contain
---     spaces and also <file> may contain spaces.
---  boot
---  browse [<package>:]<module>
---  quit
---
--- Session separators:
---   OK -- success
---   NG -- failure
 
 module Main where
 
-import Config (cProjectVersion)
+import System.Exit
-import Control.Applicative ((<$>))
+import System.Process
-import Control.Exception (SomeException(..))
+import System.Environment
-import qualified Control.Exception as E
-import Control.Monad (when)
-import CoreMonad (liftIO)
-import Data.List (intercalate)
-import Data.List.Split (splitOn)
-import Data.Version (showVersion)
-import Language.Haskell.GhcMod
-import Language.Haskell.GhcMod.Internal
-import Paths_ghc_mod
-import System.Console.GetOpt
-import System.Directory (setCurrentDirectory)
-import System.Environment (getArgs)
-import System.Exit (ExitCode, exitFailure)
-import System.IO (hFlush,stdout)
-
-import Misc
-import Utils
-
-----------------------------------------------------------------
-
-progVersion :: String
-progVersion = "ghc-modi version " ++ showVersion version ++ " compiled by GHC " ++ cProjectVersion ++ "\n"
-
-argspec :: [OptDescr (Options -> Options)]
-argspec = [ Option "b" ["boundary"]
-            (ReqArg (\s opts -> opts { lineSeparator = LineSeparator s }) "sep")
-            "specify line separator (default is Nul string)"
-          , Option "l" ["tolisp"]
-            (NoArg (\opts -> opts { outputStyle = LispStyle }))
-            "print as a list of Lisp"
-          , Option "g" []
-            (ReqArg (\s opts -> opts { ghcUserOptions = s : ghcUserOptions opts }) "flag") "specify a ghc flag"
-          ]
-
-usage :: String
-usage =    progVersion
-        ++ "Usage:\n"
-        ++ "\t ghc-modi [-l] [-b sep] [-g flag]\n"
-        ++ "\t ghc-modi version\n"
-        ++ "\t ghc-modi help\n"
-
-parseArgs :: [OptDescr (Options -> Options)] -> [String] -> (Options, [String])
-parseArgs spec argv
-    = case getOpt Permute spec argv of
-        (o,n,[]  ) -> (foldr id defaultOptions o, n)
-        (_,_,errs) -> E.throw (CmdArg errs)
-
-----------------------------------------------------------------
-
--- Running two GHC monad threads disables the handling of
--- C-c since installSignalHandlers is called twice, sigh.
 
 main :: IO ()
-main = E.handle cmdHandler $
+main = do
-    go =<< parseArgs argspec <$> getArgs
+  args <- getArgs
-  where
+  h <- spawnProcess "ghc-mod" $ ["legacy-interactive"] ++ args
-    cmdHandler (CmdArg _) = putStr $ usageInfo usage argspec
+  exitWith =<< waitForProcess h
-    go (_,"help":_) = putStr $ usageInfo usage argspec
-    go (_,"version":_) = putStr progVersion
-    go (opt,_) = emptyNewUnGetLine >>= run opt
-
-run :: Options -> UnGetLine -> IO ()
-run opt ref = flip E.catches handlers $ do
-    cradle0 <- findCradle
-    let rootdir = cradleRootDir cradle0
---        c = cradle0 { cradleCurrentDir = rootdir } TODO: ?????
-    setCurrentDirectory rootdir
-    prepareAutogen cradle0
-    -- Asynchronous db loading starts here.
-    symdbreq <- newSymDbReq opt
-    (res, _) <- runGhcModT opt $ do
-        crdl <- cradle
-        world <- liftIO $ getCurrentWorld crdl
-        loop symdbreq ref world
-    case res of
-        Right () -> return ()
-        Left (GMECabalConfigure msg) -> do
-            putStrLn $ notGood $ "cabal configure failed: " ++ show msg
-            exitFailure
-        Left e -> bug $ show e
-  where
-    -- this is just in case.
-    -- If an error is caught here, it is a bug of GhcMod library.
-    handlers = [ E.Handler (\(_ :: ExitCode) -> return ())
-               , E.Handler (\(_ :: Restart) -> run opt ref)
-               , E.Handler (\(SomeException e) -> bug $ show e) ]
-
-bug :: String -> IO ()
-bug msg = do
-  putStrLn $ notGood $ "BUG: " ++ msg
-  exitFailure
-
-notGood :: String -> String
-notGood msg = "NG " ++ escapeNewlines msg
-
-escapeNewlines :: String -> String
-escapeNewlines = replace "\n" "\\n" . replace "\\n" "\\\\n"
-
-replace :: String -> String -> String -> String
-replace needle replacement = intercalate replacement . splitOn needle
-
-----------------------------------------------------------------
-
-loop :: IOish m => SymDbReq -> UnGetLine -> World -> GhcModT m ()
-loop symdbreq ref world = do
-    -- blocking
-    cmdArg <- liftIO $ getCommand ref
-    -- after blocking, we need to see if the world has changed.
-    crdl <- cradle
-    changed <- liftIO $ didWorldChange world crdl
-    when changed $ do
-        liftIO $ ungetCommand ref cmdArg
-        E.throw Restart
-    cradle >>= liftIO . prepareAutogen
-    let (cmd,arg') = break (== ' ') cmdArg
-        arg = dropWhile (== ' ') arg'
-    (ret,ok) <- case cmd of
-        "check"  -> checkStx arg
-        "find"   -> findSym arg symdbreq
-        "lint"   -> lintStx arg
-        "info"   -> showInfo arg
-        "type"   -> showType arg
-        "split"  -> doSplit arg
-        "sig"    -> doSig arg
-        "refine" -> doRefine arg
-        "auto"   -> doAuto arg
-        "boot"   -> bootIt
-        "browse" -> browseIt arg
-        "quit"   -> return ("quit", False)
-        ""       -> return ("quit", False)
-        _        -> return ([], True)
-    if ok then do
-        liftIO $ putStr ret
-        liftIO $ putStrLn "OK"
-      else do
-        liftIO $ putStrLn $ notGood ret
-    liftIO $ hFlush stdout
-    when ok $ loop symdbreq ref world
-
-----------------------------------------------------------------
-
-checkStx :: IOish m => FilePath -> GhcModT m (String, Bool)
-checkStx file = do
-    eret <- check [file]
-    case eret of
-        Right ret -> return (ret, True)
-        Left ret  -> return (ret, True)
-
-----------------------------------------------------------------
-
-findSym :: IOish m => Symbol -> SymDbReq -> GhcModT m (String, Bool)
-findSym sym symdbreq = do
-    db <- getDb symdbreq >>= checkDb symdbreq
-    ret <- lookupSymbol sym db
-    return (ret, True)
-
-lintStx :: IOish m => FilePath -> GhcModT m (String, Bool)
-lintStx optFile = do
-    ret <- withOptions changeOpt $ lint file
-    return (ret, True)
-  where
-    (opts,file) = parseLintOptions optFile
-    hopts = if opts == "" then [] else read opts
-    changeOpt o = o { hlintOpts = hopts }
-
--- |
--- >>> parseLintOptions "[\"--ignore=Use camelCase\", \"--ignore=Eta reduce\"] file name"
--- (["--ignore=Use camelCase", "--ignore=Eta reduce"], "file name")
--- >>> parseLintOptions "file name"
--- ([], "file name")
-parseLintOptions :: String -> (String, String)
-parseLintOptions optFile = case brk (== ']') (dropWhile (/= '[') optFile) of
-    ("","")      -> ([],   optFile)
-    (opt',file') -> (opt', dropWhile (== ' ') file')
-  where
-    brk _ []         =  ([],[])
-    brk p (x:xs')
-        | p x        =  ([x],xs')
-        | otherwise  =  let (ys,zs) = brk p xs' in (x:ys,zs)
-
-----------------------------------------------------------------
-
-showInfo :: IOish m => FilePath -> GhcModT m (String, Bool)
-showInfo fileArg = do
-    let [file, expr] = splitN 2 fileArg
-    ret <- info file expr
-    return (ret, True)
-
-showType :: IOish m => FilePath -> GhcModT m (String, Bool)
-showType fileArg  = do
-    let [file, line, column] = splitN 3 fileArg
-    ret <- types file (read line) (read column)
-    return (ret, True)
-
-doSplit :: IOish m => FilePath -> GhcModT m (String, Bool)
-doSplit fileArg  = do
-    let [file, line, column] = splitN 3 fileArg
-    ret <- splits file (read line) (read column)
-    return (ret, True)
-
-doSig :: IOish m => FilePath -> GhcModT m (String, Bool)
-doSig fileArg  = do
-    let [file, line, column] = splitN 3 fileArg
-    ret <- sig file (read line) (read column)
-    return (ret, True)
-
-doRefine :: IOish m => FilePath -> GhcModT m (String, Bool)
-doRefine fileArg  = do
-    let [file, line, column, expr] = splitN 4 fileArg
-    ret <- refine file (read line) (read column) expr
-    return (ret, True)
-
-doAuto :: IOish m => FilePath -> GhcModT m (String, Bool)
-doAuto fileArg  = do
-    let [file, line, column] = splitN 3 fileArg
-    ret <- auto file (read line) (read column)
-    return (ret, True)
-
-----------------------------------------------------------------
-
-bootIt :: IOish m => GhcModT m (String, Bool)
-bootIt = do
-    ret <- boot
-    return (ret, True)
-
-browseIt :: IOish m => ModuleString -> GhcModT m (String, Bool)
-browseIt mdl = do
-    let (det,rest') = break (== ' ') mdl
-        rest = dropWhile (== ' ') rest'
-    ret <- if det == "-d"
-               then withOptions setDetailed (browse rest)
-               else browse mdl
-    return (ret, True)
-  where
-    setDetailed opt = opt { detailed = True }

src/Misc.hs

@@ -11,22 +11,14 @@ module Misc (
   , newSymDbReq
   , getDb
   , checkDb
-  , prepareAutogen
   ) where
 
 import Control.Applicative ((<$>))
-import Control.Concurrent (threadDelay)
 import Control.Concurrent.Async (Async, async, wait)
 import Control.Exception (Exception)
-import Control.Monad (unless, when)
 import CoreMonad (liftIO)
 import Data.IORef (IORef, newIORef, readIORef, writeIORef)
-import Data.List (isPrefixOf)
-import Data.Maybe (isJust)
 import Data.Typeable (Typeable)
-import System.Directory (doesDirectoryExist, getDirectoryContents)
-import System.IO (openBinaryFile, IOMode(..))
-import System.Process
 
 import Language.Haskell.GhcMod
 import Language.Haskell.GhcMod.Internal
@@ -92,63 +84,3 @@ checkDb (SymDbReq ref act) db = do
         hoistGhcModT =<< liftIO (wait req)
       else
         return db
-
-----------------------------------------------------------------
-
-build :: IO ProcessHandle
-build = do
-#ifdef WINDOWS
-    nul <- openBinaryFile "NUL" AppendMode
-#else
-    nul <- openBinaryFile "/dev/null" AppendMode
-#endif
-    (_, _, _, hdl) <- createProcess $ pro nul
-    return hdl
- where
-   pro nul = CreateProcess {
-       cmdspec = RawCommand "cabal" ["build"]
-     , cwd = Nothing
-     , env = Nothing
-     , std_in = Inherit
-     , std_out = UseHandle nul
-     , std_err = UseHandle nul
-     , close_fds = False
-#if __GLASGOW_HASKELL__ >= 702
-      , create_group = True
-#endif
-#if __GLASGOW_HASKELL__ >= 707
-      , delegate_ctlc = False
-#endif
-     }
-
-autogen :: String
-autogen = "dist/build/autogen"
-
-isAutogenPrepared :: IO Bool
-isAutogenPrepared = do
-    exist <- doesDirectoryExist autogen
-    if exist then do
-        files <- filter ("." `isPrefixOf`) <$> getDirectoryContents autogen
-        if length files >= 2 then
-            return True
-          else
-            return False
-      else
-        return False
-
-watch :: Int -> ProcessHandle -> IO ()
-watch 0 _ = return ()
-watch n hdl = do
-    prepared <- isAutogenPrepared
-    if prepared then
-        interruptProcessGroupOf hdl
-      else do
-        threadDelay 100000
-        watch (n - 1) hdl
-
-prepareAutogen :: Cradle -> IO ()
-prepareAutogen crdl = when (isJust $ cradleCabalFile crdl) $ do
-    prepared <- isAutogenPrepared
-    unless prepared $ do
-        hdl <- build
-        watch 30 hdl