module HsDev.Scan (
enumCabal, CompileFlag, ModuleToScan, ProjectToScan, SandboxToScan, ScanContents(..),
enumProject, enumDirectory,
scanProjectFile,
scanModule, scanModify, upToDate, rescanModule, changedModule, changedModules,
module HsDev.Database,
module HsDev.Symbols.Types,
module Control.Monad.Except,
) where
import Control.Applicative ((<|>))
import Control.DeepSeq
import Control.Lens (view, preview, set, _Right, _1, _2, _3, (^.))
import Control.Monad.Except
import Data.Maybe (catMaybes, fromMaybe, isJust)
import System.Directory
import HsDev.Scan.Browse (browsePackages)
import HsDev.Symbols
import HsDev.Symbols.Types
import HsDev.Database
import HsDev.Tools.GhcMod
import HsDev.Inspect
import HsDev.Util
enumCabal :: [String] -> Cabal -> ExceptT String IO [ModuleLocation]
enumCabal = list
type CompileFlag = String
type ModuleToScan = (ModuleLocation, [CompileFlag], Maybe String)
type ProjectToScan = (Project, [ModuleToScan])
type SandboxToScan = Cabal
data ScanContents = ScanContents {
modulesToScan :: [ModuleToScan],
projectsToScan :: [ProjectToScan],
sandboxesToScan :: [SandboxToScan] }
instance NFData ScanContents where
rnf (ScanContents ms ps ss) = rnf ms `seq` rnf ps `seq` rnf ss
enumProject :: Project -> ExceptT String IO ProjectToScan
enumProject p = do
p' <- loadProject p
cabal <- liftE $ searchSandbox (view projectPath p')
pkgs <- liftM (map $ view packageName) $ browsePackages [] cabal
let
projOpts :: FilePath -> [String]
projOpts f = concatMap makeOpts $ fileTargets p' f where
makeOpts :: Info -> [String]
makeOpts i = concat [
["-hide-all-packages"],
["-package " ++ view projectName p'],
["-package " ++ dep | dep <- view infoDepends i, dep `elem` pkgs]]
srcs <- projectSources p'
return (p', [(FileModule (view entity src) (Just p'), extensionsOpts src ++ projOpts (view entity src), Nothing) | src <- srcs])
enumDirectory :: FilePath -> ExceptT String IO ScanContents
enumDirectory dir = do
cts <- liftException $ traverseDirectory dir
let
projects = filter cabalFile cts
sources = filter haskellSource cts
dirs <- liftE $ filterM doesDirectoryExist cts
sboxes <- liftM catMaybes $ triesMap (liftE . findPackageDb) dirs
projs <- triesMap (enumProject . project) projects
let
projPaths = map (view projectPath . fst) projs
standalone = map (`FileModule` Nothing) $ filter (\s -> not (any (`isParent` s) projPaths)) sources
return ScanContents {
modulesToScan = [(s, [], Nothing) | s <- standalone],
projectsToScan = projs,
sandboxesToScan = map Sandbox sboxes }
scanProjectFile :: [String] -> FilePath -> ExceptT String IO Project
scanProjectFile _ f = do
proj <- (liftE $ locateProject f) >>= maybe (throwError "Can't locate project") return
loadProject proj
scanModule :: [(String, String)] -> [String] -> ModuleLocation -> Maybe String -> ExceptT String IO InspectedModule
scanModule defines opts (FileModule f p) mcts = liftM setProj $ inspectFile defines opts f mcts where
setProj =
set (inspectedId . moduleProject) p .
set (inspectionResult . _Right . moduleLocation . moduleProject) p
scanModule _ opts (CabalModule c p n) _ = browse opts c n p
scanModule _ _ (ModuleSource _) _ = throwError "Can inspect only modules in file or cabal"
scanModify :: ([String] -> Cabal -> Module -> ExceptT String IO Module) -> InspectedModule -> ExceptT String IO InspectedModule
scanModify f im = traverse f' im <|> return im where
f' = f (fromMaybe [] $ preview (inspection . inspectionOpts) im) Cabal
upToDate :: [String] -> InspectedModule -> ExceptT String IO Bool
upToDate opts (Inspected insp m _) = case m of
FileModule f _ -> liftM (== insp) $ fileInspection f opts
CabalModule _ _ _ -> return $ insp == browseInspection opts
_ -> return False
rescanModule :: [(String, String)] -> [String] -> InspectedModule -> ExceptT String IO (Maybe InspectedModule)
rescanModule defines opts im = do
up <- upToDate opts im
if up
then return Nothing
else fmap Just $ scanModule defines opts (view inspectedId im) Nothing
changedModule :: Database -> [String] -> ModuleLocation -> ExceptT String IO Bool
changedModule db opts m = maybe (return True) (liftM not . upToDate opts) m' where
m' = lookupInspected m db
changedModules :: Database -> [String] -> [ModuleToScan] -> ExceptT String IO [ModuleToScan]
changedModules db opts = filterM $ \m -> if isJust (m ^. _3)
then return True
else changedModule db (opts ++ (m ^. _2)) (m ^. _1)