f0bfcb8811
Not doing this makes having GhcModT pretty pointless as users of the library wouldn't be able to use custom inner monads as evey function for dealing with GhcModT's would be constraint to (GhcModT IO) thus only allowing IO as the inner monad.
58 lines
1.7 KiB
Haskell
58 lines
1.7 KiB
Haskell
{-# LANGUAGE CPP, BangPatterns #-}
|
|
|
|
module Language.Haskell.GhcMod.Find where
|
|
|
|
import Data.Function (on)
|
|
import Data.List (groupBy, sort)
|
|
import Data.Maybe (fromMaybe)
|
|
import qualified GHC as G
|
|
import Language.Haskell.GhcMod.Browse (browseAll)
|
|
import Language.Haskell.GhcMod.Monad
|
|
import Language.Haskell.GhcMod.Convert
|
|
import Language.Haskell.GhcMod.Types
|
|
|
|
#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 Control.Applicative ((<$>))
|
|
|
|
-- | Type of key for `SymMdlDb`.
|
|
type Symbol = String
|
|
-- | Database from 'Symbol' to modules.
|
|
newtype SymMdlDb = SymMdlDb (Map Symbol [ModuleString])
|
|
|
|
-- | Finding modules to which the symbol belong.
|
|
findSymbol :: IOish m => Symbol -> GhcModT m String
|
|
findSymbol sym = convert' =<< lookupSym sym <$> getSymMdlDb
|
|
|
|
-- | Creating 'SymMdlDb'.
|
|
getSymMdlDb :: IOish m => GhcModT m 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 :: Symbol -> SymMdlDb -> [ModuleString]
|
|
lookupSym sym (SymMdlDb db) = fromMaybe [] (M.lookup sym db)
|
|
|
|
lookupSym' :: Options -> Symbol -> SymMdlDb -> String
|
|
lookupSym' opt sym db = convert opt $ lookupSym sym db
|