diff options
Diffstat (limited to 'haddock-api/src/Haddock/Interface')
| -rw-r--r-- | haddock-api/src/Haddock/Interface/AttachInstances.hs | 1 | ||||
| -rw-r--r-- | haddock-api/src/Haddock/Interface/Create.hs | 7 | ||||
| -rw-r--r-- | haddock-api/src/Haddock/Interface/Json.hs | 4 | ||||
| -rw-r--r-- | haddock-api/src/Haddock/Interface/LexParseRn.hs | 8 |
4 files changed, 12 insertions, 8 deletions
diff --git a/haddock-api/src/Haddock/Interface/AttachInstances.hs b/haddock-api/src/Haddock/Interface/AttachInstances.hs index dc8afa31..4527360f 100644 --- a/haddock-api/src/Haddock/Interface/AttachInstances.hs +++ b/haddock-api/src/Haddock/Interface/AttachInstances.hs @@ -1,4 +1,3 @@ -{-# LANGUAGE MagicHash, BangPatterns #-} {-# LANGUAGE TypeFamilies #-} {-# OPTIONS_GHC -Wno-incomplete-record-updates #-} {-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-} diff --git a/haddock-api/src/Haddock/Interface/Create.hs b/haddock-api/src/Haddock/Interface/Create.hs index dbd4a9b2..b832128f 100644 --- a/haddock-api/src/Haddock/Interface/Create.hs +++ b/haddock-api/src/Haddock/Interface/Create.hs @@ -9,7 +9,6 @@ {-# LANGUAGE RecordWildCards #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE StandaloneDeriving #-} -{-# LANGUAGE TupleSections #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE ViewPatterns #-} {-# OPTIONS_GHC -Wwarn #-} @@ -83,7 +82,7 @@ import GHC.Types.Unique.Map newtype IfEnv m = IfEnv { - -- | Lookup names in the enviroment. + -- | Lookup names in the environment. ife_lookup_name :: Name -> m (Maybe TyThing) } @@ -265,7 +264,7 @@ createInterface1 flags unit_state mod_sum tc_gbl_env ifaces inst_ifaces = do mod_warning <- liftErrMsg (moduleWarning dflags tcg_rdr_env tcg_warns) let - -- Warnings in this module and transitive warnings from dependend modules + -- Warnings in this module and transitive warnings from dependent modules warnings :: Map Name (Doc Name) warnings = M.unions (decl_warnings : map ifaceWarningMap (M.elems ifaces)) @@ -334,7 +333,7 @@ mkAliasMap state impDecls = M.fromList $ mapMaybe (\(SrcLoc.L _ impDecl) -> do SrcLoc.L _ alias <- ideclAs impDecl - return $ + return (lookupModuleDyn state -- TODO: This is supremely dodgy, because in general the -- UnitId isn't going to look anything like the package diff --git a/haddock-api/src/Haddock/Interface/Json.hs b/haddock-api/src/Haddock/Interface/Json.hs index 92fb2e75..8b27a982 100644 --- a/haddock-api/src/Haddock/Interface/Json.hs +++ b/haddock-api/src/Haddock/Interface/Json.hs @@ -130,8 +130,10 @@ jsonDoc (DocUnorderedList xs) = jsonObject jsonDoc (DocOrderedList xs) = jsonObject [ ("tag", jsonString "DocOrderedList") - , ("documents", jsonArray (fmap jsonDoc xs)) + , ("items", jsonArray (fmap jsonItem xs)) ] + where + jsonItem (index, a) = jsonObject [("document", jsonDoc a), ("seq", jsonInt index)] jsonDoc (DocDefList xys) = jsonObject [ ("tag", jsonString "DocDefList") diff --git a/haddock-api/src/Haddock/Interface/LexParseRn.hs b/haddock-api/src/Haddock/Interface/LexParseRn.hs index f3b57792..4e1964af 100644 --- a/haddock-api/src/Haddock/Interface/LexParseRn.hs +++ b/haddock-api/src/Haddock/Interface/LexParseRn.hs @@ -90,6 +90,10 @@ processModuleHeader dflags pkgName gre safety mayStr = do where failure = (emptyHaddockModInfo, Nothing) +traverseSnd :: (Traversable t, Applicative f) => (a -> f b) -> t (x, a) -> f (t (x, b)) +traverseSnd f = traverse (\(x, a) -> + (\b -> (x, b)) <$> f a) + -- | Takes a 'GlobalRdrEnv' which (hopefully) contains all the -- definitions and a parsed comment and we attempt to make sense of -- where the identifiers in the comment point to. We're in effect @@ -152,7 +156,7 @@ rename dflags gre = rn DocBold doc -> DocBold <$> rn doc DocMonospaced doc -> DocMonospaced <$> rn doc DocUnorderedList docs -> DocUnorderedList <$> traverse rn docs - DocOrderedList docs -> DocOrderedList <$> traverse rn docs + DocOrderedList docs -> DocOrderedList <$> traverseSnd rn docs DocDefList list -> DocDefList <$> traverse (\(a, b) -> (,) <$> rn a <*> rn b) list DocCodeBlock doc -> DocCodeBlock <$> rn doc DocIdentifierUnchecked x -> pure (DocIdentifierUnchecked x) @@ -173,7 +177,7 @@ rename dflags gre = rn -- 'GlobalReaderEnv' during 'rename') in an appropriate doc. Currently -- we simply monospace the identifier in most cases except when the -- identifier is qualified: if the identifier is qualified then we can --- still try to guess and generate anchors accross modules but the +-- still try to guess and generate anchors across modules but the -- users shouldn't rely on this doing the right thing. See tickets -- #253 and #375 on the confusion this causes depending on which -- default we pick in 'rename'. |