Merge pull request #2427 from unisonweb/topic/emphroundtrip

Fix emphasis roundtrip in docs
2024-10-04 13:47:26 +03:00 · 2021-09-22 19:52:35 +00:00 · 2021-09-22 19:52:35 +00:00 · 3997ba5aee
commit 3997ba5aee
parent 22f1587448 671397661a
6 changed files with 186 additions and 93 deletions
--- a/parser-typechecker/src/Unison/Lexer.hs
+++ b/parser-typechecker/src/Unison/Lexer.hs
@ -342,22 +342,24 @@ lexemes' eof = P.optional space >> do
      isPrefixOf "}}" word ||
      all (== '#') word

-    wordy ok = wrap "syntax.docWord" . tok . fmap Textual . P.try $ do
-      let end = P.lookAhead $ void docClose
-                          <|> void docOpen
-                          <|> void (CP.satisfy isSpace)
-                          <|> void (CP.satisfy (not . ok))
-      word <- P.someTill (CP.satisfy (\ch -> not (isSpace ch) && ok ch)) end
-      guard (not $ reserved word)
+    wordy closing = wrap "syntax.docWord" . tok . fmap Textual . P.try $ do
+      let end =
+            P.lookAhead
+              $   void docClose
+              <|> void docOpen
+              <|> void (CP.satisfy isSpace)
+              <|> void closing
+      word <- P.manyTill (CP.satisfy (\ch -> not (isSpace ch))) end
+      guard (not $ reserved word || null word)
      pure word

-    leafy ok = groupy ok gs
-          where
-          gs = link <|> externalLink <|> exampleInline <|> expr
-           <|> boldOrItalicOrStrikethrough ok <|> verbatim
-           <|> atDoc <|> wordy ok
+    leafy closing = groupy closing gs
+      where
+      gs = link <|> externalLink <|> exampleInline <|> expr
+       <|> boldOrItalicOrStrikethrough closing <|> verbatim
+       <|> atDoc <|> wordy closing

-    leaf = leafy (const True)
+    leaf = leafy mzero

    atDoc = src <|> evalInline <|> signature <|> signatureInline
      where
@ -403,9 +405,9 @@ lexemes' eof = P.optional space >> do
    signatureLink = wrap "syntax.docEmbedSignatureLink" $
      tok (symbolyId <|> wordyId) <* CP.space

-    groupy ok p = do
+    groupy closing p = do
      (start,p,stop) <- positioned p
-      after <- P.optional . P.try $ leafy ok
+      after <- P.optional . P.try $ leafy closing
      pure $ case after of
        Nothing -> p
        Just after ->
@ -486,28 +488,30 @@ lexemes' eof = P.optional space >> do
          verbatim <- tok $ Textual . trim <$> P.someTill CP.anyChar ([] <$ lit fence)
          pure (name <> verbatim)

-    boldOrItalicOrStrikethrough ok = do
-      let start = some (CP.satisfy (== '*')) <|> some (CP.satisfy (== '_')) <|> some (CP.satisfy (== '~'))
-          name s = if take 1 s == "~" then "syntax.docStrikethrough"
-                   else if length s > 1 then "syntax.docBold"
-                   else "syntax.docItalic"
-      (end,ch) <- P.try $ do
-        end@(ch:_) <- start
+    boldOrItalicOrStrikethrough closing = do
+      let start =
+            some (CP.satisfy (== '*')) <|> some (CP.satisfy (== '_')) <|> some
+              (CP.satisfy (== '~'))
+          name s = if take 1 s == "~"
+            then "syntax.docStrikethrough"
+            else if take 1 s == "*" then "syntax.docBold" else "syntax.docItalic"
+      end <- P.try $ do
+        end <- start
        P.lookAhead (CP.satisfy (not . isSpace))
