hdocs 0.5.3.2 → 0.5.4.0

raw patch · 4 files changed

+52/−9 lines, 4 filesdep ~ghcdep ~haddock-apidep ~haddock-libraryPVP ok

version bump matches the API change (PVP)

Dependency ranges changed: ghc, haddock-api, haddock-library

API changes (from Hackage documentation)

Files

• hdocs.cabal +7/−1
• src/HDocs/Base.hs +17/−4
• src/HDocs/Compat.hs +24/−0
• src/HDocs/Haddock.hs +4/−4

@@ -1,5 +1,5 @@ name:                hdocs
-version:             0.5.3.2
+version:             0.5.4.0
 synopsis:            Haskell docs tool
 description:
   Tool and library to get docs for installed packages and source files.
@@ -36,7 +36,13 @@     HDocs.Haddock
     HDocs.Module
   other-modules:
+    HDocs.Compat
     HDocs.Ghc.Compat
+  if impl(ghc == 8.8.*)
+    build-depends:
+      ghc == 8.8.*,
+      haddock-api >= 2.23 && < 2.24,
+      haddock-library == 1.8.*
   if impl(ghc == 8.6.*)
     build-depends:
       ghc == 8.6.*,

@@ -8,7 +8,8 @@ 
 import Data.Char (isSpace)
 import Data.Map (Map)
-import Data.Foldable (foldMap)
+import Data.Maybe (fromMaybe, listToMaybe)
+import Data.Foldable (foldMap, toList)
 import qualified Data.Map as M
 
 import Documentation.Haddock
@@ -52,8 +53,9 @@ 	go (DocAppend a b) = go a ++ go b
 	go (DocString str) = trimSpaces str
 	go (DocParagraph p) = go p ++ "\n"
-	go (DocIdentifier i) = i
-	go (DocIdentifierUnchecked (mname, occname)) = moduleNameString mname ++ "." ++ occNameString occname
+	go (DocIdentifier i) = unwrap i
+	go (DocIdentifierUnchecked m) = moduleNameString mname ++ "." ++ occNameString occname where
+			(mname, occname) = unwrap m
 	go (DocModule m) = m
 	go (DocWarning w) = go w
 	go (DocEmphasis e) = "*" ++ go e ++ "*"
@@ -63,7 +65,12 @@ 	go (DocOrderedList i) = unlines (zipWith (\i' x -> show i' ++ ". " ++ go x) ([1..] :: [Integer]) i)
 	go (DocDefList xs) = unlines (map (\(i,x) -> go i ++ ". " ++ go x) xs)
 	go (DocCodeBlock block) = unlines (map ("    " ++) (lines (go block))) ++ "\n"
-	go (DocHyperlink (Hyperlink url label)) = maybe url (\l -> l ++ "[" ++ url ++ "]") label
+	go (DocHyperlink (Hyperlink url label)) = maybe url (\l -> showLabel l ++ "[" ++ url ++ "]") $ label where
+#if MIN_VERSION_haddock_library(1,8,0)
+			showLabel = go
+#else
+			showLabel = id
+#endif
 	go (DocPic pic) = show pic
 #if MIN_VERSION_haddock_library(1,4,0)
 	go (DocMathInline m) = m
@@ -86,6 +93,12 @@ 	trim :: String -> String
 	trim = p . p where
 		p = reverse . dropWhile isSpace
+
+#if MIN_VERSION_haddock_library(1,8,0)
+	unwrap = fromMaybe (error "toList on `Wrap` returns empty list") . listToMaybe . toList
+#else
+	unwrap = id
+#endif
 
 -- | Format docs to plain text
 formatDocs :: ModuleDocMap -> Map String String

@@ -0,0 +1,24 @@+{-# LANGUAGE CPP #-}
+
+module HDocs.Compat (
+	readInterfaceFile,
+	mapDoc
+	) where
+
+import Control.Monad.IO.Class
+import Documentation.Haddock hiding (readInterfaceFile)
+import qualified Documentation.Haddock as Haddock
+
+readInterfaceFile :: MonadIO m => NameCacheAccessor m -> FilePath -> m (Either String InterfaceFile)
+#if MIN_VERSION_haddock_api(2,23,0)
+readInterfaceFile cache f = Haddock.readInterfaceFile cache f False
+#else
+readInterfaceFile = Haddock.readInterfaceFile
+#endif
+
+mapDoc :: (a -> b) -> Doc a -> Doc b
+#if MIN_VERSION_haddock_api(2,23,0)
+mapDoc = fmap . fmap
+#else
+mapDoc = fmap
+#endif

@@ -28,8 +28,7 @@ import qualified Data.Map as M
 import Data.Maybe (listToMaybe)
 
-import Distribution.Verbosity (silent)
-import Documentation.Haddock
+import Documentation.Haddock hiding (readInterfaceFile)
 import Documentation.Haddock.Types (_doc)
 
 import DynFlags (DynFlags)
@@ -40,6 +39,7 @@ import PackageConfig
 
 import HDocs.Base
+import HDocs.Compat
 import HDocs.Ghc.Compat
 
 -- | Read all installed docs
@@ -75,7 +75,7 @@ -- | Read docs for source in Ghc monad
 readSourcesGhc :: [String] -> [FilePath] -> ExceptT String Ghc [(String, ModuleDocMap)]
 readSourcesGhc opts fs = ExceptT $ liftM (left (show :: SomeException -> String)) $ gtry $ do
-	ifaces <- liftM fst $ processModules silent fs ([Flag_Verbosity "0", Flag_NoWarnings, Flag_UseUnicode] ++ map Flag_OptGhc opts) []
+	ifaces <- liftM fst $ processModules minBound fs ([Flag_Verbosity "0", Flag_NoWarnings, Flag_UseUnicode] ++ map Flag_OptGhc opts) []
 	return $ map interfaceDocs ifaces
 
 -- | Read docs for haskell module
@@ -125,7 +125,7 @@ 
 stringize :: (Module, Map Name (Doc Name)) -> (String, ModuleDocMap)
 stringize = moduleNameString . moduleName *** strDoc where
-	strDoc = M.mapKeys getOccString . M.map (fmap getOccString)
+	strDoc = M.mapKeys getOccString . M.map (mapDoc getOccString)
 
 liftError :: ExceptT String IO a -> ExceptT String IO a
 liftError = ExceptT . handle onErr . runExceptT where