module HsDev.Scan ( -- * Enumerate functions enumCabal, CompileFlag, ModuleToScan, ProjectToScan, SandboxToScan, ScanContents(..), enumProject, enumDirectory, -- * Scan scanProjectFile, scanModule, scanModify, upToDate, rescanModule, changedModule, changedModules, -- * Reexportss 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 -- | Enum cabal modules enumCabal :: [String] -> Cabal -> ExceptT String IO [ModuleLocation] enumCabal = list -- | Compile flags type CompileFlag = String -- | Module with flags ready to scan type ModuleToScan = (ModuleLocation, [CompileFlag], Maybe String) -- | Project ready to scan type ProjectToScan = (Project, [ModuleToScan]) -- | Cabal sandbox to scan type SandboxToScan = Cabal -- | Scan info 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 -- | Enum project sources 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]) -- | Enum directory modules 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 } -- | Scan project file scanProjectFile :: [String] -> FilePath -> ExceptT String IO Project scanProjectFile _ f = do proj <- (liftE $ locateProject f) >>= maybe (throwError "Can't locate project") return loadProject proj -- | Scan module 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 (FileModule f _) = inspectFile opts f >>= traverse infer' where -- infer' m = tryInfer <|> return m where -- tryInfer = mapExceptT (withCurrentDirectory (sourceModuleRoot (moduleName m) f)) $ -- runGhcMod defaultOptions $ inferTypes opts Cabal m scanModule _ opts (CabalModule c p n) _ = browse opts c n p scanModule _ _ (ModuleSource _) _ = throwError "Can inspect only modules in file or cabal" -- | Scan additional info and modify scanned module. Dones't fail on error, just left module unchanged scanModify :: ([String] -> Cabal -> Module -> ExceptT String IO Module) -> InspectedModule -> ExceptT String IO InspectedModule scanModify f im = traverse f' im <|> return im where -- TODO: Get actual sandbox f' = f (fromMaybe [] $ preview (inspection . inspectionOpts) im) Cabal -- | Is inspected module up to date? 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 -- | Rescan inspected module 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 -- | Is module new or recently changed 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 -- | Returns new (to scan) and changed (to rescan) modules 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)