-        pure (end,ch)
-      wrap (name end) . wrap "syntax.docParagraph" $
-        join <$> P.someTill (leafy (\c -> ok c && c /= ch) <* nonNewlineSpaces)
-                            (lit end)
+        pure end
+      wrap (name end) . wrap "syntax.docParagraph" $ join <$> P.someTill
+        (leafy (closing <|> (void $ lit end)) <* nonNewlineSpaces)
+        (lit end)

    externalLink =
      P.label "hyperlink (example: [link name](https://destination.com))" $
      wrap "syntax.docNamedLink" $ do
        _ <- lit "["
-        p <- leafies (/= ']')
+        p <- leafies (void $ char ']')
        _ <- lit "]"
        _ <- lit "("
        target <- wrap "syntax.docGroup" . wrap "syntax.docJoin" $
-                  link <|> fmap join (P.some (expr <|> wordy (/= ')')))
+                  link <|> fmap join (P.some (expr <|> wordy (char ')')))
        _ <- lit ")"
        pure (p <> target)

--- a/parser-typechecker/src/Unison/TermPrinter.hs
+++ b/parser-typechecker/src/Unison/TermPrinter.hs
@ -1311,6 +1311,16 @@ prettyDoc2 ppe ac tm = case tm of
          S.DocDelimiter
          "}}"
    bail tm = brace (pretty0 ppe ac tm)
+    -- Finds the longest run of a character and return a run one longer than that
+    oneMore c inner = replicate num c
+     where
+      num =
+        case
+            filter (\s -> take 2 s == "__")
+              $ group (PP.toPlainUnbroken $ PP.syntaxToColor inner)
+          of
+            [] -> 2
+            x  -> 1 + (maximum $ map length x)
    go :: Width -> Term3 v PrintAnnotation -> Pretty SyntaxText
    go hdr = \case
      (toDocTransclude ppe -> Just d) ->
@ -1336,15 +1346,23 @@ prettyDoc2 ppe ac tm = case tm of
      (toDocWord ppe -> Just t) ->
        PP.text t
      (toDocCode ppe -> Just d) ->
-        PP.group ("''" <> rec d <> "''")
+        let inner = rec d
+            quotes = oneMore '\'' inner
+         in PP.group $ PP.string quotes <> inner <> PP.string quotes
      (toDocJoin ppe -> Just ds) ->
        foldMap rec ds
      (toDocItalic ppe -> Just d) ->
-        PP.group $ "*" <> rec d <> "*"
+        let inner = rec d
+            underscores = oneMore '_' inner
+         in PP.group $ PP.string underscores <> inner <> PP.string underscores
      (toDocBold ppe -> Just d) ->
-        PP.group $ "__" <> rec d <> "__"
+        let inner = rec d
+            stars = oneMore '*' inner
+         in PP.group $ PP.string stars <> inner <> PP.string stars
      (toDocStrikethrough ppe -> Just d) ->
-        PP.group $ "~~" <> rec d <> "~~"
+         let inner = rec d
+             quotes = oneMore '~' inner
+         in PP.group $ PP.string quotes <> inner <> PP.string quotes
      (toDocGroup ppe -> Just d) ->
        PP.group $ rec d
      (toDocColumn ppe -> Just ds) ->
--- a/unison-src/transcripts-round-trip/main.md
+++ b/unison-src/transcripts-round-trip/main.md
@ -152,3 +152,21 @@ foo =
 .> load scratch.u
 ```

+## Emphasis in docs inserts the right number of underscores
+
+Regression test for https://github.com/unisonweb/unison/issues/2408
+
+```unison:hide
+myDoc = {{ **my text** __my text__ **MY_TEXT** ___MY__TEXT___ ~~MY~TEXT~~ **MY*TEXT** }}
+```
+
+```ucm
+.> add
+.> edit myDoc
+.> undo
+```
+
+``` ucm
+.> load scratch.u
+```
+
--- a/unison-src/transcripts-round-trip/main.output.md
+++ b/unison-src/transcripts-round-trip/main.output.md
@ -34,15 +34,15 @@ x = 1 + 1
  most recent, along with the command that got us there. Try:
  
    `fork 2 .old`             
-    `fork #pqvd5behc2 .old`   to make an old namespace
+    `fork #bt17giel42 .old`   to make an old namespace
                              accessible again,
                              
