aboutsummaryrefslogtreecommitdiff
path: root/haddock-api/src/Haddock/Backends
diff options
context:
space:
mode:
authorAlec Theriault <alec.theriault@gmail.com>2019-10-07 15:11:22 -0400
committerAlec Theriault <alec.theriault@gmail.com>2019-10-07 17:56:13 -0400
commit5459ca8a76825da59ff4c1c11d74812d1931da50 (patch)
tree651863b6ddc83ffa16060d5e49d2681c8b318de8 /haddock-api/src/Haddock/Backends
parent63c7e87de4fa94cea9eb1b253054a316d3d75e1c (diff)
Prefer un-hyperlinked sources to no sources
It is possible to fail to extract an HIE ast. This is however not a reason to produce _no_ output - we should still make a colorized HTML page.
Diffstat (limited to 'haddock-api/src/Haddock/Backends')
-rw-r--r--haddock-api/src/Haddock/Backends/Hyperlinker.hs38
-rw-r--r--haddock-api/src/Haddock/Backends/Hyperlinker/Utils.hs2
2 files changed, 26 insertions, 14 deletions
diff --git a/haddock-api/src/Haddock/Backends/Hyperlinker.hs b/haddock-api/src/Haddock/Backends/Hyperlinker.hs
index 3acd91be..2e665204 100644
--- a/haddock-api/src/Haddock/Backends/Hyperlinker.hs
+++ b/haddock-api/src/Haddock/Backends/Hyperlinker.hs
@@ -18,12 +18,13 @@ import Data.Maybe
import System.Directory
import System.FilePath
-import HieTypes ( HieFile(..), HieASTs(..) )
+import HieTypes ( HieFile(..), HieASTs(..), HieAST(..), NodeInfo(..) )
import HieBin ( readHieFile, hie_file_result)
import Data.Map as M
import FastString ( mkFastString )
import Module ( Module, moduleName )
import NameCache ( initNameCache )
+import SrcLoc ( mkRealSrcLoc, realSrcLocSpan )
import UniqSupply ( mkSplitUniqSupply )
@@ -65,27 +66,38 @@ ppHyperlinkedModuleSource verbosity srcdir pretty srcs iface = case ifaceHieFile
<$> (readHieFile (initNameCache u []) hfp)
-- Get the AST and tokens corresponding to the source file we want
- let mast | M.size asts == 1 = snd <$> M.lookupMin asts
- | otherwise = M.lookup (mkFastString file) asts
+ let fileFs = mkFastString file
+ mast | M.size asts == 1 = snd <$> M.lookupMin asts
+ | otherwise = M.lookup fileFs asts
+ ast = fromMaybe (emptyHieAst fileFs) mast
+ fullAst = recoverFullIfaceTypes df types ast
tokens = parse df file rawSrc
+ -- Warn if we didn't find an AST, but there were still ASTs
+ if M.null asts
+ then pure ()
+ else out verbosity verbose $ unwords [ "couldn't find ast for"
+ , file, show (M.keys asts) ]
+
-- Produce and write out the hyperlinked sources
- case mast of
- Just ast ->
- let fullAst = recoverFullIfaceTypes df types ast
- in writeUtf8File path . renderToString pretty . render' fullAst $ tokens
- Nothing
- | M.size asts == 0 -> return ()
- | otherwise -> do
- out verbosity verbose $ unwords [ "couldn't find ast for"
- , file, show (M.keys asts) ]
- return ()
+ writeUtf8File path . renderToString pretty . render' fullAst $ tokens
Nothing -> return ()
where
df = ifaceDynFlags iface
render' = render (Just srcCssFile) (Just highlightScript) srcs
path = srcdir </> hypSrcModuleFile (ifaceMod iface)
+ emptyNodeInfo = NodeInfo
+ { nodeAnnotations = mempty
+ , nodeType = []
+ , nodeIdentifiers = mempty
+ }
+ emptyHieAst fileFs = Node
+ { nodeInfo = emptyNodeInfo
+ , nodeSpan = realSrcLocSpan (mkRealSrcLoc fileFs 1 0)
+ , nodeChildren = []
+ }
+
-- | Name of CSS file in output directory.
srcCssFile :: FilePath
srcCssFile = "style.css"
diff --git a/haddock-api/src/Haddock/Backends/Hyperlinker/Utils.hs b/haddock-api/src/Haddock/Backends/Hyperlinker/Utils.hs
index 4e8b88d2..2c48e00b 100644
--- a/haddock-api/src/Haddock/Backends/Hyperlinker/Utils.hs
+++ b/haddock-api/src/Haddock/Backends/Hyperlinker/Utils.hs
@@ -102,7 +102,7 @@ type PrintedType = String
-- > hieAst
--
-- However, this is very inefficient (both in time and space) because the
--- mutliple calls to 'recoverFullType' don't share intermediate results. This
+-- multiple calls to 'recoverFullType' don't share intermediate results. This
-- function fixes that.
recoverFullIfaceTypes
:: DynFlags