module HsDev.Commands (
findDeclaration, findModule,
fileModule,
lookupSymbol,
whois,
scopeModules, scope,
completions,
moduleCompletions,
checkModule, checkDeclaration, restrictCabal, visibleFrom,
splitIdentifier,
fileCtx, fileCtxMaybe
) where
import Control.Applicative
import Control.Arrow (Arrow(second))
import Control.Monad.Error
import Data.List
import Data.Maybe
import qualified Data.Map as M (lookup)
import Data.Traversable (traverse)
import System.Directory (canonicalizePath)
import HsDev.Database
import HsDev.Project
import HsDev.Symbols
import HsDev.Symbols.Util
findDeclaration :: Database -> String -> ErrorT String IO [ModuleDeclaration]
findDeclaration db ident = return $ selectDeclarations checkName db where
checkName :: ModuleDeclaration -> Bool
checkName m =
(declarationName (moduleDeclaration m) == iname) &&
(maybe True (moduleIdName (declarationModuleId m) ==) qname)
(qname, iname) = splitIdentifier ident
findModule :: Database -> String -> ErrorT String IO [Module]
findModule db mname = return $ selectModules ((== mname) . moduleName) db
fileModule :: Database -> FilePath -> ErrorT String IO Module
fileModule db src = do
src' <- liftIO $ canonicalizePath src
maybe (throwError $ "File '" ++ src' ++ "' not found") return $ lookupFile src' db
getProject :: Database -> Project -> ErrorT String IO Project
getProject db p = do
p' <- liftIO $ canonicalizePath $ projectCabal p
maybe (throwError $ "Project " ++ p' ++ " not found") return $
M.lookup p' $ databaseProjects db
lookupSymbol :: Database -> Cabal -> FilePath -> String -> ErrorT String IO [ModuleDeclaration]
lookupSymbol db cabal file ident = do
(_, mthis, mproj) <- fileCtx db file
liftM
(filter $ checkModule $ allOf [
restrictCabal cabal,
visibleFrom mproj mthis,
maybe (const True) inModule qname])
(findDeclaration db iname)
where
(qname, iname) = splitIdentifier ident
whois :: Database -> Cabal -> FilePath -> String -> ErrorT String IO [ModuleDeclaration]
whois db cabal file ident = do
(_, mthis, _) <- fileCtx db file
liftM
(filter $ checkModule $ allOf [
restrictCabal cabal,
inScope mthis qname])
(findDeclaration db iname)
where
(qname, iname) = splitIdentifier ident
scopeModules :: Database -> Cabal -> FilePath -> ErrorT String IO [Module]
scopeModules db cabal file = do
(file', mthis, mproj) <- fileCtxMaybe db file
case mproj of
Nothing -> return $ maybe id (:) mthis $ selectModules (inCabal cabal . moduleId) db
Just proj -> let deps' = deps file' proj in
return $ concatMap (\p -> selectModules (p . moduleId) db) [
inProject proj,
\m -> any (`inPackage` m) deps']
where
deps f p = maybe [] infoDepends $ fileTarget p f
scope :: Database -> Cabal -> FilePath -> Bool -> ErrorT String IO [ModuleDeclaration]
scope db cabal file False = do
(_, mthis, _) <- fileCtx db file
depModules <- liftM (filter ((`imported` (moduleImports' mthis)) . moduleId)) $
scopeModules db cabal file
return $ concatMap moduleModuleDeclarations $ mthis : depModules
scope db cabal file True = concatMap moduleModuleDeclarations <$> scopeModules db cabal file
completions :: Database -> Cabal -> FilePath -> String -> ErrorT String IO [ModuleDeclaration]
completions db cabal file prefix = do
(_, mthis, _) <- fileCtx db file
decls <- scope db cabal file False
return [decl |
decl <- decls,
imp <- filter ((== moduleIdName (declarationModuleId decl)) . importModuleName) $
moduleImports' mthis,
qname `elem` catMaybes [
if not (importIsQualified imp) then Just Nothing else Nothing,
Just $ Just $ importModuleName imp,
fmap Just $ importAs imp],
iname `isPrefixOf` (declarationName . moduleDeclaration $ decl)]
where
(qname, iname) = splitIdentifier prefix
moduleCompletions :: Database -> [Module] -> String -> ErrorT String IO [String]
moduleCompletions _ ms prefix = return $ nub $ completions' $ map moduleName ms where
completions' = mapMaybe getNext where
getNext m
| prefix `isPrefixOf` m = listToMaybe $ map snd $ dropWhile (uncurry (==)) $ zip (splitBy '.' prefix) (splitBy '.' m)
| otherwise = Nothing
checkModule :: (ModuleId -> Bool) -> (ModuleDeclaration -> Bool)
checkModule = (. declarationModuleId)
checkDeclaration :: (Declaration -> Bool) -> (ModuleDeclaration -> Bool)
checkDeclaration = (. moduleDeclaration)
restrictCabal :: Cabal -> ModuleId -> Bool
restrictCabal cabal m = inCabal cabal m || not (byCabal m)
visibleFrom :: Maybe Project -> Module -> ModuleId -> Bool
visibleFrom (Just p) this m = visible p (moduleId this) m
visibleFrom Nothing this m = (moduleId this) == m || byCabal m
splitBy :: Char -> String -> [String]
splitBy ch = takeWhile (not . null) . unfoldr (Just . second (drop 1) . break (== ch))
moduleImports' :: Module -> [Import]
moduleImports' m = Import "Prelude" False Nothing Nothing : Import (moduleName m) False Nothing Nothing : moduleImports m
splitIdentifier :: String -> (Maybe String, String)
splitIdentifier name = (qname, name') where
prefix = dropWhileEnd (/= '.') name
prefix' = dropWhileEnd (== '.') prefix
qname = if null prefix' then Nothing else Just prefix'
name' = fromMaybe (error "Impossible happened") $ stripPrefix prefix name
fileCtx :: Database -> FilePath -> ErrorT String IO (FilePath, Module, Maybe Project)
fileCtx db file = do
file' <- liftIO $ canonicalizePath file
mthis <- fileModule db file'
mproj <- traverse (getProject db) $ projectOf $ moduleId mthis
return (file', mthis, mproj)
fileCtxMaybe :: Database -> FilePath -> ErrorT String IO (FilePath, Maybe Module, Maybe Project)
fileCtxMaybe db file = ((\(f, m, p) -> (f, Just m, p)) <$> fileCtx db file) <|> onlyProj where
onlyProj = do
file' <- liftIO $ canonicalizePath file
mproj <- liftIO $ locateProject file'
mproj' <- traverse (getProject db) mproj
return (file', Nothing, mproj')