-    `reset-root #pqvd5behc2`  to reset the root namespace and
+    `reset-root #bt17giel42`  to reset the root namespace and
                              its history to that of the
                              specified namespace.
  
-  1. #8rn1an5gj8 : add
-  2. #pqvd5behc2 : builtins.mergeio
+  1. #agadr8gg6g : add
+  2. #bt17giel42 : builtins.mergeio
  3. #sjg2v58vn2 : (initial reflogged namespace)

 .> reset-root 2
@ -116,17 +116,17 @@ Without the above stanza, the `edit` will send the definition to the most recent
  most recent, along with the command that got us there. Try:
  
    `fork 2 .old`             
-    `fork #pqvd5behc2 .old`   to make an old namespace
+    `fork #bt17giel42 .old`   to make an old namespace
                              accessible again,
                              
-    `reset-root #pqvd5behc2`  to reset the root namespace and
+    `reset-root #bt17giel42`  to reset the root namespace and
                              its history to that of the
                              specified namespace.
  
-  1. #dbvse9969b : add
-  2. #pqvd5behc2 : reset-root #pqvd5behc2
-  3. #8rn1an5gj8 : add
-  4. #pqvd5behc2 : builtins.mergeio
+  1. #rhf1s808fb : add
+  2. #bt17giel42 : reset-root #bt17giel42
+  3. #agadr8gg6g : add
+  4. #bt17giel42 : builtins.mergeio
  5. #sjg2v58vn2 : (initial reflogged namespace)

 .> reset-root 2
@ -191,19 +191,19 @@ f x = let
  most recent, along with the command that got us there. Try:
  
    `fork 2 .old`             
-    `fork #pqvd5behc2 .old`   to make an old namespace
+    `fork #bt17giel42 .old`   to make an old namespace
                              accessible again,
                              
-    `reset-root #pqvd5behc2`  to reset the root namespace and
+    `reset-root #bt17giel42`  to reset the root namespace and
                              its history to that of the
                              specified namespace.
  
-  1. #clsum27pr1 : add
-  2. #pqvd5behc2 : reset-root #pqvd5behc2
-  3. #dbvse9969b : add
-  4. #pqvd5behc2 : reset-root #pqvd5behc2
-  5. #8rn1an5gj8 : add
-  6. #pqvd5behc2 : builtins.mergeio
+  1. #gj5agagj7s : add
+  2. #bt17giel42 : reset-root #bt17giel42
+  3. #rhf1s808fb : add
+  4. #bt17giel42 : reset-root #bt17giel42
+  5. #agadr8gg6g : add
+  6. #bt17giel42 : builtins.mergeio
  7. #sjg2v58vn2 : (initial reflogged namespace)

 .> reset-root 2
@ -273,21 +273,21 @@ h xs = match xs with
  most recent, along with the command that got us there. Try:
  
    `fork 2 .old`             
-    `fork #pqvd5behc2 .old`   to make an old namespace
+    `fork #bt17giel42 .old`   to make an old namespace
                              accessible again,
                              
-    `reset-root #pqvd5behc2`  to reset the root namespace and
+    `reset-root #bt17giel42`  to reset the root namespace and
                              its history to that of the
                              specified namespace.
  
