From 22742b7a5fe5cd260524645e8318b42146771573 Mon Sep 17 00:00:00 2001
From: janmasrovira <janmasrovira@gmail.com>
Date: Mon, 24 Apr 2023 11:19:08 +0200
Subject: [PATCH] Add judoc code annotation and face (#2025)

---
 .../Compiler/Backend/Html/Translation/FromTyped/Source.hs    | 1 +
 src/Juvix/Compiler/Concrete/Data/Highlight.hs                | 1 +
 src/Juvix/Compiler/Concrete/Data/Highlight/Properties.hs     | 2 ++
 src/Juvix/Compiler/Concrete/Data/Highlight/RenderEmacs.hs    | 1 +
 src/Juvix/Compiler/Concrete/Data/ParsedInfoTableBuilder.hs   | 2 +-
 src/Juvix/Compiler/Concrete/Data/ParsedItem.hs               | 1 +
 src/Juvix/Compiler/Concrete/Translation/FromSource.hs        | 5 +++--
 src/Juvix/Compiler/Concrete/Translation/FromSource/Lexer.hs  | 2 +-
 src/Juvix/Data/CodeAnn.hs                                    | 2 ++
 src/Juvix/Extra/Strings.hs                                   | 3 +++
 10 files changed, 16 insertions(+), 4 deletions(-)

diff --git a/src/Juvix/Compiler/Backend/Html/Translation/FromTyped/Source.hs b/src/Juvix/Compiler/Backend/Html/Translation/FromTyped/Source.hs
index 16f9e3ad8..72cd20e57 100644
--- a/src/Juvix/Compiler/Backend/Html/Translation/FromTyped/Source.hs
+++ b/src/Juvix/Compiler/Backend/Html/Translation/FromTyped/Source.hs
@@ -256,6 +256,7 @@ putTag ann x = case ann of
   AnnKeyword -> return (Html.span ! Attr.class_ "ju-keyword" $ x)
   AnnUnkindedSym -> return (Html.span ! Attr.class_ "ju-var" $ x)
   AnnComment -> return (Html.span ! Attr.class_ "ju-var" $ x) -- TODO add comment class
+  AnnJudoc -> return (Html.span ! Attr.class_ "ju-var" $ x) -- TODO add judoc class
   AnnDelimiter -> return (Html.span ! Attr.class_ "ju-delimiter" $ x)
   AnnDef tmp ni -> boldDefine <*> tagDef tmp ni
   AnnRef tmp ni -> tagRef tmp ni
diff --git a/src/Juvix/Compiler/Concrete/Data/Highlight.hs b/src/Juvix/Compiler/Concrete/Data/Highlight.hs
index 1248eb0b7..9dff267d9 100644
--- a/src/Juvix/Compiler/Concrete/Data/Highlight.hs
+++ b/src/Juvix/Compiler/Concrete/Data/Highlight.hs
@@ -70,6 +70,7 @@ goFaceParsedItem i = WithLoc (i ^. parsedLoc) (PropertyFace f)
       ParsedTagLiteralString -> FaceString
       ParsedTagComment -> FaceComment
       ParsedTagDelimiter -> FaceDelimiter
+      ParsedTagJudoc -> FaceJudoc
 
 goFaceName :: AName -> Maybe (WithLoc PropertyFace)
 goFaceName n = do
diff --git a/src/Juvix/Compiler/Concrete/Data/Highlight/Properties.hs b/src/Juvix/Compiler/Concrete/Data/Highlight/Properties.hs
index a85a3e0c1..b2fc45972 100644
--- a/src/Juvix/Compiler/Concrete/Data/Highlight/Properties.hs
+++ b/src/Juvix/Compiler/Concrete/Data/Highlight/Properties.hs
@@ -32,6 +32,7 @@ data Face
   | FaceString
   | FaceNumber
   | FaceComment
+  | FaceJudoc
   | FaceError
 
 faceSymbolStr :: Face -> Text
@@ -45,6 +46,7 @@ faceSymbolStr = \case
   FaceFunction -> Str.function
   FaceNumber -> Str.number
   FaceComment -> Str.comment
+  FaceJudoc -> Str.judoc
   FaceString -> Str.string
   FaceError -> Str.error
 
diff --git a/src/Juvix/Compiler/Concrete/Data/Highlight/RenderEmacs.hs b/src/Juvix/Compiler/Concrete/Data/Highlight/RenderEmacs.hs
index 4b9582569..49c82a3a4 100644
--- a/src/Juvix/Compiler/Concrete/Data/Highlight/RenderEmacs.hs
+++ b/src/Juvix/Compiler/Concrete/Data/Highlight/RenderEmacs.hs
@@ -25,6 +25,7 @@ fromCodeAnn = \case
   AnnKeyword -> Just (EPropertyFace (PropertyFace FaceKeyword))
   AnnDelimiter -> Just (EPropertyFace (PropertyFace FaceDelimiter))
   AnnComment -> Just (EPropertyFace (PropertyFace FaceComment))
+  AnnJudoc -> Just (EPropertyFace (PropertyFace FaceJudoc))
   AnnLiteralString -> Just (EPropertyFace (PropertyFace FaceString))
   AnnLiteralInteger -> Just (EPropertyFace (PropertyFace FaceNumber))
   AnnCode -> Nothing
diff --git a/src/Juvix/Compiler/Concrete/Data/ParsedInfoTableBuilder.hs b/src/Juvix/Compiler/Concrete/Data/ParsedInfoTableBuilder.hs
index 39deca89a..91340b2fb 100644
--- a/src/Juvix/Compiler/Concrete/Data/ParsedInfoTableBuilder.hs
+++ b/src/Juvix/Compiler/Concrete/Data/ParsedInfoTableBuilder.hs
@@ -52,7 +52,7 @@ registerJudocText i =
   registerItem
     ParsedItem
       { _parsedLoc = i,
-        _parsedTag = ParsedTagComment
+        _parsedTag = ParsedTagJudoc
       }
 
 registerLiteral :: Member InfoTableBuilder r => LiteralLoc -> Sem r LiteralLoc
diff --git a/src/Juvix/Compiler/Concrete/Data/ParsedItem.hs b/src/Juvix/Compiler/Concrete/Data/ParsedItem.hs
index 140e3e99f..e203c9618 100644
--- a/src/Juvix/Compiler/Concrete/Data/ParsedItem.hs
+++ b/src/Juvix/Compiler/Concrete/Data/ParsedItem.hs
@@ -14,6 +14,7 @@ data ParsedItemTag
   | ParsedTagLiteralString
   | ParsedTagComment
   | ParsedTagDelimiter
+  | ParsedTagJudoc
   deriving stock (Eq, Show, Generic)
 
 makeLenses ''ParsedItem
diff --git a/src/Juvix/Compiler/Concrete/Translation/FromSource.hs b/src/Juvix/Compiler/Concrete/Translation/FromSource.hs
index 4cb01beb7..8f8588b08 100644
--- a/src/Juvix/Compiler/Concrete/Translation/FromSource.hs
+++ b/src/Juvix/Compiler/Concrete/Translation/FromSource.hs
@@ -174,6 +174,7 @@ stashJudoc = do
   where
     judocBlocks :: ParsecS r (Judoc 'Parsed)
     judocBlocks = Judoc <$> some judocBlock
+
     judocBlock :: ParsecS r (JudocBlock 'Parsed)
     judocBlock = do
       p <-
@@ -188,13 +189,12 @@ stashJudoc = do
 
     judocExample :: ParsecS r (JudocBlock 'Parsed)
     judocExample = do
-      -- TODO judocText?
       P.try (judocStart >> judocExampleStart)
       _exampleId <- P.lift freshNameId
       (_exampleExpression, _exampleLoc) <- interval parseExpressionAtoms
       semicolon
       space
-      return (JudocExample (Example {..}))
+      return (JudocExample Example {..})
 
     judocLine :: ParsecS r (JudocParagraphLine 'Parsed)
     judocLine = lexeme $ do
@@ -213,6 +213,7 @@ judocAtom =
       where
         isValidText :: Char -> Bool
         isValidText = (`notElem` ['\n', ';'])
+
     judocExpression :: ParsecS r (ExpressionAtoms 'Parsed)
     judocExpression = do
       judocText_ (P.char ';')
diff --git a/src/Juvix/Compiler/Concrete/Translation/FromSource/Lexer.hs b/src/Juvix/Compiler/Concrete/Translation/FromSource/Lexer.hs
index 20638da56..70225584c 100644
--- a/src/Juvix/Compiler/Concrete/Translation/FromSource/Lexer.hs
+++ b/src/Juvix/Compiler/Concrete/Translation/FromSource/Lexer.hs
@@ -68,7 +68,7 @@ bracedString =
       void (char '\\')
       char '}'
 
-string :: (Members '[InfoTableBuilder] r) => ParsecS r (Text, Interval)
+string :: Members '[InfoTableBuilder] r => ParsecS r (Text, Interval)
 string = lexemeInterval string'
 
 judocExampleStart :: ParsecS r ()
diff --git a/src/Juvix/Data/CodeAnn.hs b/src/Juvix/Data/CodeAnn.hs
index 119beca95..5e892f6da 100644
--- a/src/Juvix/Data/CodeAnn.hs
+++ b/src/Juvix/Data/CodeAnn.hs
@@ -18,6 +18,7 @@ data CodeAnn
   | AnnKeyword
   | AnnCode
   | AnnComment
+  | AnnJudoc
   | AnnImportant
   | AnnDelimiter
   | AnnLiteralString
@@ -37,6 +38,7 @@ stylize a = case a of
   AnnCode -> bold
   AnnImportant -> bold
   AnnComment -> colorDull Cyan
+  AnnJudoc -> colorDull Cyan
   AnnDelimiter -> colorDull White
   AnnLiteralString -> colorDull Red
   AnnLiteralInteger -> colorDull Cyan
diff --git a/src/Juvix/Extra/Strings.hs b/src/Juvix/Extra/Strings.hs
index 1a1590bb0..37a6f162e 100644
--- a/src/Juvix/Extra/Strings.hs
+++ b/src/Juvix/Extra/Strings.hs
@@ -77,6 +77,9 @@ public = "public"
 comment :: (IsString s) => s
 comment = "comment"
 
+judoc :: (IsString s) => s
+judoc = "judoc"
+
 number :: (IsString s) => s
 number = "number"