From 4764ff1acba4202faaf530f3cc6fb5890074de8f Mon Sep 17 00:00:00 2001
From: Kazu Yamamoto <kazu@iij.ad.jp>
Date: Mon, 21 Apr 2014 16:30:31 +0900
Subject: [PATCH] ghc-modi boot.

---
 Language/Haskell/GhcMod/Browse.hs |  8 ++++----
 Language/Haskell/GhcMod/List.hs   | 11 ++++++-----
 src/Boot.hs                       | 14 +++++++++++++-
 src/GHCModi.hs                    | 15 +++++++++++++++
 4 files changed, 38 insertions(+), 10 deletions(-)

diff --git a/Language/Haskell/GhcMod/Browse.hs b/Language/Haskell/GhcMod/Browse.hs
index 34d1b7f..2b03870 100644
--- a/Language/Haskell/GhcMod/Browse.hs
+++ b/Language/Haskell/GhcMod/Browse.hs
@@ -31,17 +31,17 @@ browseModule :: Options
              -> Cradle
              -> ModuleString -- ^ A module name. (e.g. \"Data.List\")
              -> IO String
-browseModule opt cradle mdlName = withGHCDummyFile (browse opt cradle mdlName)
+browseModule opt cradle mdlName = withGHCDummyFile $ do
+    void $ initializeFlagsWithCradle opt cradle [] False
+    browse opt mdlName
 
 -- | Getting functions, classes, etc from a module.
 --   If 'detailed' is 'True', their types are also obtained.
 --   If 'operators' is 'True', operators are also returned.
 browse :: Options
-       -> Cradle
        -> ModuleString -- ^ A module name. (e.g. \"Data.List\")
        -> Ghc String
-browse opt cradle mdlName = do
-    void $ initializeFlagsWithCradle opt cradle [] False
+browse opt mdlName = do
     convert opt . sort <$> (getModule >>= G.getModuleInfo >>= listExports)
   where
     getModule = G.findModule mdlname mpkgid `G.gcatch` fallback
diff --git a/Language/Haskell/GhcMod/List.hs b/Language/Haskell/GhcMod/List.hs
index f2ee3f3..33cf887 100644
--- a/Language/Haskell/GhcMod/List.hs
+++ b/Language/Haskell/GhcMod/List.hs
@@ -14,14 +14,15 @@ import UniqFM (eltsUFM)
 
 -- | Listing installed modules.
 listModules :: Options -> Cradle -> IO String
-listModules opt cradle = withGHCDummyFile (modules opt cradle)
+listModules opt cradle = withGHCDummyFile $ do
+    void $ initializeFlagsWithCradle opt cradle [] False
+    modules opt
 
 -- | Listing installed modules.
-modules :: Options -> Cradle -> Ghc String
-modules opt cradle = do
-    void $ initializeFlagsWithCradle opt cradle [] False
-    convert opt . nub . sort . map dropPkgs . getExposedModules <$> G.getSessionDynFlags
+modules :: Options -> Ghc String
+modules opt = convert opt . arrange <$> G.getSessionDynFlags
   where
+    arrange = nub . sort . map dropPkgs . getExposedModules
     getExposedModules = concatMap exposedModules'
                       . eltsUFM . pkgIdMap . G.pkgState
     exposedModules' p =
diff --git a/src/Boot.hs b/src/Boot.hs
index 629cd2d..cfeb796 100644
--- a/src/Boot.hs
+++ b/src/Boot.hs
@@ -1,7 +1,10 @@
 module Boot where
 
-import Language.Haskell.GhcMod
 import Control.Applicative ((<$>))
+import CoreMonad (liftIO)
+import GHC (Ghc)
+import Language.Haskell.GhcMod
+import Language.Haskell.GhcMod.Ghc
 
 boot :: Options -> Cradle -> IO String
 boot opt cradle = do
@@ -12,6 +15,15 @@ boot opt cradle = do
     pre   <- concat <$> mapM (browseModule opt' cradle) preBrowsedModules
     return $ mods ++ langs ++ flags ++ pre
 
+boot' :: Options -> Ghc String
+boot' opt = do
+    mods  <- modules opt
+    langs <- liftIO $ listLanguages opt
+    flags <- liftIO $ listFlags opt
+    let opt' = addPackages opt
+    pre   <- concat <$> mapM (browse opt') preBrowsedModules
+    return $ mods ++ langs ++ flags ++ pre
+
 preBrowsedModules :: [String]
 preBrowsedModules = [
     "Prelude"
diff --git a/src/GHCModi.hs b/src/GHCModi.hs
index d770e95..c32de7a 100644
--- a/src/GHCModi.hs
+++ b/src/GHCModi.hs
@@ -9,6 +9,7 @@
 --  lint [hlint options] <file>
 --     the format of hlint options is [String] because they may contain
 --     spaces and aslo <file> may contain spaces.
+--  boot
 --
 -- Session separators:
 --   OK -- success
@@ -53,6 +54,8 @@ import System.Directory (setCurrentDirectory)
 import System.Environment (getArgs)
 import System.IO (hFlush,stdout)
 
+import Boot
+
 ----------------------------------------------------------------
 
 type DB = Map String [String]
@@ -158,6 +161,7 @@ loop opt set mvar readLog  = do
         "lint"  -> lintStx  opt set arg
         "info"  -> showInfo opt set arg readLog
         "type"  -> showType opt set arg readLog
+        "boot"  -> bootIt   opt set
         _       -> return ([], False, set)
     let put = case outputStyle opt of
             LispStyle  -> putStr
@@ -244,6 +248,8 @@ parseLintOptions optFile = case brk (== ']') (dropWhile (/= '[') optFile) of
         | p x        =  ([x],xs')
         | otherwise  =  let (ys,zs) = brk p xs' in (x:ys,zs)
 
+----------------------------------------------------------------
+
 showInfo :: Options
          -> Set FilePath
          -> FilePath
@@ -267,3 +273,12 @@ showType opt set fileArg readLog = do
     ret <- types opt file (read line) (read column)
     _ <- liftIO readLog
     return (ret, True, set')
+
+----------------------------------------------------------------
+
+bootIt :: Options
+       -> Set FilePath
+       -> Ghc (String, Bool, Set FilePath)
+bootIt opt set = do
+    ret <- boot' opt
+    return (ret, True, set)