ghc-mod/Language/Haskell/GhcMod/Find.hs

57 lines
1.6 KiB
Haskell
Raw Normal View History

2014-04-24 08:02:50 +00:00
{-# 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.Browse (browseAll)
2014-04-24 12:08:45 +00:00
import Language.Haskell.GhcMod.GHCApi
2014-05-14 16:05:40 +00:00
import Language.Haskell.GhcMod.Monad
2014-05-11 22:40:00 +00:00
import Language.Haskell.GhcMod.Convert
2014-04-24 12:08:45 +00:00
import Language.Haskell.GhcMod.Types
2014-04-24 08:02:50 +00:00
#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
2014-04-24 12:08:45 +00:00
import Control.Applicative ((<$>))
2014-04-24 08:02:50 +00:00
-- | Type of key for `SymMdlDb`.
type Symbol = String
-- | Database from 'Symbol' to modules.
newtype SymMdlDb = SymMdlDb (Map Symbol [ModuleString])
2014-04-30 01:51:34 +00:00
-- | Finding modules to which the symbol belong.
2014-05-14 16:05:40 +00:00
findSymbol :: Symbol -> GhcMod String
findSymbol sym = convert' =<< lookupSym sym <$> getSymMdlDb
2014-04-24 12:08:45 +00:00
2014-04-24 08:02:50 +00:00
-- | Creating 'SymMdlDb'.
2014-05-14 16:05:40 +00:00
getSymMdlDb :: GhcMod SymMdlDb
2014-04-24 08:02:50 +00:00
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.
2014-05-14 16:05:40 +00:00
lookupSym :: Symbol -> SymMdlDb -> [ModuleString]
lookupSym sym (SymMdlDb db) = fromMaybe [] (M.lookup sym db)