Parameterising some types in preparation for adding some existence ch…

…ecks in IO

src/Distribution/GhcPkgList.hs

@@ -25,21 +25,23 @@ import Distribution.Version (Version)
 
 -- | A package map maps package names to information about the
 -- versions installed.
-type PackageMap = [(String, VersionMap)]
+type PackageMap a = [(String, VersionMap a)]
 
 -- | A version map maps version numbers to information about the
 -- various installations of that version.
-type VersionMap = [(Version, [VersionInfo])]
+type VersionMap a = [(Version, [VersionInfo a])]
+
+-- | Information about a particular version of a package; at a minimum
+-- this is whether it is exposed; other information may be attached
+-- (in particular we will attach paths to Haddock docs and, later,
+-- whether those docs exist and are readable, and their synopses).
+type VersionInfo a = (Bool, a)
+
 
--- | The information we're interested about a version: is it exposed,
--- and where are its Haddock docs installed?  (Not sure why there can
--- be multiple haddock paths, but that's what Cabal gives us, so
--- that's what we take.)
-type VersionInfo = (Bool, [FilePath])
 
 -- | Get exposure/haddock information about all versions of all
 -- installed packages.
-installedPackages :: IO PackageMap
+installedPackages :: IO (PackageMap [FilePath])
 installedPackages = fmap groupPackages listInstalledPackages
 
 -- Nothing from here down is exposed.
@@ -54,13 +56,15 @@ listInstalledPackages =
 
 -- | Group installed package information together by package name and
 -- version number.
-groupPackages :: PackageIndex -> PackageMap
+groupPackages :: PackageIndex -> PackageMap [FilePath]
 groupPackages = foldr groupPackages' [] . allPackagesByName
 
-groupPackages' :: [I.InstalledPackageInfo] -> PackageMap -> PackageMap
+groupPackages' :: [I.InstalledPackageInfo] -> PackageMap [FilePath] ->
+                  PackageMap [FilePath]
 groupPackages' ps pm = foldr groupPackages'' pm ps
 
-groupPackages'' :: I.InstalledPackageInfo -> PackageMap -> PackageMap
+groupPackages'' :: I.InstalledPackageInfo -> PackageMap [FilePath] ->
+                   PackageMap [FilePath]
 groupPackages'' ipi pm =
   addToAL pm nm $ addToVersionMap vs' ver (ex, had)
     where vs' = fromMaybe [] (nm `lookup` pm)
@@ -70,7 +74,8 @@ groupPackages'' ipi pm =
           ex = I.exposed ipi
           had = I.haddockHTMLs ipi
 
-addToVersionMap :: VersionMap -> Version -> VersionInfo -> VersionMap
+addToVersionMap :: Eq a => VersionMap a -> Version -> VersionInfo a ->
+                   VersionMap a
 addToVersionMap vm v vi = addToAL vm v xs'
   where xs' = case v `lookup` vm of
                 -- No duplicates please.

src/docidx.hs

@@ -77,14 +77,14 @@ main = do
 -- just their (longer) descriptions.
 
 -- | Crawl haddock docs for package synopses.
-packageSynopses :: PackageMap -> IO [(String, String)]
+packageSynopses :: PackageMap [FilePath] -> IO [(String, String)]
 packageSynopses pm = forM (pkgsHaddocks pm) $ \(nm, ph) -> do
                        t <- packageTitle ph
                        return (nm, t)
 
 -- | Turn a PackageMap into an association list of (package name,
 -- haddock path) pairs (for the first version of each package).
-pkgsHaddocks :: PackageMap -> [(String, String)]
+pkgsHaddocks :: PackageMap [FilePath] -> [(String, String)]
 pkgsHaddocks pm = mapMaybe pkgHaddocks pm
   where pkgHaddocks (nm, vs) = do (_, v1) <- mhead $ reverse vs
                                   (_, haddocks) <- mhead v1
@@ -105,7 +105,7 @@ packageTitle haddock = do
 -- Rendering page HTML.
 
 -- | Create and render entire page.
-htmlPage :: PackageMap -> [(String, String)] -> UTCTime -> String
+htmlPage :: PackageMap [FilePath] -> [(String, String)] -> UTCTime -> String
 htmlPage pkgs syns now = renderHtml [htmlHeader, htmlBody]
   where htmlHeader = header << ((thetitle << pageTitle) : fav : css)
         fav = thelink ![rel "shortcut icon", href favIcon] << noHtml
@@ -123,10 +123,10 @@ htmlPage pkgs syns now = renderHtml [htmlHeader, htmlBody]
                            +++ (anchor ![href homePage] << stringToHtml "docidx")]
 
 -- | An AlphaMap groups packages together by their name's first character.
-type AlphaMap = M.Map Char PackageMap
+type AlphaMap = M.Map Char (PackageMap [FilePath])
 
 -- | Group packages together by their name's first character.
-alphabetize :: PackageMap -> AlphaMap
+alphabetize :: PackageMap [FilePath] -> AlphaMap
 alphabetize = foldr addAlpha M.empty
   where addAlpha (n, vs) = M.insertWith (++) c [(n, vs)]
           where c = if isAlpha c' then c' else '\0'
@@ -151,15 +151,17 @@ tocItemHtml TocSeparator = [mdash]
 tocItemHtml TocNewline = [br] -- Hmmm... you still get the bullets?
 
 -- | Render a collection of packages with the same first character.
-htmlPkgsAlpha :: [(String, String)] -> Char -> PackageMap -> [Html]
+htmlPkgsAlpha :: [(String, String)] -> Char -> PackageMap [FilePath] ->
+                 [Html]
 htmlPkgsAlpha syns c pm = [heading, packages]
   where heading = h3 ![theclass "category"] << anchor ![name [c]] << [c]
         packages = ulist ![theclass "packages"] <<
                      map (uncurry $ htmlPkg syns) pm'
         pm' = sortBy (comparing (map toUpper . fst)) pm
 
 -- | Render a particularly-named package (all versions of it).
-htmlPkg :: [(String, String)] -> String -> VersionMap -> Html
+htmlPkg :: [(String, String)] -> String -> VersionMap [FilePath] ->
+           Html
 htmlPkg syns nm vs = li << pvsHtml (flattenPkgVersions nm syn vs)
   where syn = nm `lookup` syns
 
@@ -180,9 +182,10 @@ data PkgVersion = PkgVersion {
 -- | Flatten a given package's various versions into a list of
 -- PkgVersion values, which is much nicer to iterate over when
 -- building the HTML for this package.
-flattenPkgVersions :: String -> Maybe String -> VersionMap -> [PkgVersion]
+flattenPkgVersions :: String -> Maybe String -> VersionMap [FilePath] ->
+                      [PkgVersion]
 flattenPkgVersions nm syn vs = concatMap (uncurry flatten') $ reverse vs
-  where flatten' :: Version -> [VersionInfo] -> [PkgVersion]
+  where flatten' :: Version -> [VersionInfo [FilePath]] -> [PkgVersion]
         -- We reverse here to put user versions of pkgs before
         -- identically versioned global versions.
         flatten' v = concatMap (uncurry flatten'') . reverse