module HsDev.Symbols.Util (
projectOf, packageDbOf, packageOf,
inProject, inDepsOfTarget, inDepsOfFile, inDepsOfProject, inPackageDb, inPackageDbStack, inPackage, inVersion, inFile, inModuleSource, inModule, byFile, installed, standalone,
imports, qualifier, moduleImported, visible, inScope,
newestPackage,
sourceModule, visibleModule, preferredModule, uniqueModules,
allOf, anyOf
) where
import Control.Arrow ((***), (&&&), first)
import Control.Lens (view)
import Control.Monad (liftM)
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.Util (ordNub)
projectOf :: ModuleId -> Maybe Project
projectOf m = case view moduleIdLocation m of
FileModule _ proj -> proj
_ -> Nothing
packageDbOf :: ModuleId -> Maybe PackageDb
packageDbOf m = case view moduleIdLocation m of
InstalledModule c _ _ -> Just c
_ -> Nothing
packageOf :: ModuleId -> Maybe ModulePackage
packageOf m = case view moduleIdLocation m of
InstalledModule _ package' _ -> package'
_ -> Nothing
inProject :: Project -> ModuleId -> Bool
inProject p m = projectOf m == Just p
inDepsOfTarget :: Info -> ModuleId -> Bool
inDepsOfTarget i m = any (`inPackage` m) $ view infoDepends i
inDepsOfFile :: Project -> FilePath -> ModuleId -> Bool
inDepsOfFile p f m = any (`inDepsOfTarget` m) (fileTargets p f)
inDepsOfProject :: Project -> ModuleId -> Bool
inDepsOfProject = maybe (const False) (anyPackage . ordNub . concatMap (view infoDepends) . infos) . view projectDescription where
anyPackage :: [String] -> ModuleId -> Bool
anyPackage = liftM or . mapM inPackage
inPackageDb :: PackageDb -> ModuleId -> Bool
inPackageDb c m = case view moduleIdLocation m of
InstalledModule d _ _ -> d == c
_ -> False
inPackageDbStack :: PackageDbStack -> ModuleId -> Bool
inPackageDbStack dbs m = case view moduleIdLocation m of
InstalledModule d _ _ -> d `elem` packageDbs dbs
_ -> False
inPackage :: String -> ModuleId -> Bool
inPackage p m = case view moduleIdLocation m of
InstalledModule _ package' _ -> Just p == fmap (view packageName) package'
_ -> False
inVersion :: String -> ModuleId -> Bool
inVersion v m = case view moduleIdLocation m of
InstalledModule _ package' _ -> Just v == fmap (view packageVersion) package'
_ -> False
inFile :: FilePath -> ModuleId -> Bool
inFile fpath m = case view moduleIdLocation m of
FileModule f _ -> f == normalise fpath
_ -> False
inModuleSource :: Maybe String -> ModuleId -> Bool
inModuleSource src m = case view moduleIdLocation m of
ModuleSource src' -> src' == src
_ -> False
inModule :: String -> ModuleId -> Bool
inModule mname m = fromString mname == view moduleIdName m
byFile :: ModuleId -> Bool
byFile m = case view moduleIdLocation m of
FileModule _ _ -> True
_ -> False
installed :: ModuleId -> Bool
installed m = case view moduleIdLocation m of
InstalledModule _ _ _ -> True
_ -> False
standalone :: ModuleId -> Bool
standalone m = case view moduleIdLocation m of
FileModule _ Nothing -> True
_ -> False
imports :: Module -> [Import]
imports = view moduleImports
qualifier :: Module -> Maybe String -> [Import]
qualifier m q = filter (importQualifier (fmap fromString q)) $
import_ (fromString "Prelude") :
import_ (view moduleName m) :
imports m
moduleImported :: ModuleId -> [Import] -> Bool
moduleImported m = any (\i -> view moduleIdName m == view importModuleName i)
visible :: Project -> ModuleId -> ModuleId -> Bool
visible p (ModuleId _ (FileModule src _)) m =
inProject p m || any (`inPackage` m) deps || maybe False ((`elem` deps) . view projectName) (projectOf m)
where
deps = concatMap (view infoDepends) $ fileTargets p src
visible _ _ _ = False
inScope :: Module -> Maybe String -> ModuleId -> Bool
inScope this q m = m `moduleImported` qualifier this q
newestPackage :: Symbol a => [a] -> [a]
newestPackage =
uncurry (++) .
((selectNewest . groupPackages) *** map snd) .
partition (isJust . fst) .
map ((mpackage . symbolModuleLocation) &&& id)
where
mpackage (InstalledModule _ (Just p) _) = Just p
mpackage _ = Nothing
pname = fmap (view packageName) . fst
pver = fmap (view packageVersion) . fst
groupPackages :: [(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)
sourceModule :: Maybe Project -> [Module] -> Maybe Module
sourceModule proj ms = listToMaybe $ maybe (const []) (filter . (. view moduleId) . inProject) proj ms ++ filter (byFile . view moduleId) ms
visibleModule :: PackageDb -> Maybe Project -> [Module] -> Maybe Module
visibleModule d proj ms = listToMaybe $ maybe (const []) (filter . (. view moduleId) . inProject) proj ms ++ filter (inPackageDb d . view moduleId) ms
preferredModule :: PackageDb -> Maybe Project -> [ModuleId] -> Maybe ModuleId
preferredModule d proj ms = listToMaybe $ concatMap (`filter` ms) order where
order = [
maybe (const False) inProject proj,
byFile,
inPackageDb d,
const True]
uniqueModules :: PackageDb -> Maybe Project -> [ModuleId] -> [ModuleId]
uniqueModules d proj =
mapMaybe (preferredModule d proj) .
groupBy ((==) `on` view moduleIdName) .
sortBy (comparing (view moduleIdName))
allOf :: [a -> Bool] -> a -> Bool
allOf ps x = all ($ x) ps
anyOf :: [a -> Bool] -> a -> Bool
anyOf ps x = any ($ x) ps