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.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
cabalOf :: ModuleId -> Maybe Cabal
cabalOf m = case view moduleIdLocation m of
CabalModule c _ _ -> Just c
_ -> Nothing
packageOf :: ModuleId -> Maybe ModulePackage
packageOf m = case view 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) $ 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
inCabal :: Cabal -> ModuleId -> Bool
inCabal c m = case view moduleIdLocation m of
CabalModule cabal _ _ -> cabal == c
_ -> False
inPackage :: String -> ModuleId -> Bool
inPackage p m = case view moduleIdLocation m of
CabalModule _ package _ -> Just p == fmap (view packageName) package
_ -> False
inVersion :: String -> ModuleId -> Bool
inVersion v m = case view moduleIdLocation m of
CabalModule _ 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
byCabal :: ModuleId -> Bool
byCabal m = case view moduleIdLocation m of
CabalModule _ _ _ -> 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
imported :: ModuleId -> [Import] -> Bool
imported 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 `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 (view packageName) . fst
pver = fmap (view 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 . (. view moduleId) . inProject) proj ms ++ filter (byFile . view moduleId) ms
visibleModule :: Cabal -> Maybe Project -> [Module] -> Maybe Module
visibleModule cabal proj ms = listToMaybe $ maybe (const []) (filter . (. view moduleId) . inProject) proj ms ++ filter (inCabal cabal . view 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 =
mapMaybe (preferredModule cabal 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