@@ -3,13 +3,14 @@
3-- | Generation of HTML documentation for Idris code
3-- | Generation of HTML documentation for Idris code
4module Idris.IdrisDoc (generateDocs) where
4module Idris.IdrisDoc (generateDocs) where
6−import Idris.Core.TT (Name (..))
6+import Idris.Core.TT (Name (..), txt, nsroot)
7import Idris.Core.Evaluate (ctxtAlist, Def (..))
7import Idris.Core.Evaluate (ctxtAlist, Def (..))
8−import Idris.AbsSyntax (IState, tt_ctxt, runIO, imported)
8+import Idris.AbsSyntax (IState, tt_ctxt, imported)
10import qualified Data.Map as M
10import qualified Data.Map as M
11import qualified Data.Text as T
11import qualified Data.Text as T
13+-- ---------------------------------------------------------------- [ Public ]
14-- | Generates HTML documentation for a series of loaded namespaces and their dependencies.
15-- | Generates HTML documentation for a series of loaded namespaces and their dependencies.
15generateDocs :: IState -- ^ IState where all necessary information is extracted from.
16generateDocs :: IState -- ^ IState where all necessary information is extracted from.
@@ -17,86 +18,38 @@ generateDocs :: IState -- ^ IState where all necessary information is extracted
17 -> FilePath -- ^ The directory to which documentation will be written.
18 -> FilePath -- ^ The directory to which documentation will be written.
18 -> IO (Either String ())
19 -> IO (Either String ())
19generateDocs ist nss out = -- err "IdrisDoc is still in development..."
20generateDocs ist nss out = -- err "IdrisDoc is still in development..."
20− -- Right `fmap` (print $ createNameTrie ist)
21+ -- Right `fmap` (print $ map toNsName nss)
21− -- Right `fmap` (print $ imported ist)
22+ -- Right `fmap` (print $ nsDict ist)
23+ Right `fmap` (print $ imported ist)
26+-- ----------------------------------------------------------------- [ Types ]
24type Failable = Either String
28type Failable = Either String
29+type NsName = [T.Text]
30+type NsInfo = [(Name, Def)]
25−type NsDict = M.Map Name NsInfo
31+type NsDict = M.Map NsName NsInfo
27−data NsInfo = NsInfo { ns :: Name, info :: Maybe () }
33+-- --------------------------------------------------------------- [ Utility ]
29-- | Make an error message
35-- | Make an error message
30err :: String -> IO (Failable ())
36err :: String -> IO (Failable ())
31err s = return $ Left s
37err s = return $ Left s
34−-- ------------------------------------------------------------- [ Name Trie ]
40+-- | Converts a Name into a [Text] corresponding to the namespace part of a NS Name
35−
41+toNsName :: Name -- ^ Name to convert
36−-- | A NameTrie is either:
42+ -> NsName
37−-- a namespace item,
43+toNsName (UN n) = [n]
38−-- a namespace node with children,
44+toNsName (NS n ns) = (toNsName n) ++ ns
39−-- both
45+toNsName _ = []
40−data NameTrie a = NameTrie {
46+
41− content :: Maybe (Name, a),
47+
42− children :: M.Map T.Text (NameTrie a)
48+-- | Retrieves the namespace part of a Name
43− } deriving Show
49+getNs :: Name -- ^ Name to retrieve namespace for
45−-- | Empty NameTrie
51+getNs (NS _ ns) = ns
46−ntEmpty :: NameTrie a
52+getNs _ = []
47−ntEmpty = NameTrie { content = Nothing, children = M.empty }
49−-- | Build NameTrie from a Map
50−ntFromMap :: M.Map T.Text (NameTrie a) -- ^ Mapping of namespace contents
52−ntFromMap m = NameTrie { content = Nothing, children = m }
54−-- | Build NameTrie from a (Maybe NameTrie a)
55−ntFromMaybe :: Maybe (NameTrie a) -- ^ Maybe a NameTrie?
57−ntFromMaybe (Just nt) = nt
58−ntFromMaybe Nothing = ntEmpty
61−-- | Lookup a sub-NameTrie based on a NameTrie identifier.
62−-- Identifier example: A.B.c -> [A,B,c] (reverse Idris-style)
63−ntLookup :: [T.Text] -- ^ Identifier to lookup
64− -> NameTrie a -- ^ The trie to lookup within
65− -> Maybe (NameTrie a)
66−ntLookup (t:ts) n | Just n' <- M.lookup t (children n) = ntLookup ts n'
67−ntLookup [t] n = M.lookup t (children n)
68−ntLookup _ _ = Nothing
71−-- | Add content to a NameTrie
72−ntInsert :: Name -- ^ The name to add content under
73− -> a -- ^ The content to add
74− -> NameTrie a -- ^ The NameTrie (Ns) to add the content to
76−ntInsert n@(UN t) c = ntInsertHelper [t] n c
77−ntInsert n@(NS (UN t) ns) c = ntInsertHelper (reverse $ t:ns) n c
78−ntInsert _ _ = id -- Ignore
80−-- | Add content to a NameTrie using a NameTrie identifier
81−ntInsertHelper :: [T.Text] -- ^ Path of identifiers
82− -> Name -- ^ Name of final entry
83− -> a -- ^ The content to add
84− -> NameTrie a -- ^ The NameTrie (Ns) to add the content to
86−ntInsertHelper (t:ts) n c nt = let cs = children nt
87− subnt = ntFromMaybe $ M.lookup t cs
88− nt' = ntInsertHelper ts n c subnt
89− in nt { children = M.insert t nt' cs }
90−ntInsertHelper [] n c nt = nt { content = Just (n, c) }
93−-- | Creates a trie on which names can be looked up by traveling their namespaces
94−ntCreate :: IState -- ^ IState to fetch info from
96−ntCreate ist = let defList = ctxtAlist $ tt_ctxt ist
97− adder t (n, d) = ntInsert n d t
98− in foldl adder ntEmpty defList
101-- --------------------------------------------------------- [ Info Fetching ]
54-- --------------------------------------------------------- [ Info Fetching ]
@@ -104,18 +57,16 @@ ntCreate ist = let defList = ctxtAlist $ tt_ctxt ist
104fetchInfo :: IState -- ^ IState to fetch info from
57fetchInfo :: IState -- ^ IState to fetch info from
105 -> [Name] -- ^ List of namespaces to fetch info for
58 -> [Name] -- ^ List of namespaces to fetch info for
106 -> NsDict -- ^ Mapping from namespace name to info about its contents
59 -> NsDict -- ^ Mapping from namespace name to info about its contents
107−fetchInfo ist ns = let nameTrie = ntCreate ist
60+fetchInfo ist ns = let nsMap = nsDict ist
108 in undefined
61 in undefined
110−-- | Returns all names defined in a namespace, including child namespaces
111−allNamesInNs :: NameTrie a -- ^ NameTrie to fetch info from
113− -> [Name] -- ^ All names within the namespace
114−allNamesInNs nt n = undefined
116−-- | Returns the namespace within a name is defined
64+-- | Returns a map of NsName -> [(Name, Def)]
117−nsOfName :: Name -- ^ Name to retrieve the namespace of
65+nsDict :: IState
118− -> Name -- ^ The namespace
66+ -> NsDict
119−nsOfName n = undefined
67+nsDict ist = let nameDefList = ctxtAlist $ tt_ctxt ist
68+ adder m c@(n, d) = M.insertWith (++) (getNs n) [c] m
69+ in foldl adder M.empty nameDefList
71+-- ------------------------------------------------------- [ HTML Generation ]
121−-- ------------------------------------------------------- [ HTML Generation ]