module HsDev.Symbols.Util (
projectOf, cabalOf, packageOf,
inProject, inDepsOfTarget, inDepsOfFile, inDepsOfProject, 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 Control.Monad (liftM)
import Data.Function (on)
import Data.Maybe
import Data.List (maximumBy, groupBy, sortBy, partition, nub)
import Data.Ord (comparing)
import Data.String (fromString)
import System.FilePath (normalise)
import HsDev.Symbols
import HsDev.Project
projectOf :: ModuleId -> Maybe Project
projectOf m = case moduleIdLocation m of
FileModule _ proj -> proj
_ -> Nothing
cabalOf :: ModuleId -> Maybe Cabal
cabalOf m = case moduleIdLocation m of
CabalModule c _ _ -> Just c
_ -> 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
inDepsOfTarget :: Info -> ModuleId -> Bool
inDepsOfTarget i m = any (`inPackage` m) $ infoDepends i
inDepsOfFile :: Project -> FilePath -> ModuleId -> Bool
inDepsOfFile p f = maybe (const False) inDepsOfTarget $ fileTarget p f
inDepsOfProject :: Project -> ModuleId -> Bool
inDepsOfProject = maybe (const False) (anyPackage . nub . concatMap infoDepends . infos) . projectDescription where
anyPackage :: [String] -> ModuleId -> Bool
anyPackage = liftM or . mapM inPackage
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 = fromString 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 (fmap fromString q)) $
import_ (fromString "Prelude") :
import_ (moduleName m) :
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 . 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)
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