[ fix ] properly handle Namespace blocks for DocStrings (#1342)

src/Core/Context.idr

@@ -1998,6 +1998,20 @@ extendNS ns
     = do defs <- get Ctxt
          put Ctxt (record { currentNS $= (<.> ns) } defs)
 
+export
+withExtendedNS : {auto c : Ref Ctxt Defs} ->
+                 Namespace -> Core a -> Core a
+withExtendedNS ns act
+    = do defs <- get Ctxt
+         let cns = currentNS defs
+         put Ctxt (record { currentNS = cns <.> ns } defs)
+         ma <- catch (Right <$> act) (pure . Left)
+         defs <- get Ctxt
+         put Ctxt (record { currentNS = cns } defs)
+         case ma of
+           Left err => throw err
+           Right a  => pure a
+
 -- Get the name as it would be defined in the current namespace
 -- i.e. if it doesn't have an explicit namespace already, add it,
 -- otherwise leave it alone

src/Idris/Desugar.idr

@@ -953,7 +953,8 @@ mutual
            mds' <- traverse (desugarDecl ps) mds
            pure (concat mds')
   desugarDecl ps (PNamespace fc ns decls)
-      = do ds <- traverse (desugarDecl ps) decls
+      = withExtendedNS ns $ do
+           ds <- traverse (desugarDecl ps) decls
            pure [INamespace fc ns (concat ds)]
   desugarDecl ps (PTransform fc n lhs rhs)
       = do (bound, blhs) <- bindNames False !(desugar LHS ps lhs)

src/Idris/DocString.idr

@@ -1,6 +1,7 @@
 module Idris.DocString
 
 import Core.Context
+import Core.Context.Log
 import Core.Core
 import Core.Env
 import Core.TT
@@ -68,6 +69,8 @@ addDocString : {auto c : Ref Ctxt Defs} ->
                Core ()
 addDocString n_in doc
     = do n <- inCurrentNS n_in
+         log "doc.record" 50 $
+           "Adding doc for " ++ show n_in ++ " (aka " ++ show n ++ " in current NS)"
          syn <- get Syn
          put Syn (record { docstrings $= addName n doc,
                            saveDocstrings $= insert n () } syn)

src/TTImp/ProcessDecls.idr

@@ -47,12 +47,8 @@ process eopts nest env (IParameters fc ps decls)
 process eopts nest env (IRecord fc ns vis rec)
     = processRecord eopts nest env ns vis rec
 process eopts nest env (INamespace fc ns decls)
-    = do defs <- get Ctxt
-         let cns = currentNS defs
-         extendNS ns
+    = withExtendedNS ns $
          traverse_ (processDecl eopts nest env) decls
-         defs <- get Ctxt
-         put Ctxt (record { currentNS = cns } defs)
 process eopts nest env (ITransform fc n lhs rhs)
     = processTransform eopts nest env fc n lhs rhs
 process eopts nest env (IRunElabDecl fc tm)

tests/idris2/docs001/expected

@@ -18,6 +18,7 @@ Main> Prelude.List : Type -> Type
     Nil : List a
       Empty list
     (::) : a -> List a -> List a
+      A non-empty list, consisting of a head element and the rest of the list.
 Main> Prelude.Show : Type -> Type
   Things that have a canonical `String` representation.
   Parameters: ty

tests/idris2/docs002/Doc.idr

@@ -12,3 +12,11 @@ export
 ||| Hello!
 hello : Int -> Int
 hello x = x*2
+
+namespace NS
+
+  namespace NestedNS
+
+    ||| A type of Foo
+    Foo : Type
+    Foo = ()

tests/idris2/docs002/expected

@@ -3,4 +3,7 @@ Doc> hello : Int -> Int
 	Hello!
 world : Nat -> Nat
 	World!
+Doc> Doc.NS.NestedNS.Foo : Type
+  A type of Foo
+  
 Doc> Bye for now!

tests/idris2/docs002/input

@@ -1,2 +1,3 @@
 :browse Doc
+:doc Foo
 :q