Merge pull request #5120 from neduard/fix-4729-roundtrip-bug-in-doc-c…

…allout

unison-src/transcripts-round-trip/main.output.md

@@ -24,7 +24,7 @@ So we can see the pretty-printed output:
 
   ☝️
   
-  I added 105 definitions to the top of scratch.u
+  I added 108 definitions to the top of scratch.u
   
   You can edit them there, then run `update` to replace the
   definitions currently in this namespace.
@@ -331,6 +331,82 @@ fix_4384e =
   }}
   }}
 
+fix_4729a : Doc2
+fix_4729a =
+  {{
+  # H1A
+
+    ## H2A
+
+       ```
+       {{
+       # H1B
+       
+         ## B2B
+         
+            
+       }}
+       ```
+
+    ## H2A
+
+       
+  }}
+
+fix_4729b : Doc2
+fix_4729b =
+  {{
+  # H1A
+
+    ## H2A
+
+       {{ docTable
+         [[{{
+             # HA
+             
+               
+             }}, {{
+             # HB
+             
+               
+             }}], [{{
+             # a
+             
+               
+             }}, {{
+             # b
+             
+               
+             }}]] }}
+
+    ## H2A
+
+       
+  }}
+
+fix_4729c : Doc2
+fix_4729c =
+  {{
+  # Examples ``
+  docCallout
+    (Some
+      (syntax.docUntitledSection
+        [syntax.docSection (syntax.docParagraph [syntax.docWord "Title"]) []]))
+    (syntax.docUntitledSection
+      [ syntax.docParagraph
+          [ syntax.docWord "This"
+          , syntax.docWord "is"
+          , syntax.docWord "a"
+          , syntax.docWord "callout"
+          , syntax.docWord "with"
+          , syntax.docWord "a"
+          , syntax.docWord "title"
+          ]
+      ]) ``
+
+
+  }}
+
 Fix_525.bar.quaffle : Nat
 Fix_525.bar.quaffle = 32
 

unison-src/transcripts-round-trip/reparses-with-same-hash.u

@@ -542,4 +542,45 @@ fix_4384d = {{ {{ docExampleBlock 0 '[1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,
 fix_4384e = 
   id : x -> x
   id x = x
-  {{ {{ docExampleBlock 0 (id id id id id id id id id id id id id id id id id id id id id (x -> 0) }} }}
+  {{ {{ docExampleBlock 0 (id id id id id id id id id id id id id id id id id id id id id (x -> 0) }} }}
+
+fix_4729a = {{
+  # H1A
+
+  ## H2A
+
+  ```
+  {{
+    # H1B
+
+    ## B2B
+  }}
+  ```
+
+  ## H2A
+}}
+
+fix_4729b = {{
+  # H1A
+
+  ## H2A
+
+  {{ docTable [
+     [ {{ # HA }}, {{ # HB }} ],
+     [ {{ ## a }}, {{ ## b }} ]
+     ] }}
+
+  ## H2A
+}}
+
+fix_4729c = {{
+  # Examples
+  ```
+  docCallout
+    (Some
+      {{
+        # Title
+
+      }}) {{ This is a callout with a title }}
+  ```
+}}

unison-syntax/src/Unison/Syntax/Lexer.hs

@@ -71,11 +71,18 @@ type BlockName = String
 type Layout = [(BlockName, Column)]
 
 data ParsingEnv = ParsingEnv
-  { layout :: !Layout, -- layout stack
-    opening :: Maybe BlockName, -- `Just b` if a block of type `b` is being opened
-    inLayout :: Bool, -- are we inside a construct that uses layout?
-    parentSection :: Int, -- 1 means we are inside a # Heading 1
-    parentListColumn :: Int -- 4 means we are inside a list starting at the fourth column
+  { -- layout stack
+    layout :: !Layout,
+    -- `Just b` if a block of type `b` is being opened
+    opening :: Maybe BlockName,
+    -- are we inside a construct that uses layout?
+    inLayout :: Bool,
+    -- Use a stack to remember the parent section and
+    -- allow docSections within docSections.
+    -- 1 means we are inside a # Heading 1
+    parentSections :: [Int],
+    -- 4 means we are inside a list starting at the fourth column
+    parentListColumn :: Int
   }
   deriving (Show)
 
@@ -309,7 +316,7 @@ lexer0' scope rem =
       (P.EndOfInput) -> "end of input"
     customErrs es = [Err <$> e | P.ErrorCustom e <- toList es]
     toPos (P.SourcePos _ line col) = Pos (P.unPos line) (P.unPos col)
-    env0 = ParsingEnv [] (Just scope) True 0 0
+    env0 = ParsingEnv [] (Just scope) True [0] 0
     -- hacky postprocessing pass to do some cleanup of stuff that's annoying to
     -- fix without adding more state to the lexer:
     --   - 1+1 lexes as [1, +1], convert this to [1, +, 1]
@@ -429,13 +436,20 @@ lexemes' eof =
       -- Construct the token for opening the doc block.
       let openTok = Token (Open "syntax.docUntitledSection") openStart openEnd
       env0 <- S.get
-      -- Disable layout while parsing the doc block
-      (bodyToks0, closeTok) <- local (\env -> env {inLayout = False}) do
-        bodyToks <- body
-        closeStart <- posP
-        lit "}}"
-        closeEnd <- posP
-        pure (bodyToks, Token Close closeStart closeEnd)
+      -- Disable layout while parsing the doc block and reset the section number
+      (bodyToks0, closeTok) <- local
+        ( \env ->
+            env
+              { inLayout = False,
+                parentSections = 0 : (parentSections env0)
+              }
+        )
+        do
+          bodyToks <- body
+          closeStart <- posP
+          lit "}}"
+          closeEnd <- posP
+          pure (bodyToks, Token Close closeStart closeEnd)
       let docToks = beforeStartToks <> [openTok] <> bodyToks0 <> [closeTok]
       -- Parse any layout tokens after the doc block, e.g. virtual semicolon
       endToks <- token' ignore (pure ())
@@ -814,12 +828,12 @@ lexemes' eof =
         -- # A section title (not a subsection)
         section :: P [Token Lexeme]
         section = wrap "syntax.docSection" $ do
-          n <- S.gets parentSection
-          hashes <- P.try $ lit (replicate n '#') *> P.takeWhile1P Nothing (== '#') <* sp
+          ns <- S.gets parentSections
+          hashes <- P.try $ lit (replicate (head ns) '#') *> P.takeWhile1P Nothing (== '#') <* sp
           title <- paragraph <* CP.space
-          let m = length hashes + n
+          let m = length hashes + head ns
           body <-
-            local (\env -> env {parentSection = m}) $
+            local (\env -> env {parentSections = (m : (tail ns))}) $
               P.many (sectionElem <* CP.space)
           pure $ title <> join body