module HsDev.Symbols.Util (
packageOf, projectOf,
inProject, 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 ((***), (&&&), second)
import Data.Function (on)
import Data.Maybe
import Data.List (maximumBy, groupBy, sortBy, partition)
import Data.Ord (comparing)
import System.FilePath (normalise)
import HsDev.Symbols
import HsDev.Project
projectOf :: ModuleId -> Maybe Project
projectOf m = case moduleIdLocation m of
FileModule _ proj -> proj
_ -> Nothing
packageOf :: ModuleId -> Maybe ModulePackage
packageOf m = case moduleIdLocation m of
CabalModule _ package _ -> package
_ -> Nothing
inProject :: Project -> ModuleId -> Bool
inProject p m = projectOf m == Just p
inCabal :: Cabal -> ModuleId -> Bool
inCabal c m = case moduleIdLocation m of
CabalModule cabal _ _ -> cabal == c
_ -> False
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
inFile :: FilePath -> ModuleId -> Bool
inFile fpath m = case moduleIdLocation m of
FileModule f _ -> f == normalise fpath
_ -> False
inModuleSource :: Maybe String -> ModuleId -> Bool
inModuleSource src m = case moduleIdLocation m of
ModuleSource src' -> src' == src
_ -> False
inModule :: String -> ModuleId -> Bool
inModule mname m = mname == moduleIdName m
byFile :: ModuleId -> Bool
byFile m = case moduleIdLocation m of
FileModule _ _ -> True
_ -> False
byCabal :: ModuleId -> Bool
byCabal m = case moduleIdLocation m of
CabalModule _ _ _ -> True
_ -> False
standalone :: ModuleId -> Bool
standalone m = case moduleIdLocation m of
FileModule _ Nothing -> True
_ -> False
imports :: Module -> [Import]
imports = moduleImports
qualifier :: Module -> Maybe String -> [Import]
qualifier m q = filter (importQualifier q) $ (Import "Prelude" False Nothing Nothing : Import (moduleName m) False Nothing Nothing : imports m)
imported :: ModuleId -> [Import] -> Bool
imported m = any (\i -> moduleIdName m == importModuleName i)
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
inScope :: Module -> Maybe String -> ModuleId -> Bool
inScope this q m = m `imported` qualifier this q
newestPackage :: Symbol a => [a] -> [a]
newestPackage =
uncurry (++) .
(selectNewest *** map fst) .
partition (isJust . snd) .
map (id &&& (moduleNamePackage . symbolModuleLocation))
where
moduleNamePackage (CabalModule _ (Just p) mname) = Just (mname, p)
moduleNamePackage _ = Nothing
pname = fmap (second packageName) . snd
pver = fmap (packageVersion . snd) . snd
selectNewest :: Symbol a => [(a, Maybe (String, ModulePackage))] -> [a]
selectNewest =
map (fst . maximumBy (comparing pver)) .
groupBy ((==) `on` pname) .
sortBy (comparing pname)
sourceModule :: Maybe Project -> [Module] -> Maybe Module
sourceModule proj ms = listToMaybe $ maybe (const []) (filter . (. moduleId) . inProject) proj ms ++ filter (byFile . moduleId) ms
visibleModule :: Cabal -> Maybe Project -> [Module] -> Maybe Module
visibleModule cabal proj ms = listToMaybe $ maybe (const []) (filter . (. moduleId) . inProject) proj ms ++ filter (inCabal cabal . moduleId) ms
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]
uniqueModules :: Cabal -> Maybe Project -> [ModuleId] -> [ModuleId]
uniqueModules cabal proj =
catMaybes .
map (preferredModule cabal proj) .
groupBy ((==) `on` moduleIdName) .
sortBy (comparing moduleIdName)
allOf :: [a -> Bool] -> a -> Bool
allOf ps x = all ($ x) ps
anyOf :: [a -> Bool] -> a -> Bool
anyOf ps x = any ($ x) ps