module HsDev.Symbols.Util ( projectOf, cabalOf, packageOf, inProject, inDepsOf, inCabal, inPackage, inVersion, inFile, inModuleSource, inModule, byFile, byCabal, standalone, imports, qualifier, imported, visible, inScope, newestPackage, sourceModule, visibleModule, preferredModule, uniqueModules, allOf, anyOf ) where import Control.Arrow ((***), (&&&), first) import Data.Function (on) import Data.Maybe import Data.List (maximumBy, groupBy, sortBy, partition) import Data.Ord (comparing) import Data.String (fromString) import System.FilePath (normalise) import HsDev.Symbols import HsDev.Project -- | Get module project projectOf :: ModuleId -> Maybe Project projectOf m = case moduleIdLocation m of FileModule _ proj -> proj _ -> Nothing -- | Get module cabal cabalOf :: ModuleId -> Maybe Cabal cabalOf m = case moduleIdLocation m of CabalModule c _ _ -> Just c _ -> Nothing -- | Get module package packageOf :: ModuleId -> Maybe ModulePackage packageOf m = case moduleIdLocation m of CabalModule _ package _ -> package _ -> Nothing -- | Check if module in project inProject :: Project -> ModuleId -> Bool inProject p m = projectOf m == Just p -- | Check if module in deps of project target inDepsOf :: Info -> ModuleId -> Bool inDepsOf i m = any (`inPackage` m) $ infoDepends i -- | Check if module in cabal inCabal :: Cabal -> ModuleId -> Bool inCabal c m = case moduleIdLocation m of CabalModule cabal _ _ -> cabal == c _ -> False -- | Check if module in package inPackage :: String -> ModuleId -> Bool inPackage p m = case moduleIdLocation m of CabalModule _ package _ -> Just p == fmap packageName package _ -> False inVersion :: String -> ModuleId -> Bool inVersion v m = case moduleIdLocation m of CabalModule _ package _ -> Just v == fmap packageVersion package _ -> False -- | Check if module in file inFile :: FilePath -> ModuleId -> Bool inFile fpath m = case moduleIdLocation m of FileModule f _ -> f == normalise fpath _ -> False -- | Check if module in source inModuleSource :: Maybe String -> ModuleId -> Bool inModuleSource src m = case moduleIdLocation m of ModuleSource src' -> src' == src _ -> False -- | Check if declaration is in module inModule :: String -> ModuleId -> Bool inModule mname m = fromString mname == moduleIdName m -- | Check if module defined in file byFile :: ModuleId -> Bool byFile m = case moduleIdLocation m of FileModule _ _ -> True _ -> False -- | Check if module got from cabal database byCabal :: ModuleId -> Bool byCabal m = case moduleIdLocation m of CabalModule _ _ _ -> True _ -> False -- | Check if module is standalone standalone :: ModuleId -> Bool standalone m = case moduleIdLocation m of FileModule _ Nothing -> True _ -> False -- | Get list of imports imports :: Module -> [Import] imports = moduleImports -- | Get list of imports, which can be accessed with specified qualifier or unqualified qualifier :: Module -> Maybe String -> [Import] qualifier m q = filter (importQualifier (fmap fromString q)) $ import_ (fromString "Prelude") : import_ (moduleName m) : imports m -- | Check if module imported via imports specified imported :: ModuleId -> [Import] -> Bool imported m = any (\i -> moduleIdName m == importModuleName i) -- | Check if module visible from this module within this project visible :: Project -> ModuleId -> ModuleId -> Bool visible p (ModuleId _ (FileModule src _)) m = inProject p m || any (`inPackage` m) deps || maybe False ((`elem` deps) . projectName) (projectOf m) where deps = maybe [] infoDepends $ fileTarget p src visible _ _ _ = False -- | Check if module is in scope with qualifier inScope :: Module -> Maybe String -> ModuleId -> Bool inScope this q m = m `imported` qualifier this q -- | Select symbols with last package version newestPackage :: Symbol a => [a] -> [a] newestPackage = uncurry (++) . ((selectNewest . groupPackages) *** map snd) . partition (isJust . fst) . map ((mpackage . symbolModuleLocation) &&& id) where mpackage (CabalModule _ (Just p) _) = Just p mpackage _ = Nothing pname = fmap packageName . fst pver = fmap packageVersion . fst groupPackages :: Symbol a => [(Maybe ModulePackage, a)] -> [(Maybe ModulePackage, [a])] groupPackages = map (first head . unzip) . groupBy ((==) `on` fst) . sortBy (comparing fst) selectNewest :: [(Maybe ModulePackage, [a])] -> [a] selectNewest = concatMap (snd . maximumBy (comparing pver)) . groupBy ((==) `on` pname) . sortBy (comparing pname) -- | Select module, defined by sources sourceModule :: Maybe Project -> [Module] -> Maybe Module sourceModule proj ms = listToMaybe $ maybe (const []) (filter . (. moduleId) . inProject) proj ms ++ filter (byFile . moduleId) ms -- | Select module, visible in project or cabal visibleModule :: Cabal -> Maybe Project -> [Module] -> Maybe Module visibleModule cabal proj ms = listToMaybe $ maybe (const []) (filter . (. moduleId) . inProject) proj ms ++ filter (inCabal cabal . moduleId) ms -- | Select preferred visible module preferredModule :: Cabal -> Maybe Project -> [ModuleId] -> Maybe ModuleId preferredModule cabal proj ms = listToMaybe $ concatMap (`filter` ms) order where order = [ maybe (const False) inProject proj, byFile, inCabal cabal, const True] -- | Remove duplicate modules, leave only `preferredModule` uniqueModules :: Cabal -> Maybe Project -> [ModuleId] -> [ModuleId] uniqueModules cabal proj = catMaybes . map (preferredModule cabal proj) . groupBy ((==) `on` moduleIdName) . sortBy (comparing moduleIdName) -- | Select value, satisfying to all predicates allOf :: [a -> Bool] -> a -> Bool allOf ps x = all ($ x) ps -- | Select value, satisfying one of predicates anyOf :: [a -> Bool] -> a -> Bool anyOf ps x = any ($ x) ps -- | Is file info actual? --isActual :: Symbol a -> IO Bool --isActual = maybe (return False) checkStamp . symbolLocation where -- checkStamp l = do -- actualStamp <- getModificationTime (locationFile l) -- return $ Just actualStamp == locationTimeStamp l