find functions went to lib.

Language/Haskell/GhcMod/Find.hs

@@ -0,0 +1,49 @@
+{-# LANGUAGE CPP, BangPatterns #-}
+
+module Language.Haskell.GhcMod.Find where
+
+import Data.Function (on)
+import Data.List (groupBy, sort)
+import Data.Maybe (fromMaybe)
+import GHC (Ghc)
+import qualified GHC as G
+import Language.Haskell.GhcMod
+import Language.Haskell.GhcMod.Browse (browseAll)
+import Language.Haskell.GhcMod.Types (convert)
+
+#ifndef MIN_VERSION_containers
+#define MIN_VERSION_containers(x,y,z) 1
+#endif
+
+#if MIN_VERSION_containers(0,5,0)
+import Control.DeepSeq (force)
+import Data.Map.Strict (Map)
+import qualified Data.Map.Strict as M
+#else
+import Data.Map (Map)
+import qualified Data.Map as M
+#endif
+
+-- | Type of key for `SymMdlDb`.
+type Symbol = String
+-- | Database from 'Symbol' to modules.
+newtype SymMdlDb = SymMdlDb (Map Symbol [ModuleString])
+
+-- | Creating 'SymMdlDb'.
+getSymMdlDb :: Ghc SymMdlDb
+getSymMdlDb = do
+    sm <- G.getSessionDynFlags >>= browseAll
+#if MIN_VERSION_containers(0,5,0)
+    let !sms = force $ map tieup $ groupBy ((==) `on` fst) $ sort sm
+        !m = force $ M.fromList sms
+#else
+    let !sms = map tieup $ groupBy ((==) `on` fst) $ sort sm
+        !m = M.fromList sms
+#endif
+    return (SymMdlDb m)
+  where
+    tieup x = (head (map fst x), map snd x)
+
+-- | Looking up 'SymMdlDb' with 'Symbol' to find modules.
+lookupSym :: Options -> Symbol -> SymMdlDb -> String
+lookupSym opt sym (SymMdlDb db) = convert opt $ fromMaybe [] (M.lookup sym db)

Language/Haskell/GhcMod/Ghc.hs

@@ -8,10 +8,16 @@ module Language.Haskell.GhcMod.Ghc (
   , info
   , types
   , modules
+  -- * 'SymMdlDb'
+  , Symbol
+  , SymMdlDb
+  , getSymMdlDb
+  , lookupSym
   ) where
 
 import Language.Haskell.GhcMod.Browse
 import Language.Haskell.GhcMod.Check
+import Language.Haskell.GhcMod.Find
 import Language.Haskell.GhcMod.GHCApi
 import Language.Haskell.GhcMod.Info
 import Language.Haskell.GhcMod.List

Language/Haskell/GhcMod/Internal.hs

@@ -26,18 +26,14 @@ module Language.Haskell.GhcMod.Internal (
   , setTargetFiles
   , addTargetFiles
   , handleErrMsg
-  , browseAll
   -- * 'Ghc' Choice
   , (||>)
   , goNext
   , runAnyOne
   -- * 'GhcMonad' Choice
   , (|||>)
-  -- * Misc
-  , convert
   ) where
 
-import Language.Haskell.GhcMod.Browse
 import Language.Haskell.GhcMod.CabalApi
 import Language.Haskell.GhcMod.ErrMsg
 import Language.Haskell.GhcMod.GHCApi

ghc-mod.cabal

@@ -57,6 +57,7 @@ Library
                         Language.Haskell.GhcMod.ErrMsg
                         Language.Haskell.GhcMod.Flag
                         Language.Haskell.GhcMod.GHCApi
+                        Language.Haskell.GhcMod.Find
                         Language.Haskell.GhcMod.GHCChoice
                         Language.Haskell.GhcMod.Gap
                         Language.Haskell.GhcMod.GhcPkg
@@ -69,6 +70,7 @@ Library
                         Language.Haskell.GhcMod.Types
   Build-Depends:        base >= 4.0 && < 5
                       , containers
+                      , deepseq
                       , directory
                       , filepath
                       , ghc
@@ -108,7 +110,6 @@ Executable ghc-modi
   HS-Source-Dirs:       src
   Build-Depends:        base >= 4.0 && < 5
                       , containers
-                      , deepseq
                       , directory
                       , filepath
                       , ghc

src/GHCModi.hs

@@ -1,4 +1,3 @@
-{-# LANGUAGE CPP, BangPatterns #-}
 {-# LANGUAGE DeriveDataTypeable #-}
 
 -- Commands:
@@ -24,8 +23,7 @@ import Control.Exception (SomeException(..), Exception)
 import qualified Control.Exception as E
 import Control.Monad (when, void)
 import CoreMonad (liftIO)
-import Data.Function (on)
+import Data.List (find)
-import Data.List (groupBy, sort, find)
 import Data.Maybe (fromMaybe)
 import Data.Set (Set)
 import qualified Data.Set as S
@@ -44,24 +42,10 @@ import System.Directory (setCurrentDirectory)
 import System.Environment (getArgs)
 import System.IO (hFlush,stdout)
 
-#ifndef MIN_VERSION_containers
-#define MIN_VERSION_containers(x,y,z) 1
-#endif
-
-#if MIN_VERSION_containers(0,5,0)
-import Control.DeepSeq (force)
-import Data.Map.Strict (Map)
-import qualified Data.Map.Strict as M
-#else
-import Data.Map (Map)
-import qualified Data.Map as M
-#endif
-
 import Boot
 
 ----------------------------------------------------------------
 
-type DB = Map String [String]
 type Logger = IO String
 
 ----------------------------------------------------------------
@@ -119,9 +103,7 @@ main = E.handle cmdHandler $
       where
         -- this is just in case.
         -- If an error is caught here, it is a bug of GhcMod library.
-        someHandler (SomeException e) = do
+        someHandler (SomeException _) = do
-            let ret = convert opt $ "ghc-modi:0:0:" ++ show e
-            putStr ret
             putStrLn "NG"
 
 ----------------------------------------------------------------
@@ -134,24 +116,16 @@ run cradle mlibdir opt body = G.runGhc mlibdir $ do
 
 ----------------------------------------------------------------
 
-setupDB :: Cradle -> Maybe FilePath -> Options -> MVar DB -> IO ()
+setupDB :: Cradle -> Maybe FilePath -> Options -> MVar SymMdlDb -> IO ()
 setupDB cradle mlibdir opt mvar = E.handle handler $ do
-    sm <- run cradle mlibdir opt $ \_ -> G.getSessionDynFlags >>= browseAll
+    db <- run cradle mlibdir opt $ \_ -> getSymMdlDb
-#if MIN_VERSION_containers(0,5,0)
+    putMVar mvar db
-    let !sms = force $ map tieup $ groupBy ((==) `on` fst) $ sort sm
-        !m = force $ M.fromList sms
-#else
-    let !sms = map tieup $ groupBy ((==) `on` fst) $ sort sm
-        !m = M.fromList sms
-#endif
-    putMVar mvar m
   where
-    tieup x = (head (map fst x), map snd x)
+    handler (SomeException _) = return () -- fixme: put emptyDb?
-    handler (SomeException _) = return ()
 
 ----------------------------------------------------------------
 
-loop :: Options -> Set FilePath -> MVar DB -> Logger -> Ghc ()
+loop :: Options -> Set FilePath -> MVar SymMdlDb -> Logger -> Ghc ()
 loop opt set mvar readLog  = do
     cmdArg <- liftIO getLine
     let (cmd,arg') = break (== ' ') cmdArg
@@ -211,11 +185,11 @@ checkStx opt set file readLog = do
                     return $ Just mainfile
     isMain m = G.moduleNameString (G.moduleName (G.ms_mod m)) == "Main"
 
-findSym :: Options -> Set FilePath -> String -> MVar DB
+findSym :: Options -> Set FilePath -> String -> MVar SymMdlDb
         -> Ghc (String, Bool, Set FilePath)
 findSym opt set sym mvar = do
     db <- liftIO $ readMVar mvar
-    let ret = convert opt $ fromMaybe [] (M.lookup sym db) -- fixme
+    let ret = lookupSym opt sym db
     return (ret, True, set)
 
 lintStx :: Options -> Set FilePath -> FilePath