module Scion.Browser.Query
( allPackageIds
, allPackages
, packagesByName
, getPackage
, getSingletonDatabase
, getModules
, getSubmodules
, getDeclsInModule
, getModulesWhereDeclarationIs
) where
import Data.List (isPrefixOf, stripPrefix)
import qualified Data.Map as M
import Distribution.Package hiding (Package)
import Language.Haskell.Exts.Annotated.Syntax
import Scion.Browser
import Scion.Browser.FromMissingH (addToAL)
allPackageIds :: Database -> [PackageIdentifier]
allPackageIds = M.keys
allPackages :: Database -> [Documented Package]
allPackages = M.elems
packagesByName :: String -> Database -> [Documented Package]
packagesByName name db = M.foldlWithKey (\lst k v -> let PackageName pkgN = pkgName k
in if pkgN == name then v:lst else lst)
[] db
getPackage :: PackageIdentifier -> Database -> Maybe (Documented Package)
getPackage = M.lookup
getSingletonDatabase :: PackageIdentifier -> Database -> Maybe Database
getSingletonDatabase pid db = case getPackage pid db of
Nothing -> Nothing
Just pkg -> Just $ singletonDatabase pkg
type ModuleWithPackage = (PackageIdentifier, Documented Module)
getModules :: String -> Database -> [(String, [ModuleWithPackage])]
getModules = getSubmodules' getModulesFromPackage
getSubmodules :: String -> Database -> [(String, [ModuleWithPackage])]
getSubmodules = getSubmodules' getSubmodulesFromPackage
getSubmodules' :: (String -> Documented Package -> [Documented Module]) -> String -> Database -> [(String, [ModuleWithPackage])]
getSubmodules' f mname db = M.foldrWithKey (\pid pkg current -> mergeModules pid (f mname pkg) current) [] db
mergeModules :: PackageIdentifier -> [Documented Module] -> [(String, [ModuleWithPackage])] -> [(String, [ModuleWithPackage])]
mergeModules pid mods initial = foldr (\md current -> mergeModule pid md current) initial mods
mergeModule :: PackageIdentifier -> Documented Module -> [(String, [ModuleWithPackage])] -> [(String, [ModuleWithPackage])]
mergeModule pid md current = let mname = getName md
in case lookup mname current of
Nothing -> (mname, [(pid, md)]) : current
Just mods -> addToAL current mname ((pid, md):mods)
getModulesFromPackage :: String -> Documented Package -> [Documented Module]
getModulesFromPackage "" (Package _ _ modMap) =
M.foldlWithKey (\lst k v -> if '.' `elem` k then lst else v:lst) [] modMap
getModulesFromPackage initial (Package _ _ modMap) =
M.foldlWithKey (\lst k v -> if include k then v:lst else lst) [] modMap
where minitial = initial ++ "."
include k = case stripPrefix minitial k of
Nothing -> False
Just mn -> not ('.' `elem` mn)
getSubmodulesFromPackage :: String -> Documented Package -> [Documented Module]
getSubmodulesFromPackage "" (Package _ _ modMap) = M.elems modMap
getSubmodulesFromPackage initial (Package _ _ modMap) =
let minitial = initial ++ "."
in M.foldlWithKey (\lst k v -> if minitial `isPrefixOf` k then v:lst else lst) [] modMap
getDeclsInModule :: String -> Database -> [(PackageIdentifier, [Documented Decl])]
getDeclsInModule modName db = M.foldrWithKey (\k v lst -> (k, getDeclsInModuleFromPackage modName v):lst) [] db
getDeclsInModuleFromPackage :: String -> Documented Package -> [Documented Decl]
getDeclsInModuleFromPackage modName (Package _ _ modMap) =
case M.lookup modName modMap of
Just (Module _ _ _ _ decls) -> decls
_ -> []
getModulesWhereDeclarationIs :: String -> Database -> [Documented Module]
getModulesWhereDeclarationIs decl db = M.fold (\v lst -> (getModulesWhereDeclarationIsInPackage decl v) ++ lst) [] db
getModulesWhereDeclarationIsInPackage :: String -> Documented Package -> [Documented Module]
getModulesWhereDeclarationIsInPackage decl (Package _ _ modMap) = M.elems $ M.filter (moduleHasDecl decl) modMap
moduleHasDecl :: String -> Documented Module -> Bool
moduleHasDecl decl (Module _ _ _ _ decls) = isDeclName decls
where isDeclName [] = False
isDeclName (x:xs) = getName x == decl || isChildName (getChildren x) || isDeclName xs
isChildName [] = False
isChildName (x:xs) = getName x == decl || isChildName xs