Add judoc code annotation and face (#2025)

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

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

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
 

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

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

src/Juvix/Compiler/Concrete/Data/ParsedItem.hs

@@ -14,6 +14,7 @@ data ParsedItemTag
   | ParsedTagLiteralString
   | ParsedTagComment
   | ParsedTagDelimiter
+  | ParsedTagJudoc
   deriving stock (Eq, Show, Generic)
 
 makeLenses ''ParsedItem

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 ';')

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 ()

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

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"