aboutsummaryrefslogtreecommitdiff
path: root/haddock-api/src/Haddock/Interface
diff options
context:
space:
mode:
authorAlec Theriault <alec.theriault@gmail.com>2017-12-10 12:22:21 -0800
committerAlexander Biehl <alexbiehl@gmail.com>2018-02-01 14:58:18 +0100
commit4f75be94f45a0e92553eccefe56230c554333ce7 (patch)
treeb88a2dd52d4bcd001f423c490c14b4c3cbaaee0e /haddock-api/src/Haddock/Interface
parent60e10eb876899165e9644013508361bf72048bdb (diff)
Use the GHC lexer for the Hyperlinker backend (#714)
* Start changing to use GHC lexer * better cpp * Change SrcSpan to RealSrcSpan * Remove error * Try to stop too many open files * wip * wip * Revert "wip" This reverts commit b605510a195f26315e3d8ca90e6d95a6737553e1. Conflicts: haddock-api/haddock-api.cabal haddock-api/src/Haddock/Interface.hs * Remove pointless 'caching' * Use dlist rather than lists when finding vars * Use a map rather than list * Delete bogus comment * Rebase followup Things now run using the GHC lexer. There are still - stray debug statements - unnecessary changes w.r.t. master * Cleaned up differences w.r.t. current Haddock HEAD Things are looking good. quasiquotes in particular look beautiful: the TH ones (with Haskell source inside) colour/link their contents too! Haven't yet begun to check for possible performance problems. * Support CPP and top-level pragmas The support for these is hackier - but no more hacky than the existing support. * Tests pass, CPP is better recognized The tests were in some cases altered: I consider the new output to be more correct than the old one.... * Fix shrinking of source without tabs in test * Replace 'Position'/'Span' with GHC counterparts Replaces 'Position' -> 'GHC.RealSrcLoc' and 'Span' -> 'GHC.RealSrcSpan'. * Nits * Forgot entry in .cabal * Update changelog
Diffstat (limited to 'haddock-api/src/Haddock/Interface')
-rw-r--r--haddock-api/src/Haddock/Interface/Create.hs24
1 files changed, 12 insertions, 12 deletions
diff --git a/haddock-api/src/Haddock/Interface/Create.hs b/haddock-api/src/Haddock/Interface/Create.hs
index 2a56e87a..4309163f 100644
--- a/haddock-api/src/Haddock/Interface/Create.hs
+++ b/haddock-api/src/Haddock/Interface/Create.hs
@@ -20,7 +20,6 @@
module Haddock.Interface.Create (createInterface) where
import Documentation.Haddock.Doc (metaDocAppend)
-import Documentation.Haddock.Utf8 as Utf8
import Haddock.Types
import Haddock.Options
import Haddock.GhcUtils
@@ -33,15 +32,14 @@ import Haddock.Backends.Hyperlinker.Parser as Hyperlinker
import Data.Bifunctor
import Data.Bitraversable
-import qualified Data.ByteString as BS
import qualified Data.Map as M
import Data.Map (Map)
import Data.List
import Data.Maybe
import Data.Ord
import Control.Applicative
-import Control.Exception (evaluate)
import Control.Monad
+import Control.DeepSeq
import Data.Traversable
import Avail hiding (avail)
@@ -160,7 +158,7 @@ createInterface tm flags modMap instIfaceMap = do
modWarn <- liftErrMsg (moduleWarning dflags gre warnings)
- tokenizedSrc <- mkMaybeTokenizedSrc flags tm
+ tokenizedSrc <- mkMaybeTokenizedSrc dflags flags tm
return $! Interface {
ifaceMod = mdl
@@ -1137,12 +1135,12 @@ seqList :: [a] -> ()
seqList [] = ()
seqList (x : xs) = x `seq` seqList xs
-mkMaybeTokenizedSrc :: [Flag] -> TypecheckedModule
+mkMaybeTokenizedSrc :: DynFlags -> [Flag] -> TypecheckedModule
-> ErrMsgGhc (Maybe [RichToken])
-mkMaybeTokenizedSrc flags tm
+mkMaybeTokenizedSrc dflags flags tm
| Flag_HyperlinkedSource `elem` flags = case renamedSource tm of
Just src -> do
- tokens <- liftGhcToErrMsgGhc . liftIO $ mkTokenizedSrc summary src
+ tokens <- liftGhcToErrMsgGhc (liftIO (mkTokenizedSrc dflags summary src))
return $ Just tokens
Nothing -> do
liftErrMsg . tell . pure $ concat
@@ -1155,12 +1153,14 @@ mkMaybeTokenizedSrc flags tm
where
summary = pm_mod_summary . tm_parsed_module $ tm
-mkTokenizedSrc :: ModSummary -> RenamedSource -> IO [RichToken]
-mkTokenizedSrc ms src = do
- -- make sure to read the whole file at once otherwise
+mkTokenizedSrc :: DynFlags -> ModSummary -> RenamedSource -> IO [RichToken]
+mkTokenizedSrc dflags ms src = do
+ -- make sure to read the whole file at once otherwise
-- we run out of file descriptors (see #495)
- rawSrc <- BS.readFile (msHsFilePath ms) >>= evaluate
- return $ Hyperlinker.enrich src (Hyperlinker.parse (decodeUtf8 rawSrc))
+ file <- force <$> readFile (filepath)
+ return $ Hyperlinker.enrich src (Hyperlinker.parse dflags filepath file)
+ where
+ filepath = msHsFilePath ms
-- | Find a stand-alone documentation comment by its name.
findNamedDoc :: String -> [HsDecl GhcRn] -> ErrMsgM (Maybe HsDocString)