-  1. #acngtb04a8 : add
-  2. #pqvd5behc2 : reset-root #pqvd5behc2
-  3. #clsum27pr1 : add
-  4. #pqvd5behc2 : reset-root #pqvd5behc2
-  5. #dbvse9969b : add
-  6. #pqvd5behc2 : reset-root #pqvd5behc2
-  7. #8rn1an5gj8 : add
-  8. #pqvd5behc2 : builtins.mergeio
+  1. #3igmh2it4p : add
+  2. #bt17giel42 : reset-root #bt17giel42
+  3. #gj5agagj7s : add
+  4. #bt17giel42 : reset-root #bt17giel42
+  5. #rhf1s808fb : add
+  6. #bt17giel42 : reset-root #bt17giel42
+  7. #agadr8gg6g : add
+  8. #bt17giel42 : builtins.mergeio
  9. #sjg2v58vn2 : (initial reflogged namespace)

 .> reset-root 2
@ -353,23 +353,23 @@ foo n _ = n
  most recent, along with the command that got us there. Try:
  
    `fork 2 .old`             
-    `fork #pqvd5behc2 .old`   to make an old namespace
+    `fork #bt17giel42 .old`   to make an old namespace
                              accessible again,
                              
-    `reset-root #pqvd5behc2`  to reset the root namespace and
+    `reset-root #bt17giel42`  to reset the root namespace and
                              its history to that of the
                              specified namespace.
  
-  1.  #j32i1remee : add
-  2.  #pqvd5behc2 : reset-root #pqvd5behc2
-  3.  #acngtb04a8 : add
-  4.  #pqvd5behc2 : reset-root #pqvd5behc2
-  5.  #clsum27pr1 : add
-  6.  #pqvd5behc2 : reset-root #pqvd5behc2
-  7.  #dbvse9969b : add
-  8.  #pqvd5behc2 : reset-root #pqvd5behc2
-  9.  #8rn1an5gj8 : add
-  10. #pqvd5behc2 : builtins.mergeio
+  1.  #jsnoueu9le : add
+  2.  #bt17giel42 : reset-root #bt17giel42
+  3.  #3igmh2it4p : add
+  4.  #bt17giel42 : reset-root #bt17giel42
+  5.  #gj5agagj7s : add
+  6.  #bt17giel42 : reset-root #bt17giel42
+  7.  #rhf1s808fb : add
+  8.  #bt17giel42 : reset-root #bt17giel42
+  9.  #agadr8gg6g : add
+  10. #bt17giel42 : builtins.mergeio
  11. #sjg2v58vn2 : (initial reflogged namespace)

 .> reset-root 2
@ -432,25 +432,25 @@ foo =
  most recent, along with the command that got us there. Try:
  
    `fork 2 .old`             
-    `fork #pqvd5behc2 .old`   to make an old namespace
+    `fork #bt17giel42 .old`   to make an old namespace
                              accessible again,
                              
-    `reset-root #pqvd5behc2`  to reset the root namespace and
+    `reset-root #bt17giel42`  to reset the root namespace and
                              its history to that of the
                              specified namespace.
  
-  1.  #o6r7803627 : add
-  2.  #pqvd5behc2 : reset-root #pqvd5behc2
-  3.  #j32i1remee : add
-  4.  #pqvd5behc2 : reset-root #pqvd5behc2
-  5.  #acngtb04a8 : add
-  6.  #pqvd5behc2 : reset-root #pqvd5behc2
-  7.  #clsum27pr1 : add
-  8.  #pqvd5behc2 : reset-root #pqvd5behc2
-  9.  #dbvse9969b : add
-  10. #pqvd5behc2 : reset-root #pqvd5behc2
-  11. #8rn1an5gj8 : add
-  12. #pqvd5behc2 : builtins.mergeio
+  1.  #vbmanbqtlh : add
+  2.  #bt17giel42 : reset-root #bt17giel42
+  3.  #jsnoueu9le : add
+  4.  #bt17giel42 : reset-root #bt17giel42
+  5.  #3igmh2it4p : add
+  6.  #bt17giel42 : reset-root #bt17giel42
+  7.  #gj5agagj7s : add
+  8.  #bt17giel42 : reset-root #bt17giel42
+  9.  #rhf1s808fb : add
+  10. #bt17giel42 : reset-root #bt17giel42
+  11. #agadr8gg6g : add
+  12. #bt17giel42 : builtins.mergeio
  13. #sjg2v58vn2 : (initial reflogged namespace)

 .> reset-root 2
