Remove the concept of the 'current module' in Docs (purescript#3506)

The concept of the current module is unnecessary (we aren't using it
anywhere either in the compiler or in Pursuit) as well as potentially
confusing; for example, what is the 'current module' when we are
rendering re-exported declarations? Additionally, since the information
is not used, it would be easy for it to become incorrect without anyone
noticing.

This commit refactors the Docs related code, removing the concept of the
current module. Specifically, the following have been removed:

- the SameModule constructor from the LinkLocation data type;
  wherever we previously would have used that, we can now use the
  LocalModule constructor, which encodes precisely the same information.
- the 'current module' field from the constructors LocalModule and
  DepsModule of the data type LinkLocation, which was unused.
- the 'currentModuleName' field of the HtmlRenderContext data type,
  which was also unused.

I came across this refactoring opportunity while looking into purescript#3504.

app/Command/Docs/Html.hs

@@ -48,8 +48,7 @@ writeHtmlFile filepath =
 
 getHtmlRenderContext :: P.ModuleName -> D.HtmlRenderContext
 getHtmlRenderContext mn = D.HtmlRenderContext
-  { D.currentModuleName = mn
-  , D.buildDocLink = getLink mn
+  { D.buildDocLink = getLink mn
   , D.renderDocLink = renderLink
   , D.renderSourceLink = const Nothing
   }
@@ -70,11 +69,11 @@ getLink curMn namespace target containingMod = do
   normalLinkLocation = do
     case containingMod of
       D.ThisModule ->
-        return D.SameModule
+        return $ D.LocalModule curMn
       D.OtherModule destMn ->
         -- This is OK because all modules count as 'local' for purs docs in
         -- html mode
-        return $ D.LocalModule curMn destMn
+        return $ D.LocalModule destMn
 
   builtinLinkLocation = do
     let primMn = P.moduleNameFromString "Prim"
@@ -84,9 +83,7 @@ getLink curMn namespace target containingMod = do
 renderLink :: D.DocLink -> Text
 renderLink l =
   case D.linkLocation l of
-    D.SameModule ->
-      ""
-    D.LocalModule _ dest ->
+    D.LocalModule dest ->
       P.runModuleName dest <> ".html"
     D.DepsModule{} ->
       P.internalError "DepsModule: not implemented"

src/Language/PureScript/Docs/AsHtml.hs

@@ -53,18 +53,16 @@ data HtmlOutputModule a = HtmlOutputModule
   deriving (Show, Functor)
 
 data HtmlRenderContext = HtmlRenderContext
-  { currentModuleName :: P.ModuleName
-  , buildDocLink :: Namespace -> Text -> ContainingModule -> Maybe DocLink
+  { buildDocLink :: Namespace -> Text -> ContainingModule -> Maybe DocLink
   , renderDocLink :: DocLink -> Text
   , renderSourceLink :: P.SourceSpan -> Maybe Text
   }
 
 -- |
 -- An HtmlRenderContext for when you don't want to render any links.
-nullRenderContext :: P.ModuleName -> HtmlRenderContext
-nullRenderContext mn = HtmlRenderContext
-  { currentModuleName = mn
-  , buildDocLink = const (const (const Nothing))
+nullRenderContext :: HtmlRenderContext
+nullRenderContext = HtmlRenderContext
+  { buildDocLink = const (const (const Nothing))
   , renderDocLink = const ""
   , renderSourceLink = const Nothing
   }
@@ -83,16 +81,16 @@ moduleAsHtml
     :: (InPackage P.ModuleName -> Maybe HtmlRenderContext)
     -> Module
     -> (P.ModuleName, HtmlOutputModule Html)
-moduleAsHtml getR Module{..} = (modName, HtmlOutputModule modHtml reexports)
+moduleAsHtml getHtmlCtx Module{..} = (modName, HtmlOutputModule modHtml reexports)
   where
   modHtml = do
-    let r = fromMaybe (nullRenderContext modName) $ getR (Local modName)
+    let r = fromMaybe nullRenderContext $ getHtmlCtx (Local modName)
      in do
         for_ modComments renderMarkdown
         for_ modDeclarations (declAsHtml r)
   reexports =
     flip map modReExports $ \(pkg, decls) ->
-        let r = fromMaybe (nullRenderContext modName) $ getR pkg
+        let r = fromMaybe nullRenderContext $ getHtmlCtx pkg
          in (pkg, foldMap (declAsHtml r) decls)
 
 -- renderIndex :: LinksContext -> [(Maybe Char, Html)]
@@ -101,25 +99,25 @@ moduleAsHtml getR Module{..} = (modName, HtmlOutputModule modHtml reexports)
 --   go = takeLocals
 --      >>> groupIndex getIndex renderEntry
 --      >>> map (second (ul . mconcat))
--- 
+--
 --   getIndex (_, title_) = do
 --     c <- textHeadMay title_
 --     guard (toUpper c `elem` ['A'..'Z'])
 --     pure c
--- 
+--
 --   textHeadMay t =
 --     case T.length t of
 --       0 -> Nothing
 --       _ -> Just (T.index t 0)
--- 
+--
 --   renderEntry (mn, title_) =
 --     li $ do
 --       let url = T.pack (filePathFor mn `relativeTo` "index") <> "#" <> title_
 --       code $
 --         a ! A.href (v url) $ text title_
 --       sp
 --       text ("(" <> P.runModuleName mn <> ")")
--- 
+--
 --   groupIndex :: Ord i => (a -> Maybe i) -> (a -> b) -> [a] -> [(Maybe i, [b])]
 --   groupIndex f g =
 --     map (second DList.toList) . M.toList . foldr go' M.empty . sortBy (comparing f)
@@ -233,13 +231,13 @@ renderLink r link_@DocLink{..} =
   a ! A.href (v (renderDocLink r link_ <> fragmentFor link_))
     ! A.title (v fullyQualifiedName)
   where
-  fullyQualifiedName = case linkLocation of
-    SameModule                -> fq (currentModuleName r) linkTitle
-    LocalModule _ modName     -> fq modName linkTitle
-    DepsModule _ _ _ modName  -> fq modName linkTitle
-    BuiltinModule modName     -> fq modName linkTitle
+  fullyQualifiedName =
+    P.runModuleName modName <> "." <> linkTitle
 
-  fq mn str = P.runModuleName mn <> "." <> str
+  modName = case linkLocation of
+    LocalModule m    -> m
+    DepsModule _ _ m -> m
+    BuiltinModule m  -> m
 
 makeFragment :: Namespace -> Text -> Text
 makeFragment ns = (prefix <>) . escape

src/Language/PureScript/Docs/Types.hs

@@ -414,18 +414,13 @@ data DocLink = DocLink
 instance NFData DocLink
 
 data LinkLocation
-  -- | A link to a declaration in the same module.
-  = SameModule
+  -- | A link to a declaration in the current package.
+  = LocalModule P.ModuleName
 
-  -- | A link to a declaration in a different module, but still in the current
-  -- package; we need to store the current module and the other declaration's
-  -- module.
-  | LocalModule P.ModuleName P.ModuleName
-
-  -- | A link to a declaration in a different package. We store: current module
-  -- name, name of the other package, version of the other package, and name of
-  -- the module in the other package that the declaration is in.
-  | DepsModule P.ModuleName PackageName Version P.ModuleName
+  -- | A link to a declaration in a different package. The arguments represent
+  -- the name of the other package, the version of the other package, and the
+  -- name of the module in the other package that the declaration is in.
+  | DepsModule PackageName Version P.ModuleName
 
   -- | A link to a declaration that is built in to the compiler, e.g. the Prim
   -- module. In this case we only need to store the module that the builtin
@@ -454,14 +449,14 @@ getLink LinksContext{..} curMn namespace target containingMod = do
   normalLinkLocation = do
     case containingMod of
       ThisModule ->
-        return SameModule
+        return $ LocalModule curMn
       OtherModule destMn ->
         case Map.lookup destMn ctxModuleMap of
           Nothing ->
-            return $ LocalModule curMn destMn
+            return $ LocalModule destMn
           Just pkgName -> do
             pkgVersion <- lookup pkgName ctxResolvedDependencies
-            return $ DepsModule curMn pkgName pkgVersion destMn
+            return $ DepsModule pkgName pkgVersion destMn
 
   builtinLinkLocation =
     case containingMod of