@@ -5,7 +5,7 @@
55module Idris.IdrisDoc (generateDocs) where
66
77import Idris.Core.TT (Name (..), sUN, SpecialName (..), OutputAnnotation (..),
8− TextFormatting (..), txt, str, nsroot, constIsType)
8+ TextFormatting (..), txt, str, nsroot, constIsType, toAlist)
99import Idris.Core.Evaluate (ctxtAlist, Def (..), lookupDefAcc,
1010 Accessibility (..), isDConName, isFnName,
1111 isTConName)
@@ -17,6 +17,7 @@ import qualified Idris.Docstrings as Docstrings
1717
1818import IRTS.System (getDataFileName)
1919
20+import Control.Applicative ((<|>))
2021import Control.Monad (forM_)
2122import Control.Monad.Trans.Except
2223import Control.Monad.Trans.State.Strict
@@ -29,6 +30,7 @@ import qualified Data.Text.Encoding as E
2930import qualified Data.List as L
3031import qualified Data.List.Split as LS
3132import qualified Data.Map as M hiding ((!))
33+import Data.Monoid (mempty)
3234import qualified Data.Ord (compare)
3335import qualified Data.Set as S
3436import qualified Data.Text as T
@@ -81,16 +83,21 @@ generateDocs ist nss' out =
8183type Failable = Either String
8284
8385-- | Internal representation of a fully qualified namespace name
84−type NsName = [T.Text]
86+type NsName = [T.Text]
8587
8688-- | All information to be documented about a single namespace member
87−type NsItem = (Name, Maybe Docs, Accessibility)
89+type NsItem = (Name, Maybe Docs, Accessibility)
90+
91+-- | Docstrings containing fully elaborated term annotations
92+type FullDocstring = Docstrings.Docstring Docstrings.DocTerm
8893
8994-- | All information to be documented about a namespace
90−type NsInfo = [NsItem]
95+data NsInfo = NsInfo { nsDocstring :: Maybe FullDocstring,
96+ nsContents :: [NsItem]
97+ }
9198
9299-- | A map from namespace names to information about them
93−type NsDict = M.Map NsName NsInfo
100+type NsDict = M.Map NsName NsInfo
94101
95102-- --------------------------------------------------------------- [ Utility ]
96103
@@ -142,12 +149,15 @@ fetchInfo :: IState -- ^ IState to fetch info from
142149fetchInfo ist nss =
143150 do let originNss = S.fromList nss
144151 info <- nsDict ist
145− let info' = M.map (filter filterInclude) info
146− info'' = M.map removeOrphans info'
147− info''' = M.filter (not . null) info''
148− reachedNss = traceNss info''' originNss S.empty
149− return $ M.filterWithKey (\k _ -> S.member k reachedNss) info'''
150−
152+ let accessible = M.map (filterContents filterInclude) info
153+ nonOrphan = M.map (updateContents removeOrphans) accessible
154+ nonEmpty = M.filter (not . null . nsContents) nonOrphan
155+ reachedNss = traceNss nonEmpty originNss S.empty
156+ return $ M.filterWithKey (\k _ -> S.member k reachedNss) nonEmpty
157+ where
158+ -- TODO: lensify
159+ filterContents p (NsInfo md ns) = NsInfo md (filter p ns)
160+ updateContents f x = x { nsContents = f (nsContents x) }
151161
152162-- | Removes loose class methods and data constructors,
153163-- leaving them documented only under their parent.
@@ -187,7 +197,7 @@ traceNss :: NsDict -- ^ Mappings of namespaces and their contents
187197 -> S.Set NsName -- ^ Set of namespaces which has been traced
188198 -> S.Set NsName -- ^ Set of namespaces to trace and all traced one
189199traceNss 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)
191201 nsTracer _ = [S.empty] -- Ignore
192202 reached = S.unions $ concatMap nsTracer (S.toList sT)
193203 processed = S.union sT sD
@@ -217,14 +227,19 @@ referredNss (n, Just d, _) =
217227-- | Returns an NsDict of containing all known namespaces and their contents
218228nsDict :: IState
219229 -> IO NsDict
220−nsDict ist =
221− let nameDefList = ctxtAlist $ tt_ctxt ist
222− adder m (n, _) = do map <- m
223− doc <- loadDocs ist n
224− let acc = getAccess ist n
225− c = [(n, doc, acc)]
226− return $ M.insertWith (++) (getNs n) c map
227− in foldl adder (return M.empty) nameDefList
230+nsDict ist = flip (foldl addModDoc) modDocs $ foldl adder (return M.empty) nameDefList
231+ where nameDefList = ctxtAlist $ tt_ctxt ist
232+ adder m (n, _) = do map <- m
233+ doc <- loadDocs ist n
234+ let access = getAccess ist n
235+ nInfo = NsInfo Nothing [(n, doc, access)]
236+ return $ M.insertWith addNameInfo (getNs n) nInfo map
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
241+
242+
228243
229244
230245-- | Gets the Accessibility for a Name
@@ -427,11 +442,14 @@ createNsDoc ist ns content out =
427442 haveDocs (_, Just d, _) = [d]
428443 haveDocs _ = []
429444 -- We cannot do anything without a Doc
430− content' = concatMap haveDocs content
445+ content' = concatMap haveDocs (nsContents content)
431446 createDirectoryIfMissing True dir
432447 (path, h) <- openTempFile dir file
433448 BS2.hPut h $ renderHtml $ wrapper (Just ns) $ do
434449 H.h1 $ toHtml (nsName2Str ns)
450+ case nsDocstring content of
451+ Nothing -> mempty
452+ Just docstring -> Docstrings.renderHtml docstring
435453 H.dl ! class_ "decls" $ forM_ content' (createOtherDoc ist)
436454 hClose h
437455 renameFile path tpath
@@ -590,6 +608,8 @@ createOtherDoc ist (DataDoc fd@(FD n docstring args _ _) fds) = do
590608 H.dt $ toHtml $ show name
591609 H.dd $ Docstrings.renderHtml docstring
592610
611+createOtherDoc ist (ModDoc _ docstring) = do
612+ Docstrings.renderHtml docstring
593613
594614-- | Generates everything but the actual content of the page
595615wrapper :: Maybe NsName -- ^ Namespace name, unless it is the index