@@ -122,6 +122,7 @@ rootNsStr = "<builtins>"
122nsName2Str :: NsName -- ^ NsName to convert
122nsName2Str :: NsName -- ^ NsName to convert
123 -> String
123 -> String
124nsName2Str n = if null n then rootNsStr else name n
124nsName2Str n = if null n then rootNsStr else name n
125 where name [] = []
126 where name [] = []
126 name [ns] = str ns
127 name [ns] = str ns
127 name (ns:nss) = (name nss) ++ ('.' : str ns)
128 name (ns:nss) = (name nss) ++ ('.' : str ns)
@@ -189,6 +190,7 @@ referredNss (n, Just d, _) =
189 ts = concatMap types fds
190 ts = concatMap types fds
190 names = concatMap (extractPTermNames) ts
191 names = concatMap (extractPTermNames) ts
191 in S.map getNs $ S.fromList names
192 in S.map getNs $ S.fromList names
192 where getFunDocs (FunDoc f) = [f]
194 where getFunDocs (FunDoc f) = [f]
193 getFunDocs (DataDoc f fs) = f:fs
195 getFunDocs (DataDoc f fs) = f:fs
194 getFunDocs (ClassDoc _ _ fs) = fs
196 getFunDocs (ClassDoc _ _ fs) = fs
@@ -217,7 +219,7 @@ getAccess ist n =
217 let res = lookupDefAcc n False (tt_ctxt ist)
219 let res = lookupDefAcc n False (tt_ctxt ist)
218 in case res of
220 in case res of
219 [(_, acc)] -> acc
221 [(_, acc)] -> acc
220− _ -> Public -- Does this default make sense?
222+ _ -> Public
222-- | Simple predicate for whether an NsItem has Docs
224-- | Simple predicate for whether an NsItem has Docs
223hasDoc :: NsItem -- ^ The NsItem to test
225hasDoc :: NsItem -- ^ The NsItem to test
@@ -247,8 +249,8 @@ loadDocs ist n
249-- | Extracts names referred from a type.
251-- | Extracts names referred from a type.
250−-- The covering of all PTerms ensures that we avoid unanticipated cases, though
252+-- The covering of all PTerms ensures that we avoid unanticipated cases,
251−-- all of them are not needed. The author just did not know which!
253+-- though all of them are not needed. The author just did not know which!
252-- TODO: Remove unnecessary cases
254-- TODO: Remove unnecessary cases
253extractPTermNames :: PTerm -- ^ Where to extract names from
255extractPTermNames :: PTerm -- ^ Where to extract names from
254 -> [Name] -- ^ Extracted names
256 -> [Name] -- ^ Extracted names
@@ -435,17 +437,18 @@ genTypeHeader nsd (FD n _ args ftype _) = do
435 names = [ n | (n@(UN n'), _, _, _) <- args,
437 names = [ n | (n@(UN n'), _, _, _) <- args,
436 not (T.isPrefixOf (txt "__") n') ]
438 not (T.isPrefixOf (txt "__") n') ]
440+ decorator (AnnName n _ _ _) str | str /= show (nsroot n) = str
438 decorator (AnnName n _ _ _) str | filterName n, isFun n = do
441 decorator (AnnName n _ _ _) str | filterName n, isFun n = do
439 R.renderHtml $ H.a ! class_ "name"
442 R.renderHtml $ H.a ! class_ "name"
440 ! title (toValue $ show n) ! href (toValue $ link n)
443 ! title (toValue $ show n) ! href (toValue $ link n)
441− $ toHtml $ show $ nsroot n
444+ $ toHtml $ str
442 decorator (AnnName n _ _ _) str | filterName n = do
445 decorator (AnnName n _ _ _) str | filterName n = do
443 R.renderHtml $ H.a ! class_ "type"
446 R.renderHtml $ H.a ! class_ "type"
444 ! title (toValue $ show n) ! href (toValue $ link n)
447 ! title (toValue $ show n) ! href (toValue $ link n)
445− $ toHtml $ show $ nsroot n
448+ $ toHtml $ str
446 decorator (AnnBoundName n _) str | Just t <- M.lookup n docs = do
449 decorator (AnnBoundName n _) str | Just t <- M.lookup n docs = do
447 R.renderHtml $ H.span ! class_ "arg" ! title (toValue t)
450 R.renderHtml $ H.span ! class_ "arg" ! title (toValue t)
448− $ toHtml $ show n
451+ $ toHtml $ str
449 decorator _ str = str
452 decorator _ str = str
451 docs = M.fromList $ mapMaybe docExtractor args
454 docs = M.fromList $ mapMaybe docExtractor args
@@ -511,6 +514,7 @@ createOtherDoc :: NsDict -- ^ Information about other namespaces
511 -> Docs -- ^ Namespace item to generate HTML block for
514 -> Docs -- ^ Namespace item to generate HTML block for
512 -> H.Html -- ^ Resulting HTML
515 -> H.Html -- ^ Resulting HTML
513createOtherDoc nsd (FunDoc fd) = createFunDoc nsd fd
516createOtherDoc nsd (FunDoc fd) = createFunDoc nsd fd
514createOtherDoc nsd (ClassDoc n docstring fds) = do
518createOtherDoc nsd (ClassDoc n docstring fds) = do
515 H.dt ! (A.id $ toValue $ show n) $ do
519 H.dt ! (A.id $ toValue $ show n) $ do
@@ -518,6 +522,7 @@ createOtherDoc nsd (ClassDoc n docstring fds) = do
518 H.dd $ do
522 H.dd $ do
519 (if nullDocstring docstring then Empty else renderDoc docstring)
523 (if nullDocstring docstring then Empty else renderDoc docstring)
520 H.dl ! class_ "decls" $ forM_ fds (createFunDoc nsd)
524 H.dl ! class_ "decls" $ forM_ fds (createFunDoc nsd)
521createOtherDoc nsd (DataDoc fd@(FD n docstring args _ _) fds) = do
526createOtherDoc nsd (DataDoc fd@(FD n docstring args _ _) fds) = do
522 H.dt ! (A.id $ toValue $ show n) $ do
527 H.dt ! (A.id $ toValue $ show n) $ do
@@ -566,7 +571,6 @@ wrapper ns inner =
566 H.footer $ do
571 H.footer $ do
567 "Produced by IdrisDoc version "
572 "Produced by IdrisDoc version "
568 toHtml version
573 toHtml version
571 where extract (Just ns) = let nestings = if null ns then 1 else length ns
575 where extract (Just ns) = let nestings = if null ns then 1 else length ns
572 in (False, nsName2Str ns, nestings-1)
576 in (False, nsName2Str ns, nestings-1)