@ -470,3 +470,56 @@ foo =
      foo : Text

 ```
+## Emphasis in docs inserts the right number of underscores
+
+Regression test for https://github.com/unisonweb/unison/issues/2408
+
+```unison
+myDoc = {{ **my text** __my text__ **MY_TEXT** ___MY__TEXT___ ~~MY~TEXT~~ **MY*TEXT** }}
+```
+
+```ucm
+.> add
+
+  ⍟ I've added these definitions:
+  
+    myDoc : Doc2
+
+.> edit myDoc
+
+  ☝️
+  
+  I added these definitions to the top of
+  /Users/runar/work/unison/scratch.u
+  
+    myDoc : Doc2
+    myDoc =
+      {{
+      **my text** __my text__ **MY_TEXT** ___MY__TEXT___
+      ~~MY~TEXT~~ **MY*TEXT**
+      }}
+  
+  You can edit them there, then do `update` to replace the
+  definitions currently in this namespace.
+
+.> undo
+
+  Here are the changes I undid
+  
+  Added definitions:
+  
+    1. myDoc : Doc2
+
+```
+```ucm
+.> load scratch.u
+
+  I found and typechecked these definitions in scratch.u. If you
+  do an `add` or `update`, here's how your codebase would
+  change:
+  
+    ⍟ These new definitions are ok to `add`:
+    
+      myDoc : Doc2
+
+```
--- a/unison-src/transcripts-using-base/doc.md.files/syntax.u
+++ b/unison-src/transcripts-using-base/doc.md.files/syntax.u
@ -5,7 +5,7 @@ basicFormatting = {{
    Paragraphs are separated by one or more blanklines. Sections
    have a title and 0 or more paragraphs or other section elements.
    
-    Text can be __bold__, *italicized*, ~~strikethrough~~, or
+    Text can be **bold**, __italicized__, ~~strikethrough~~, or
    ''monospaced''.
    
    You can link to Unison terms, types, and external URLs:
@ -20,7 +20,7 @@ basicFormatting = {{
    This is useful for creating documents programmatically
    or just including other documents.

-    *Next up:* {lists}
+    __Next up:__ {lists}
 }}

 lists = {{
@ -168,7 +168,7 @@ This is an aside. {{ docAside {{ Some extra detail that doesn't belong in main t
  docBlockquote {{
    "And what is the use of a book," thought Alice, "without pictures or conversation?"

-    *Lewis Carroll, Alice's Adventures in Wonderland* }} 
+    _Lewis Carroll, Alice's Adventures in Wonderland_ }} 
 }}

 {{ docTooltip {{Hover over me}} {{Extra detail}} }} 
--- a/unison-src/transcripts-using-base/doc.output.md
+++ b/unison-src/transcripts-using-base/doc.output.md
@ -113,8 +113,8 @@ and the rendered output using `display`:
      Sections have a title and 0 or more paragraphs or other
      section elements.
      
-      Text can be __bold__, *italicized*, ~~strikethrough~~, or
-      ''monospaced''.
+      Text can be **bold**, __italicized__, ~~strikethrough~~,
+      or ''monospaced''.
      
      You can link to Unison terms, types, and external URLs:
      
@ -129,7 +129,7 @@ and the rendered output using `display`:
      useful for creating documents programmatically or just
      including other documents.
      
-      *Next up:* {lists}
+      __Next up:__ {lists}
    }}

 .> display basicFormatting
@ -469,7 +469,7 @@ and the rendered output using `display`:
      "And what is the use of a book," thought Alice, "without
      pictures or conversation?"
      
-      *Lewis Carroll, Alice's Adventures in Wonderland*
+      __Lewis Carroll, Alice's Adventures in Wonderland__
      }} }}
    
    {{ docTooltip {{ Hover over me }} {{ Extra detail }} }}