Remove support for examples from judoc (#2747)

The judoc examples feature is currently unused. This feature was added
in #1442

Keeping support for this feature adds a cost to HTML generation. We are
removing this to improve the performance of `juvix html`.

To just render the HTML documentation we only require the scoper result
from the pipeline. To support the examples we need the type checking
result. The cost is significant in larger projects as the pipeline is
run for each import.

Part of #2744

app/Commands/Html.hs

@@ -10,7 +10,7 @@ import Juvix.Compiler.Backend.Html.Translation.FromTyped.Source
 import Juvix.Compiler.Concrete.Pretty qualified as Concrete
 import Juvix.Compiler.Concrete.Translation.FromParsed.Analysis.Scoping qualified as Scoper
 import Juvix.Compiler.Internal.Translation
-import Juvix.Compiler.Internal.Translation.FromInternal.Analysis.TypeChecking.Data.Context (resultInternal, resultNormalized)
+import Juvix.Compiler.Internal.Translation.FromInternal.Analysis.TypeChecking.Data.Context (resultInternal)
 import Juvix.Extra.Process
 import System.Process qualified as Process
 
@@ -45,7 +45,6 @@ resultToJudocCtx :: InternalTypedResult -> Html.JudocCtx
 resultToJudocCtx res =
   Html.JudocCtx
     { _judocCtxComments = Scoper.getScoperResultComments sres,
-      _judocCtxNormalizedTable = res ^. resultNormalized,
       _judocCtxTopModules = [sres ^. Scoper.resultModule]
     }
   where

src/Juvix/Compiler/Backend/Html/Translation/FromTyped.hs

@@ -15,11 +15,8 @@ import Juvix.Compiler.Backend.Html.Translation.FromTyped.Source hiding (go)
 import Juvix.Compiler.Concrete.Data.ScopedName qualified as S
 import Juvix.Compiler.Concrete.Language
 import Juvix.Compiler.Concrete.Print
-import Juvix.Compiler.Internal.Translation.FromInternal.Analysis.TypeChecking qualified as InternalTyped
-import Juvix.Compiler.Internal.Translation.FromInternal.Analysis.TypeChecking.Data.Context
 import Juvix.Compiler.Pipeline.EntryPoint
 import Juvix.Extra.Assets
-import Juvix.Extra.Strings qualified as Str
 import Juvix.Prelude
 import Juvix.Prelude.Pretty
 import Text.Blaze.Html.Renderer.Utf8 qualified as Html
@@ -28,8 +25,7 @@ import Text.Blaze.Html5.Attributes qualified as Attr
 
 data JudocCtx = JudocCtx
   { _judocCtxComments :: Comments,
-    _judocCtxTopModules :: [Module 'Scoped 'ModuleTop],
-    _judocCtxNormalizedTable :: InternalTyped.NormalizedTable
+    _judocCtxTopModules :: [Module 'Scoped 'ModuleTop]
   }
 
 data JudocArgs = JudocArgs
@@ -56,16 +52,14 @@ instance Semigroup JudocCtx where
   ctx1 <> ctx2 =
     JudocCtx
       { _judocCtxComments = ctx1 ^. judocCtxComments <> ctx2 ^. judocCtxComments,
-        _judocCtxTopModules = ctx1 ^. judocCtxTopModules <> ctx2 ^. judocCtxTopModules,
-        _judocCtxNormalizedTable = ctx1 ^. judocCtxNormalizedTable <> ctx2 ^. judocCtxNormalizedTable
+        _judocCtxTopModules = ctx1 ^. judocCtxTopModules <> ctx2 ^. judocCtxTopModules
       }
 
 instance Monoid JudocCtx where
   mempty =
     JudocCtx
       { _judocCtxComments = mempty,
-        _judocCtxTopModules = mempty,
-        _judocCtxNormalizedTable = mempty
+        _judocCtxTopModules = mempty
       }
 
 data Tree k a = Tree
@@ -180,17 +174,14 @@ writeHtml f h = liftIO $ do
 
 genJudocHtml :: (Members '[EmbedIO] r) => EntryPoint -> JudocArgs -> Sem r ()
 genJudocHtml entry JudocArgs {..} =
-  runReader htmlOpts . runReader normTable . runReader entry $ do
+  runReader htmlOpts . runReader entry $ do
     liftIO (writeAssets _judocArgsOutputDir)
     mapM_ (goTopModule cs) allModules
     createIndexFile (map topModulePath (toList allModules))
   where
     cs :: Comments
     cs = _judocArgsCtx ^. judocCtxComments
 
-    normTable :: InternalTyped.NormalizedTable
-    normTable = _judocArgsCtx ^. judocCtxNormalizedTable
-
     mainMod :: Module 'Scoped 'ModuleTop
     mainMod = _judocArgsMainModule
 
@@ -285,7 +276,7 @@ template rightMenu' content' = do
 -- | This function compiles a module into Html documentation.
 goTopModule ::
   forall r.
-  (Members '[Reader HtmlOptions, EmbedIO, Reader EntryPoint, Reader NormalizedTable] r) =>
+  (Members '[Reader HtmlOptions, EmbedIO, Reader EntryPoint] r) =>
   Comments ->
   Module 'Scoped 'ModuleTop ->
   Sem r ()
@@ -314,7 +305,7 @@ goTopModule cs m = do
             _genModuleHtmlArgsModule = m
           }
 
-    docHtml :: forall s. (Members '[Reader HtmlOptions, Reader EntryPoint, Reader NormalizedTable] s) => Sem s Html
+    docHtml :: forall s. (Members '[Reader HtmlOptions, Reader EntryPoint] s) => Sem s Html
     docHtml = do
       content' <- content
       rightMenu' <- rightMenu
@@ -396,10 +387,10 @@ goTopModule cs m = do
               )
               <> sigs'
 
-goJudocMay :: (Members '[Reader HtmlOptions, Reader NormalizedTable] r) => Maybe (Judoc 'Scoped) -> Sem r Html
+goJudocMay :: (Members '[Reader HtmlOptions] r) => Maybe (Judoc 'Scoped) -> Sem r Html
 goJudocMay = maybe (return mempty) goJudoc
 
-goJudoc :: forall r. (Members '[Reader HtmlOptions, Reader NormalizedTable] r) => Judoc 'Scoped -> Sem r Html
+goJudoc :: forall r. (Members '[Reader HtmlOptions] r) => Judoc 'Scoped -> Sem r Html
 goJudoc (Judoc bs) = mconcatMapM goGroup bs
   where
     goGroup :: JudocGroup 'Scoped -> Sem r Html
@@ -413,30 +404,16 @@ goJudoc (Judoc bs) = mconcatMapM goGroup bs
     goBlock :: JudocBlock 'Scoped -> Sem r Html
     goBlock = \case
       JudocLines ls -> Html.p . concatWith (\l r -> l <> " " <> r) <$> mapM goLine (toList ls)
-      JudocExample e -> goExample e
 
     goLine :: JudocLine 'Scoped -> Sem r Html
     goLine (JudocLine _ atoms) = mconcatMapM goAtom (fmap (^. withLocParam) atoms)
 
-    goExample :: Example 'Scoped -> Sem r Html
-    goExample ex = do
-      e' <- ppCodeHtml defaultOptions (ex ^. exampleExpression)
-      norm' <- asks @NormalizedTable (^?! at (ex ^. exampleId) . _Just) >>= ppCodeHtmlInternal
-      return
-        $ Html.pre
-          ! Attr.class_ "screen"
-        $ (Html.code ! Attr.class_ "prompt" $ Str.judocExample)
-          <> " "
-          <> e'
-          <> "\n"
-          <> norm'
-
     goAtom :: JudocAtom 'Scoped -> Sem r Html
     goAtom = \case
       JudocExpression e -> ppCodeHtml defaultOptions e
       JudocText txt -> return (toHtml txt)
 
-goStatement :: forall r. (Members '[Reader HtmlOptions, Reader NormalizedTable] r) => Statement 'Scoped -> Sem r Html
+goStatement :: forall r. (Members '[Reader HtmlOptions] r) => Statement 'Scoped -> Sem r Html
 goStatement = \case
   StatementAxiom t -> goAxiom t
   StatementInductive t -> goInductive t
@@ -454,7 +431,7 @@ goStatement = \case
       SyntaxOperator {} -> mempty
       SyntaxIterator {} -> mempty
 
-goFixity :: forall r. (Members '[Reader HtmlOptions, Reader NormalizedTable] r) => FixitySyntaxDef 'Scoped -> Sem r Html
+goFixity :: forall r. (Members '[Reader HtmlOptions] r) => FixitySyntaxDef 'Scoped -> Sem r Html
 goFixity def = do
   sig' <- ppHelper (ppFixityDefHeaderNew def)
   header' <- defHeader (def ^. fixitySymbol) sig' (def ^. fixityDoc)
@@ -501,13 +478,13 @@ goFixity def = do
             arit
               <> assoc
 
-goAlias :: forall r. (Members '[Reader HtmlOptions, Reader NormalizedTable] r) => AliasDef 'Scoped -> Sem r Html
+goAlias :: forall r. (Members '[Reader HtmlOptions] r) => AliasDef 'Scoped -> Sem r Html
 goAlias def = do
   sig' <- ppCodeHtml defaultOptions def
   defHeader (def ^. aliasDefName) sig' Nothing
 
 -- | local modules generated by inductive types should not show up.
-goLocalModule :: forall r. (Members '[Reader HtmlOptions, Reader NormalizedTable] r) => Module 'Scoped 'ModuleLocal -> Sem r Html
+goLocalModule :: forall r. (Members '[Reader HtmlOptions] r) => Module 'Scoped 'ModuleLocal -> Sem r Html
 goLocalModule def = fmap (fromMaybe mempty) . runFail $ do
   failWhen (def ^. moduleInductive)
   sig' <- ppHelper (ppModuleHeader def)
@@ -529,23 +506,23 @@ goOpen op
   | Public <- op ^. openModuleParams . openPublic = noDefHeader <$> ppCodeHtml defaultOptions op
   | otherwise = mempty
 
-goAxiom :: forall r. (Members '[Reader HtmlOptions, Reader NormalizedTable] r) => AxiomDef 'Scoped -> Sem r Html
+goAxiom :: forall r. (Members '[Reader HtmlOptions] r) => AxiomDef 'Scoped -> Sem r Html
 goAxiom axiom = do
   header' <- axiomHeader
   defHeader (axiom ^. axiomName) header' (axiom ^. axiomDoc)
   where
     axiomHeader :: Sem r Html
     axiomHeader = ppCodeHtml defaultOptions (set axiomDoc Nothing axiom)
 
-goFunctionDef :: forall r. (Members '[Reader HtmlOptions, Reader NormalizedTable] r) => FunctionDef 'Scoped -> Sem r Html
+goFunctionDef :: forall r. (Members '[Reader HtmlOptions] r) => FunctionDef 'Scoped -> Sem r Html
 goFunctionDef def = do
   sig' <- funSig
   defHeader (def ^. signName) sig' (def ^. signDoc)
   where
     funSig :: Sem r Html
     funSig = ppHelper (ppFunctionSignature def)
 
-goInductive :: forall r. (Members '[Reader HtmlOptions, Reader NormalizedTable] r) => InductiveDef 'Scoped -> Sem r Html
+goInductive :: forall r. (Members '[Reader HtmlOptions] r) => InductiveDef 'Scoped -> Sem r Html
 goInductive def = do
   sig' <- inductiveHeader
   header' <- defHeader (def ^. inductiveName) sig' (def ^. inductiveDoc)
@@ -558,7 +535,7 @@ goInductive def = do
 ppHelper :: (Members '[Reader HtmlOptions] r) => Sem '[ExactPrint, Reader Options] () -> Sem r Html
 ppHelper = docToHtml . run . runReader defaultOptions . execExactPrint Nothing
 
-goConstructors :: forall r. (Members '[Reader HtmlOptions, Reader NormalizedTable] r) => NonEmpty (ConstructorDef 'Scoped) -> Sem r Html
+goConstructors :: forall r. (Members '[Reader HtmlOptions] r) => NonEmpty (ConstructorDef 'Scoped) -> Sem r Html
 goConstructors cc = do
   tbl' <- table . tbody <$> mconcatMapM goConstructor cc
   return
@@ -592,7 +569,7 @@ noDefHeader = p ! Attr.class_ "src"
 
 defHeader ::
   forall r x.
-  (Members '[Reader HtmlOptions, Reader NormalizedTable] r) =>
+  (Members '[Reader HtmlOptions] r) =>
   S.Name' x ->
   Html ->
   Maybe (Judoc 'Scoped) ->

src/Juvix/Compiler/Concrete/Data/Highlight/PrettyJudoc.hs

@@ -66,7 +66,6 @@ ppJudoc (Judoc bs) = do
     ppBlock :: JudocBlock 'Scoped -> Sem r (Doc CodeAnn)
     ppBlock = \case
       JudocLines ls -> hsep <$> mapM ppLine (toList ls)
-      JudocExample {} -> return mempty
 
     ppLine :: JudocLine 'Scoped -> Sem r (Doc CodeAnn)
     ppLine (JudocLine _ as) = mconcatMapM (ppAtom . (^. withLocParam)) (toList as)

src/Juvix/Compiler/Concrete/Language.hs

@@ -2031,7 +2031,6 @@ deriving stock instance Ord (JudocGroup 'Scoped)
 
 data JudocBlock (s :: Stage)
   = JudocLines (NonEmpty (JudocLine s))
-  | JudocExample (Example s)
   deriving stock (Generic)
 
 instance Serialize (JudocBlock 'Scoped)
@@ -2500,7 +2499,6 @@ instance HasLoc (JudocGroup s) where
 instance HasLoc (JudocBlock s) where
   getLoc = \case
     JudocLines ls -> getLocSpan ls
-    JudocExample e -> getLoc e
 
 instance HasLoc PatternScopedIden where
   getLoc = \case
@@ -2817,22 +2815,6 @@ instance HasAtomicity PatternArg where
     | isJust (p ^. patternArgName) = Atom
     | otherwise = atomicity (p ^. patternArgPattern)
 
-judocExamples :: Judoc s -> [Example s]
-judocExamples (Judoc bs) = concatMap goGroup bs
-  where
-    goGroup :: JudocGroup s -> [Example s]
-    goGroup = \case
-      JudocGroupBlock p -> goParagraph p
-      JudocGroupLines l -> concatMap goBlock l
-
-    goParagraph :: JudocBlockParagraph s -> [Example s]
-    goParagraph l = concatMap goBlock (l ^. judocBlockParagraphBlocks)
-
-    goBlock :: JudocBlock s -> [Example s]
-    goBlock = \case
-      JudocExample e -> [e]
-      _ -> mempty
-
 instance HasNameKind ScopedIden where
   getNameKind = getNameKind . (^. scopedIdenFinal)
 

src/Juvix/Compiler/Concrete/Print/Base.hs

@@ -807,13 +807,6 @@ ppJudocStart = do
       | inBlock -> return Nothing
       | otherwise -> ppCode Kw.delimJudocStart $> Just ()
 
-instance (SingI s) => PrettyPrint (Example s) where
-  ppCode e =
-    ppJudocStart
-      <??+> ppCode Kw.delimJudocExample
-      <+> ppExpressionType (e ^. exampleExpression)
-        <> semicolon
-
 instance (PrettyPrint a) => PrettyPrint (WithLoc a) where
   ppCode a = morphemeM (getLoc a) (ppCode (a ^. withLocParam))
 
@@ -872,7 +865,6 @@ instance (SingI s) => PrettyPrint (JudocGroup s) where
 instance (SingI s) => PrettyPrint (JudocBlock s) where
   ppCode = \case
     JudocLines l -> vsep (ppCode <$> l)
-    JudocExample e -> ppCode e
 
 instance (SingI s) => PrettyPrint (AxiomDef s) where
   ppCode :: forall r. (Members '[ExactPrint, Reader Options] r) => AxiomDef s -> Sem r ()

src/Juvix/Compiler/Concrete/Translation/FromParsed/Analysis/Scoping.hs

@@ -2457,7 +2457,6 @@ checkJudocBlock ::
   Sem r (JudocBlock 'Scoped)
 checkJudocBlock = \case
   JudocLines l -> JudocLines <$> mapM checkJudocLine l
-  JudocExample e -> JudocExample <$> traverseOf exampleExpression checkParseExpressionAtoms e
 
 checkJudocBlockParagraph ::
   (Members '[HighlightBuilder, Reader ScopeParameters, Error ScoperError, State Scope, State ScoperState, InfoTableBuilder, Reader InfoTable, NameIdGen, Reader EntryPoint] r) =>

src/Juvix/Compiler/Concrete/Translation/FromSource.hs

@@ -569,9 +569,7 @@ stashJudoc = do
 
     judocBlock :: Bool -> ParsecS r (JudocBlock 'Parsed)
     judocBlock inBlock = do
-      p <-
-        judocExample inBlock
-          <|> judocParagraphLines inBlock
+      p <- judocParagraphLines inBlock
       void (many (judocEmptyLine inBlock))
       return p
 
@@ -587,25 +585,14 @@ stashJudoc = do
     judocParagraphLines :: Bool -> ParsecS r (JudocBlock 'Parsed)
     judocParagraphLines inBlock = JudocLines <$> some1 (paragraphLine inBlock)
 
-    judocExample :: Bool -> ParsecS r (JudocBlock 'Parsed)
-    judocExample inBlock = do
-      if
-          | inBlock -> judocExampleStart
-          | otherwise -> P.try (judocStart >> judocExampleStart)
-      _exampleId <- P.lift freshNameId
-      (_exampleExpression, _exampleLoc) <- interval parseExpressionAtoms
-      semicolon
-      space
-      return (JudocExample Example {..})
-
     paragraphLine :: Bool -> ParsecS r (JudocLine 'Parsed)
     paragraphLine inBlock = do
       kwstart <-
         if
             | inBlock -> return Nothing
             | otherwise -> P.try $ do
                 s <- judocStart
-                P.notFollowedBy (P.choice [judocExampleStart, void P.newline])
+                P.notFollowedBy (P.choice [void P.newline])
                 return (Just s)
       l <- JudocLine kwstart . trimEnds <$> some1 (withLoc (judocAtom inBlock))
       if

src/Juvix/Compiler/Concrete/Translation/FromSource/Lexer.hs

@@ -13,7 +13,6 @@ import Juvix.Compiler.Concrete.Extra qualified as P
 import Juvix.Compiler.Concrete.Keywords
 import Juvix.Compiler.Concrete.Translation.FromSource.ParserResultBuilder
 import Juvix.Data.Keyword
-import Juvix.Extra.Strings qualified as Str
 import Juvix.Parser.Lexer
 import Juvix.Prelude
 import Text.Megaparsec.Char.Lexer qualified as L
@@ -73,9 +72,6 @@ bracedString =
 string :: (Members '[ParserResultBuilder] r) => ParsecS r (Text, Interval)
 string = lexemeInterval string'
 
-judocExampleStart :: ParsecS r ()
-judocExampleStart = P.chunk Str.judocExample >> hspace_
-
 judocBlockEnd :: (Members '[ParserResultBuilder] r) => ParsecS r KeywordRef
 judocBlockEnd = kw delimJudocBlockEnd
 

src/Juvix/Compiler/Internal/Extra.hs

@@ -111,8 +111,7 @@ genFieldProjection _funDefName _funDefBuiltin info fieldIx = do
       retTy = constrArgs !! fieldIx
   cloneFunctionDefSameName
     FunctionDef
-      { _funDefExamples = [],
-        _funDefTerminating = False,
+      { _funDefTerminating = False,
         _funDefInstance = False,
         _funDefCoercion = False,
         _funDefArgsInfo = mempty,