@@ -5,7 +5,7 @@
5module Idris.IdrisDoc (generateDocs) where
5module Idris.IdrisDoc (generateDocs) where
7import Idris.Core.TT (Name (..), sUN, SpecialName (..), OutputAnnotation (..),
7import Idris.Core.TT (Name (..), sUN, SpecialName (..), OutputAnnotation (..),
8− TextFormatting (..), txt, str, nsroot, constIsType)
8+ TextFormatting (..), txt, str, nsroot, constIsType, toAlist)
9import Idris.Core.Evaluate (ctxtAlist, Def (..), lookupDefAcc,
9import Idris.Core.Evaluate (ctxtAlist, Def (..), lookupDefAcc,
10 Accessibility (..), isDConName, isFnName,
10 Accessibility (..), isDConName, isFnName,
11 isTConName)
11 isTConName)
@@ -17,6 +17,7 @@ import qualified Idris.Docstrings as Docstrings
18import IRTS.System (getDataFileName)
18import IRTS.System (getDataFileName)
20+import Control.Applicative ((<|>))
20import Control.Monad (forM_)
21import Control.Monad (forM_)
21import Control.Monad.Trans.Except
22import Control.Monad.Trans.Except
22import Control.Monad.Trans.State.Strict
23import Control.Monad.Trans.State.Strict
@@ -29,6 +30,7 @@ import qualified Data.Text.Encoding as E
29import qualified Data.List as L
30import qualified Data.List as L
30import qualified Data.List.Split as LS
31import qualified Data.List.Split as LS
31import qualified Data.Map as M hiding ((!))
32import qualified Data.Map as M hiding ((!))
33+import Data.Monoid (mempty)
32import qualified Data.Ord (compare)
34import qualified Data.Ord (compare)
33import qualified Data.Set as S
35import qualified Data.Set as S
34import qualified Data.Text as T
36import qualified Data.Text as T
@@ -81,16 +83,21 @@ generateDocs ist nss' out =
81type Failable = Either String
83type Failable = Either String
83-- | Internal representation of a fully qualified namespace name
85-- | Internal representation of a fully qualified namespace name
84−type NsName = [T.Text]
86+type NsName = [T.Text]
86-- | All information to be documented about a single namespace member
88-- | All information to be documented about a single namespace member
87−type NsItem = (Name, Maybe Docs, Accessibility)
89+type NsItem = (Name, Maybe Docs, Accessibility)
91+-- | Docstrings containing fully elaborated term annotations
92+type FullDocstring = Docstrings.Docstring Docstrings.DocTerm
89-- | All information to be documented about a namespace
94-- | All information to be documented about a namespace
90−type NsInfo = [NsItem]
95+data NsInfo = NsInfo { nsDocstring :: Maybe FullDocstring,
96+ nsContents :: [NsItem]
92-- | A map from namespace names to information about them
99-- | A map from namespace names to information about them
93−type NsDict = M.Map NsName NsInfo
100+type NsDict = M.Map NsName NsInfo
95-- --------------------------------------------------------------- [ Utility ]
102-- --------------------------------------------------------------- [ Utility ]
@@ -142,12 +149,15 @@ fetchInfo :: IState -- ^ IState to fetch info from
142fetchInfo ist nss =
149fetchInfo ist nss =
143 do let originNss = S.fromList nss
150 do let originNss = S.fromList nss
144 info <- nsDict ist
151 info <- nsDict ist
145− let info' = M.map (filter filterInclude) info
152+ let accessible = M.map (filterContents filterInclude) info
146− info'' = M.map removeOrphans info'
153+ nonOrphan = M.map (updateContents removeOrphans) accessible
147− info''' = M.filter (not . null) info''
154+ nonEmpty = M.filter (not . null . nsContents) nonOrphan
148− reachedNss = traceNss info''' originNss S.empty
155+ reachedNss = traceNss nonEmpty originNss S.empty
149− return $ M.filterWithKey (\k _ -> S.member k reachedNss) info'''
156+ return $ M.filterWithKey (\k _ -> S.member k reachedNss) nonEmpty
159+ filterContents p (NsInfo md ns) = NsInfo md (filter p ns)
160+ updateContents f x = x { nsContents = f (nsContents x) }
152-- | Removes loose class methods and data constructors,
162-- | Removes loose class methods and data constructors,
153-- leaving them documented only under their parent.
163-- leaving them documented only under their parent.
@@ -187,7 +197,7 @@ traceNss :: NsDict -- ^ Mappings of namespaces and their contents
187 -> S.Set NsName -- ^ Set of namespaces which has been traced
197 -> S.Set NsName -- ^ Set of namespaces which has been traced
188 -> S.Set NsName -- ^ Set of namespaces to trace and all traced one
198 -> S.Set NsName -- ^ Set of namespaces to trace and all traced one
189traceNss nsd sT sD =
199traceNss nsd sT sD =
190− let nsTracer ns | Just nsis <- M.lookup ns nsd = map referredNss nsis
200+ let nsTracer ns | Just nsis <- M.lookup ns nsd = map referredNss (nsContents nsis)
191 nsTracer _ = [S.empty] -- Ignore
201 nsTracer _ = [S.empty] -- Ignore
192 reached = S.unions $ concatMap nsTracer (S.toList sT)
202 reached = S.unions $ concatMap nsTracer (S.toList sT)
193 processed = S.union sT sD
203 processed = S.union sT sD
@@ -217,14 +227,19 @@ referredNss (n, Just d, _) =
217-- | Returns an NsDict of containing all known namespaces and their contents
227-- | Returns an NsDict of containing all known namespaces and their contents
218nsDict :: IState
228nsDict :: IState
219 -> IO NsDict
229 -> IO NsDict
220−nsDict ist =
230+nsDict ist = flip (foldl addModDoc) modDocs $ foldl adder (return M.empty) nameDefList
221− let nameDefList = ctxtAlist $ tt_ctxt ist
231+ where nameDefList = ctxtAlist $ tt_ctxt ist
222− adder m (n, _) = do map <- m
232+ adder m (n, _) = do map <- m
223− doc <- loadDocs ist n
233+ doc <- loadDocs ist n
224− let acc = getAccess ist n
234+ let access = getAccess ist n
225− c = [(n, doc, acc)]
235+ nInfo = NsInfo Nothing [(n, doc, access)]
226− return $ M.insertWith (++) (getNs n) c map
236+ return $ M.insertWith addNameInfo (getNs n) nInfo map
227− in foldl adder (return M.empty) nameDefList
237+ addNameInfo (NsInfo m ns) (NsInfo m' ns') = NsInfo (m <|> m') (ns ++ ns')
238+ modDocs = map (\(mn, d) -> (mn, NsInfo (Just d) [])) $ toAlist (idris_moduledocs ist)
239+ addModDoc :: IO NsDict -> (Name, NsInfo) -> IO NsDict
240+ addModDoc dict (mn, d) = fmap (M.insertWith addNameInfo (getNs mn) d) dict
230-- | Gets the Accessibility for a Name
245-- | Gets the Accessibility for a Name
@@ -427,11 +442,14 @@ createNsDoc ist ns content out =
427 haveDocs (_, Just d, _) = [d]
442 haveDocs (_, Just d, _) = [d]
428 haveDocs _ = []
443 haveDocs _ = []
429 -- We cannot do anything without a Doc
444 -- We cannot do anything without a Doc
430− content' = concatMap haveDocs content
445+ content' = concatMap haveDocs (nsContents content)
431 createDirectoryIfMissing True dir
446 createDirectoryIfMissing True dir
432 (path, h) <- openTempFile dir file
447 (path, h) <- openTempFile dir file
433 BS2.hPut h $ renderHtml $ wrapper (Just ns) $ do
448 BS2.hPut h $ renderHtml $ wrapper (Just ns) $ do
434 H.h1 $ toHtml (nsName2Str ns)
449 H.h1 $ toHtml (nsName2Str ns)
450+ case nsDocstring content of
452+ Just docstring -> Docstrings.renderHtml docstring
435 H.dl ! class_ "decls" $ forM_ content' (createOtherDoc ist)
453 H.dl ! class_ "decls" $ forM_ content' (createOtherDoc ist)
437 renameFile path tpath
455 renameFile path tpath
@@ -590,6 +608,8 @@ createOtherDoc ist (DataDoc fd@(FD n docstring args _ _) fds) = do
590 H.dt $ toHtml $ show name
608 H.dt $ toHtml $ show name
591 H.dd $ Docstrings.renderHtml docstring
609 H.dd $ Docstrings.renderHtml docstring
611+createOtherDoc ist (ModDoc _ docstring) = do
612+ Docstrings.renderHtml docstring
594-- | Generates everything but the actual content of the page
614-- | Generates everything but the actual content of the page
595wrapper :: Maybe NsName -- ^ Namespace name, unless it is the index
615wrapper :: Maybe NsName -- ^ Namespace name, unless it is the index