Fix disappearing judoc in syntax declarations (#3205)

* Closes #3063

src/Juvix/Compiler/Concrete/Data/Scope/Base.hs

@@ -70,7 +70,7 @@ data ScoperState = ScoperState
 data SymbolOperator = SymbolOperator
   { _symbolOperatorUsed :: Bool,
     _symbolOperatorFixity :: Fixity,
-    _symbolOperatorDef :: OperatorSyntaxDef
+    _symbolOperatorDef :: OperatorSyntaxDef 'Parsed
   }
   deriving stock (Show)
 
@@ -81,7 +81,7 @@ newtype ScoperOperators = ScoperOperators
 
 data SymbolIterator = SymbolIterator
   { _symbolIteratorUsed :: Bool,
-    _symbolIteratorDef :: IteratorSyntaxDef
+    _symbolIteratorDef :: IteratorSyntaxDef 'Parsed
   }
 
 newtype ScoperIterators = ScoperIterators

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

@@ -360,6 +360,7 @@ deriving stock instance Ord (Import 'Scoped)
 data AliasDef (s :: Stage) = AliasDef
   { _aliasDefSyntaxKw :: Irrelevant KeywordRef,
     _aliasDefAliasKw :: Irrelevant KeywordRef,
+    _aliasDefDoc :: Maybe (Judoc s),
     _aliasDefName :: SymbolType s,
     _aliasDefAsName :: IdentifierType s
   }
@@ -398,8 +399,8 @@ instance NFData ParsedIteratorInfo
 
 data SyntaxDef (s :: Stage)
   = SyntaxFixity (FixitySyntaxDef s)
-  | SyntaxOperator OperatorSyntaxDef
-  | SyntaxIterator IteratorSyntaxDef
+  | SyntaxOperator (OperatorSyntaxDef s)
+  | SyntaxIterator (IteratorSyntaxDef s)
   | SyntaxAlias (AliasDef s)
 
 deriving stock instance (Show (SyntaxDef 'Parsed))
@@ -484,34 +485,68 @@ instance Serialize FixityDef
 
 instance NFData FixityDef
 
-data OperatorSyntaxDef = OperatorSyntaxDef
+data OperatorSyntaxDef (s :: Stage) = OperatorSyntaxDef
   { _opSymbol :: Symbol,
     _opFixity :: Symbol,
+    _opDoc :: Maybe (Judoc s),
     _opKw :: KeywordRef,
     _opSyntaxKw :: KeywordRef
   }
-  deriving stock (Show, Eq, Ord, Generic)
+  deriving stock (Generic)
+
+deriving stock instance Show (OperatorSyntaxDef 'Parsed)
+
+deriving stock instance Show (OperatorSyntaxDef 'Scoped)
+
+deriving stock instance Eq (OperatorSyntaxDef 'Parsed)
+
+deriving stock instance Eq (OperatorSyntaxDef 'Scoped)
+
+deriving stock instance Ord (OperatorSyntaxDef 'Parsed)
+
+deriving stock instance Ord (OperatorSyntaxDef 'Scoped)
+
+instance Serialize (OperatorSyntaxDef 'Parsed)
+
+instance NFData (OperatorSyntaxDef 'Parsed)
 
-instance Serialize OperatorSyntaxDef
+instance Serialize (OperatorSyntaxDef 'Scoped)
 
-instance NFData OperatorSyntaxDef
+instance NFData (OperatorSyntaxDef 'Scoped)
 
-instance HasLoc OperatorSyntaxDef where
+instance HasLoc (OperatorSyntaxDef s) where
   getLoc OperatorSyntaxDef {..} = getLoc _opSyntaxKw <> getLoc _opSymbol
 
-data IteratorSyntaxDef = IteratorSyntaxDef
+data IteratorSyntaxDef (s :: Stage) = IteratorSyntaxDef
   { _iterSymbol :: Symbol,
     _iterInfo :: Maybe ParsedIteratorInfo,
+    _iterDoc :: Maybe (Judoc s),
     _iterSyntaxKw :: KeywordRef,
     _iterIteratorKw :: KeywordRef
   }
-  deriving stock (Show, Eq, Ord, Generic)
+  deriving stock (Generic)
+
+deriving stock instance Show (IteratorSyntaxDef 'Parsed)
+
+deriving stock instance Show (IteratorSyntaxDef 'Scoped)
+
+deriving stock instance Eq (IteratorSyntaxDef 'Parsed)
+
+deriving stock instance Eq (IteratorSyntaxDef 'Scoped)
+
+deriving stock instance Ord (IteratorSyntaxDef 'Parsed)
+
+deriving stock instance Ord (IteratorSyntaxDef 'Scoped)
+
+instance Serialize (IteratorSyntaxDef 'Parsed)
+
+instance NFData (IteratorSyntaxDef 'Parsed)
 
-instance Serialize IteratorSyntaxDef
+instance Serialize (IteratorSyntaxDef 'Scoped)
 
-instance NFData IteratorSyntaxDef
+instance NFData (IteratorSyntaxDef 'Scoped)
 
-instance HasLoc IteratorSyntaxDef where
+instance HasLoc (IteratorSyntaxDef s) where
   getLoc IteratorSyntaxDef {..} = getLoc _iterSyntaxKw <> getLoc _iterSymbol
 
 data ArgDefault (s :: Stage) = ArgDefault
@@ -2565,8 +2600,8 @@ deriving stock instance Ord (NamedApplicationNew 'Parsed)
 deriving stock instance Ord (NamedApplicationNew 'Scoped)
 
 data RecordSyntaxDef (s :: Stage)
-  = RecordSyntaxOperator OperatorSyntaxDef
-  | RecordSyntaxIterator IteratorSyntaxDef
+  = RecordSyntaxOperator (OperatorSyntaxDef s)
+  | RecordSyntaxIterator (IteratorSyntaxDef s)
   deriving stock (Generic)
 
 instance Serialize (RecordSyntaxDef 'Scoped)

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

@@ -377,7 +377,7 @@ instance (SingI s) => PrettyPrint (NamedArgumentNew s) where
     NamedArgumentNewFunction f -> ppCode f
     NamedArgumentItemPun f -> ppCode f
 
-instance PrettyPrint (RecordSyntaxDef s) where
+instance (SingI s) => PrettyPrint (RecordSyntaxDef s) where
   ppCode = \case
     RecordSyntaxOperator d -> ppCode d
     RecordSyntaxIterator d -> ppCode d
@@ -594,8 +594,10 @@ instance PrettyPrint ScopedIden where
   ppCode = ppCode . (^. scopedIdenSrcName)
 
 instance (SingI s) => PrettyPrint (AliasDef s) where
-  ppCode AliasDef {..} =
-    ppCode _aliasDefSyntaxKw
+  ppCode AliasDef {..} = do
+    let doc' = ppCode <$> _aliasDefDoc
+    doc'
+      ?<> ppCode _aliasDefSyntaxKw
       <+> ppCode _aliasDefAliasKw
       <+> ppSymbolType _aliasDefName
       <+> ppCode Kw.kwAssign
@@ -928,15 +930,17 @@ instance (SingI s) => PrettyPrint (ParsedFixityInfo s) where
 
 instance (SingI s) => PrettyPrint (FixitySyntaxDef s) where
   ppCode f@FixitySyntaxDef {..} = do
-    let header' = ppFixityDefHeader f
+    let doc' = ppCode <$> _fixityDoc
+        header' = ppFixityDefHeader f
         body' = ppCode _fixityInfo
-    header' <+> ppCode _fixityAssignKw <+> body'
+    doc' ?<> header' <+> ppCode _fixityAssignKw <+> body'
 
-instance PrettyPrint OperatorSyntaxDef where
+instance (SingI s) => PrettyPrint (OperatorSyntaxDef s) where
   ppCode OperatorSyntaxDef {..} = do
-    let opSymbol' = ppUnkindedSymbol _opSymbol
+    let doc' = ppCode <$> _opDoc
+        opSymbol' = ppUnkindedSymbol _opSymbol
         p = ppUnkindedSymbol _opFixity
-    ppCode _opSyntaxKw <+> ppCode _opKw <+> opSymbol' <+> p
+    doc' ?<> ppCode _opSyntaxKw <+> ppCode _opKw <+> opSymbol' <+> p
 
 instance PrettyPrint PatternApp where
   ppCode = apeHelper
@@ -965,10 +969,12 @@ instance PrettyPrint ParsedIteratorInfo where
         items = ppBlockOrList' (catMaybes [iniItem, rangeItem])
     grouped (ppCode l <> items <> ppCode r)
 
-instance PrettyPrint IteratorSyntaxDef where
+instance (SingI s) => PrettyPrint (IteratorSyntaxDef s) where
   ppCode IteratorSyntaxDef {..} = do
-    let iterSymbol' = ppUnkindedSymbol _iterSymbol
-    ppCode _iterSyntaxKw
+    let doc' = ppCode <$> _iterDoc
+        iterSymbol' = ppUnkindedSymbol _iterSymbol
+    doc'
+      ?<> ppCode _iterSyntaxKw
       <+> ppCode _iterIteratorKw
       <+> iterSymbol'
       <+?> fmap ppCode _iterInfo

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

@@ -1044,10 +1044,26 @@ resolveFixitySyntaxDef fdef@FixitySyntaxDef {..} = topBindings $ do
     getFixityId :: (Members '[InfoTableBuilder, Reader InfoTable] r') => S.Symbol -> Sem r' S.NameId
     getFixityId = return . fromJust . (^. fixityDefFixity . fixityId) <=< getFixityDef
 
+checkOperatorSyntaxDef ::
+  forall r.
+  (Members '[Reader PackageId, Reader ScopeParameters, Reader InfoTable, InfoTableBuilder, NameIdGen, Error ScoperError, Reader ScopeParameters, State Scope, State ScoperState, State ScoperSyntax, NameIdGen, InfoTableBuilder, Reader InfoTable] r) =>
+  OperatorSyntaxDef 'Parsed ->
+  Sem r (OperatorSyntaxDef 'Scoped)
+checkOperatorSyntaxDef OperatorSyntaxDef {..} = do
+  mdef <- mapM checkJudoc _opDoc
+  return
+    OperatorSyntaxDef
+      { _opSymbol = _opSymbol,
+        _opDoc = mdef,
+        _opFixity = _opFixity,
+        _opSyntaxKw = _opSyntaxKw,
+        _opKw = _opKw
+      }
+
 resolveOperatorSyntaxDef ::
   forall r.
   (Members '[Error ScoperError, State Scope, State ScoperState, State ScoperSyntax, InfoTableBuilder, Reader InfoTable] r) =>
-  OperatorSyntaxDef ->
+  OperatorSyntaxDef 'Parsed ->
   Sem r ()
 resolveOperatorSyntaxDef s@OperatorSyntaxDef {..} = do
   checkNotDefined
@@ -1067,10 +1083,26 @@ resolveOperatorSyntaxDef s@OperatorSyntaxDef {..} = do
         (HashMap.lookup _opSymbol <$> gets (^. scoperSyntaxOperators . scoperOperators))
         $ \s' -> throw (ErrDuplicateOperator (DuplicateOperator (s' ^. symbolOperatorDef) s))
 
+checkIteratorSyntaxDef ::
+  forall r.
+  (Members '[Reader PackageId, Reader ScopeParameters, Reader InfoTable, InfoTableBuilder, NameIdGen, Error ScoperError, Reader ScopeParameters, State Scope, State ScoperState, State ScoperSyntax, NameIdGen, InfoTableBuilder, Reader InfoTable] r) =>
+  IteratorSyntaxDef 'Parsed ->
+  Sem r (IteratorSyntaxDef 'Scoped)
+checkIteratorSyntaxDef IteratorSyntaxDef {..} = do
+  doc <- mapM checkJudoc _iterDoc
+  return
+    IteratorSyntaxDef
+      { _iterSymbol = _iterSymbol,
+        _iterDoc = doc,
+        _iterInfo = _iterInfo,
+        _iterIteratorKw,
+        _iterSyntaxKw
+      }
+
 resolveIteratorSyntaxDef ::
   forall r.
   (Members '[Error ScoperError, State Scope, State ScoperState, State ScoperSyntax] r) =>
-  IteratorSyntaxDef ->
+  IteratorSyntaxDef 'Parsed ->
   Sem r ()
 resolveIteratorSyntaxDef s@IteratorSyntaxDef {..} = do
   checkNotDefined
@@ -1362,8 +1394,8 @@ checkInductiveDef InductiveDef {..} = do
 
             checkRecordSyntaxDef :: RecordSyntaxDef 'Parsed -> Sem r (RecordSyntaxDef 'Scoped)
             checkRecordSyntaxDef = \case
-              RecordSyntaxOperator d -> return (RecordSyntaxOperator d)
-              RecordSyntaxIterator d -> return (RecordSyntaxIterator d)
+              RecordSyntaxOperator d -> RecordSyntaxOperator <$> checkOperatorSyntaxDef d
+              RecordSyntaxIterator d -> RecordSyntaxIterator <$> checkIteratorSyntaxDef d
 
             checkRecordStatement :: RecordStatement 'Parsed -> Sem r (RecordStatement 'Scoped)
             checkRecordStatement = \case
@@ -3247,22 +3279,24 @@ checkSyntaxDef ::
 checkSyntaxDef = \case
   SyntaxFixity fixDef -> SyntaxFixity <$> checkFixitySyntaxDef fixDef
   SyntaxAlias a -> SyntaxAlias <$> checkAliasDef a
-  SyntaxOperator opDef -> return $ SyntaxOperator opDef
-  SyntaxIterator iterDef -> return $ SyntaxIterator iterDef
+  SyntaxOperator opDef -> SyntaxOperator <$> checkOperatorSyntaxDef opDef
+  SyntaxIterator iterDef -> SyntaxIterator <$> checkIteratorSyntaxDef iterDef
 
 checkAliasDef ::
   forall r.
-  (Members '[Error ScoperError, Reader ScopeParameters, State Scope, State ScoperState, Reader BindingStrategy, InfoTableBuilder, Reader InfoTable, NameIdGen, State ScoperSyntax] r) =>
+  (Members '[Reader PackageId, Reader ScopeParameters, Reader InfoTable, InfoTableBuilder, NameIdGen, Error ScoperError, Reader ScopeParameters, State Scope, State ScoperState, Reader BindingStrategy, InfoTableBuilder, Reader InfoTable, NameIdGen, State ScoperSyntax] r) =>
   AliasDef 'Parsed ->
   Sem r (AliasDef 'Scoped)
 checkAliasDef def@AliasDef {..} = do
   scanAlias def
+  doc' <- maybe (return Nothing) (return . Just <=< checkJudoc) _aliasDefDoc
   aliasName' :: S.Symbol <- gets (^?! scopeLocalSymbols . at _aliasDefName . _Just)
   asName' <- checkScopedIden _aliasDefAsName
   return
     AliasDef
       { _aliasDefName = aliasName',
         _aliasDefAsName = asName',
+        _aliasDefDoc = doc',
         ..
       }
   where
@@ -3281,7 +3315,7 @@ reserveAliasDef ::
 reserveAliasDef = void . reserveAliasSymbol
 
 resolveSyntaxDef ::
-  (Members '[Error ScoperError, Reader ScopeParameters, State Scope, State ScoperState, InfoTableBuilder, Reader InfoTable, NameIdGen, State ScoperSyntax, Reader BindingStrategy] r) =>
+  (Members '[Reader PackageId, Reader ScopeParameters, Reader InfoTable, InfoTableBuilder, NameIdGen, Error ScoperError, Reader ScopeParameters, State Scope, State ScoperState, InfoTableBuilder, Reader InfoTable, NameIdGen, State ScoperSyntax, Reader BindingStrategy] r) =>
   SyntaxDef 'Parsed ->
   Sem r ()
 resolveSyntaxDef = \case

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

@@ -210,8 +210,8 @@ instance ToGenericError QualSymNotInScope where
           msg = "Qualified symbol not in scope:" <+> ppCode opts' _qualSymNotInScope
 
 data DuplicateOperator = DuplicateOperator
-  { _dupOperatorFirst :: OperatorSyntaxDef,
-    _dupOperatorSecond :: OperatorSyntaxDef
+  { _dupOperatorFirst :: OperatorSyntaxDef 'Parsed,
+    _dupOperatorSecond :: OperatorSyntaxDef 'Parsed
   }
   deriving stock (Show)
 
@@ -241,8 +241,8 @@ instance ToGenericError DuplicateOperator where
               locs = vsep $ map (pretty . getLoc) [_dupOperatorFirst, _dupOperatorSecond]
 
 data DuplicateIterator = DuplicateIterator
-  { _dupIteratorFirst :: IteratorSyntaxDef,
-    _dupIteratorSecond :: IteratorSyntaxDef
+  { _dupIteratorFirst :: IteratorSyntaxDef 'Parsed,
+    _dupIteratorSecond :: IteratorSyntaxDef 'Parsed
   }
   deriving stock (Show)
 
@@ -426,7 +426,7 @@ instance ToGenericError ModuleNotInScope where
           msg = "The module" <+> ppCode opts' _moduleNotInScopeName <+> "is not in scope"
 
 newtype UnusedOperatorDef = UnusedOperatorDef
-  { _unusedOperatorDef :: OperatorSyntaxDef
+  { _unusedOperatorDef :: OperatorSyntaxDef 'Parsed
   }
   deriving stock (Show)
 
@@ -449,7 +449,7 @@ instance ToGenericError UnusedOperatorDef where
               <> ppCode opts' _unusedOperatorDef
 
 newtype UnusedIteratorDef = UnusedIteratorDef
-  { _unusedIteratorDef :: IteratorSyntaxDef
+  { _unusedIteratorDef :: IteratorSyntaxDef 'Parsed
   }
   deriving stock (Show)
 
@@ -741,7 +741,7 @@ instance ToGenericError IteratorInitializer where
       i = getLoc _iteratorInitializerIterator
 
 newtype InvalidRangeNumber = InvalidRangeNumber
-  { _invalidRangeNumber :: IteratorSyntaxDef
+  { _invalidRangeNumber :: IteratorSyntaxDef 'Parsed
   }
   deriving stock (Show)
 

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

@@ -705,6 +705,7 @@ aliasDef :: forall r. (Members '[ParserResultBuilder, PragmasStash, Error Parser
 aliasDef synKw = do
   let _aliasDefSyntaxKw = Irrelevant synKw
   _aliasDefAliasKw <- Irrelevant <$> kw kwAlias
+  _aliasDefDoc <- getJudoc
   _aliasDefName <- symbol
   kw kwAssign
   _aliasDefAsName <- name
@@ -770,16 +771,17 @@ parsedFixityInfo = do
 
 fixitySyntaxDef :: forall r. (Members '[ParserResultBuilder, PragmasStash, Error ParserError, JudocStash] r) => KeywordRef -> ParsecS r (FixitySyntaxDef 'Parsed)
 fixitySyntaxDef _fixitySyntaxKw = P.label "<fixity declaration>" $ do
-  _fixityDoc <- getJudoc
   _fixityKw <- kw kwFixity
+  _fixityDoc <- getJudoc
   _fixitySymbol <- symbol
   _fixityAssignKw <- kw kwAssign
   _fixityInfo <- parsedFixityInfo
   return FixitySyntaxDef {..}
 
-operatorSyntaxDef :: forall r. (Members '[ParserResultBuilder, PragmasStash, Error ParserError, JudocStash] r) => KeywordRef -> ParsecS r OperatorSyntaxDef
-operatorSyntaxDef _opSyntaxKw = do
+operatorSyntaxDef :: forall r. (Members '[ParserResultBuilder, PragmasStash, Error ParserError, JudocStash] r) => KeywordRef -> ParsecS r (OperatorSyntaxDef 'Parsed)
+operatorSyntaxDef _opSyntaxKw = P.label "<operator declaration>" $ do
   _opKw <- kw kwOperator
+  _opDoc <- getJudoc
   _opSymbol <- symbol
   _opFixity <- symbol
   return OperatorSyntaxDef {..}
@@ -810,9 +812,10 @@ parsedIteratorInfo = do
       void (kw kwRange >> kw kwAssign)
       fmap fromIntegral <$> integer
 
-iteratorSyntaxDef :: forall r. (Members '[ParserResultBuilder, PragmasStash, Error ParserError, JudocStash] r) => KeywordRef -> ParsecS r IteratorSyntaxDef
+iteratorSyntaxDef :: forall r. (Members '[ParserResultBuilder, PragmasStash, Error ParserError, JudocStash] r) => KeywordRef -> ParsecS r (IteratorSyntaxDef 'Parsed)
 iteratorSyntaxDef _iterSyntaxKw = do
   _iterIteratorKw <- kw kwIterator
+  _iterDoc <- getJudoc
   _iterSymbol <- symbol
   _iterInfo <- optional parsedIteratorInfo
   return IteratorSyntaxDef {..}