diff options
author | Alec Theriault <alec.theriault@gmail.com> | 2017-12-10 12:22:21 -0800 |
---|---|---|
committer | Alexander Biehl <alexbiehl@gmail.com> | 2018-02-01 14:58:18 +0100 |
commit | 4f75be94f45a0e92553eccefe56230c554333ce7 (patch) | |
tree | b88a2dd52d4bcd001f423c490c14b4c3cbaaee0e /haddock-api/src/Haddock/Interface | |
parent | 60e10eb876899165e9644013508361bf72048bdb (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.hs | 24 |
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) |