Skip to content

Whitespace parser parses comments #56

New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Merged
merged 8 commits into from
May 22, 2022
Merged

Whitespace parser parses comments #56

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
8 commits
Select commit Hold shift + click to select a range
89677a5
Rename Comment -> DocComment
avh4 May 1, 2022
eff5b1c
Add comments to the whitespace parser type signature
avh4 May 1, 2022
1c2569a
Backfill simple Parse.Space test
avh4 May 1, 2022
ca1227d
Backfill Parse.Space tests for adjacent tokens
avh4 May 1, 2022
b72a2d2
Parse curly brace comments in whitespace
avh4 May 1, 2022
947fdc9
Parse hyphen comments in whitespace
avh4 May 1, 2022
cf1cf4f
Remove "comment trick" comments for now
avh4 May 1, 2022
809cf42
Limit scope of -Wno-error=unused-do-binds
avh4 May 2, 2022
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
22 changes: 17 additions & 5 deletions compiler/src/AST/Source.hs
View file
Open in desktop
Original file line number Diff line number Diff line change
@@ -1,7 +1,10 @@
{-# LANGUAGE EmptyDataDecls #-}
{-# OPTIONS_GHC -Wall #-}

module AST.Source
( Expr,
( Comment (..),
GREN_COMMENT,
Expr,
Expr_ (..),
VarType (..),
Def (..),
Expand All @@ -23,7 +26,7 @@ module AST.Source
Effects (..),
Manager (..),
Docs (..),
Comment (..),
DocComment (..),
Exposing (..),
Exposed (..),
Privacy (..),
Expand All @@ -33,11 +36,20 @@ where
import qualified AST.Utils.Binop as Binop
import Data.Name (Name)
import qualified Data.Name as Name
import qualified Data.Utf8 as Utf8
import qualified Gren.Float as EF
import qualified Gren.String as ES
import qualified Parse.Primitives as P
import qualified Reporting.Annotation as A

-- COMMENTS

data Comment
= BlockComment (Utf8.Utf8 GREN_COMMENT)
| LineComment (Utf8.Utf8 GREN_COMMENT)

data GREN_COMMENT

-- EXPRESSIONS

type Expr = A.Located Expr_
Expand Down Expand Up @@ -157,10 +169,10 @@ data Manager

data Docs
= NoDocs A.Region
| YesDocs Comment [(Name, Comment)]
| YesDocs DocComment [(Name, DocComment)]

newtype Comment
= Comment P.Snippet
newtype DocComment
= DocComment P.Snippet

-- EXPOSING

Expand Down
2 changes: 0 additions & 2 deletions compiler/src/Compile.hs
View file
Open in desktop
Original file line number Diff line number Diff line change
@@ -1,5 +1,3 @@
{-# OPTIONS_GHC -Wall -fno-warn-unused-do-bind #-}

module Compile
( Artifacts (..),
compile,
Expand Down
16 changes: 9 additions & 7 deletions compiler/src/Gren/Docs.hs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -3,6 +3,8 @@
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE UnboxedTuples #-}
{-# OPTIONS_GHC -Wall #-}
-- Temporary while implementing gren format
{-# OPTIONS_GHC -Wno-error=unused-do-bind #-}

module Gren.Docs
( Documentation,
Expand Down Expand Up @@ -270,8 +272,8 @@ fromModule modul@(Can.Module _ exports docs _ _ _ _ _) =

-- PARSE OVERVIEW

parseOverview :: Src.Comment -> Either E.Error [A.Located Name.Name]
parseOverview (Src.Comment snippet) =
parseOverview :: Src.DocComment -> Either E.Error [A.Located Name.Name]
parseOverview (Src.DocComment snippet) =
case P.fromSnippet (chompOverview []) E.BadEnd snippet of
Left err ->
Left (E.SyntaxProblem err)
Expand Down Expand Up @@ -394,20 +396,20 @@ onlyInExports name (A.At region _) =

-- CHECK DEFS

checkDefs :: Map.Map Name.Name (A.Located Can.Export) -> Src.Comment -> Map.Map Name.Name Src.Comment -> Can.Module -> Either E.Error Module
checkDefs :: Map.Map Name.Name (A.Located Can.Export) -> Src.DocComment -> Map.Map Name.Name Src.DocComment -> Can.Module -> Either E.Error Module
checkDefs exportDict overview comments (Can.Module name _ _ decls unions aliases infixes effects) =
let types = gatherTypes decls Map.empty
info = Info comments types unions aliases infixes effects
in case Result.run (Map.traverseWithKey (checkExport info) exportDict) of
(_, Left problems) -> Left $ E.DefProblems (OneOrMore.destruct NE.List problems)
(_, Right inserters) -> Right $ foldr ($) (emptyModule name overview) inserters

emptyModule :: ModuleName.Canonical -> Src.Comment -> Module
emptyModule (ModuleName.Canonical _ name) (Src.Comment overview) =
emptyModule :: ModuleName.Canonical -> Src.DocComment -> Module
emptyModule (ModuleName.Canonical _ name) (Src.DocComment overview) =
Module name (Json.fromComment overview) Map.empty Map.empty Map.empty Map.empty

data Info = Info
{ _iComments :: Map.Map Name.Name Src.Comment,
{ _iComments :: Map.Map Name.Name Src.DocComment,
_iValues :: Map.Map Name.Name (Either A.Region Can.Type),
_iUnions :: Map.Map Name.Name Can.Union,
_iAliases :: Map.Map Name.Name Can.Alias,
Expand Down Expand Up @@ -461,7 +463,7 @@ getComment region name info =
case Map.lookup name (_iComments info) of
Nothing ->
Result.throw (E.NoComment name region)
Just (Src.Comment snippet) ->
Just (Src.DocComment snippet) ->
Result.ok (Json.fromComment snippet)

getType :: Name.Name -> Info -> Result.Result i w E.DefProblem Type.Type
Expand Down
2 changes: 2 additions & 0 deletions compiler/src/Gren/Kernel.hs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -3,6 +3,8 @@
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE UnboxedTuples #-}
{-# OPTIONS_GHC -Wall #-}
-- Temporary while implementing gren format
{-# OPTIONS_GHC -Wno-error=unused-do-bind #-}

module Gren.Kernel
( Content (..),
Expand Down
2 changes: 1 addition & 1 deletion compiler/src/Json/Decode.hs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -2,7 +2,7 @@
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE Rank2Types #-}
{-# LANGUAGE UnboxedTuples #-}
{-# OPTIONS_GHC -Wall -fno-warn-unused-do-bind -fno-warn-name-shadowing #-}
{-# OPTIONS_GHC -fno-warn-name-shadowing #-}

module Json.Decode
( fromByteString,
Expand Down
21 changes: 11 additions & 10 deletions compiler/src/Parse/Declaration.hs
View file
Open in desktop
Original file line number Diff line number Diff line change
@@ -1,5 +1,6 @@
{-# LANGUAGE OverloadedStrings #-}
{-# OPTIONS_GHC -Wall -fno-warn-unused-do-bind #-}
-- Temporary while implementing gren format
{-# OPTIONS_GHC -Wno-error=unused-do-bind #-}

module Parse.Declaration
( Decl (..),
Expand Down Expand Up @@ -27,10 +28,10 @@ import qualified Reporting.Error.Syntax as E
-- DECLARATION

data Decl
= Value (Maybe Src.Comment) (A.Located Src.Value)
| Union (Maybe Src.Comment) (A.Located Src.Union)
| Alias (Maybe Src.Comment) (A.Located Src.Alias)
| Port (Maybe Src.Comment) Src.Port
= Value (Maybe Src.DocComment) (A.Located Src.Value)
| Union (Maybe Src.DocComment) (A.Located Src.Union)
| Alias (Maybe Src.DocComment) (A.Located Src.Alias)
| Port (Maybe Src.DocComment) Src.Port

declaration :: Space.Parser E.Decl Decl
declaration =
Expand All @@ -46,7 +47,7 @@ declaration =

-- DOC COMMENT

chompDocComment :: Parser E.Decl (Maybe Src.Comment)
chompDocComment :: Parser E.Decl (Maybe Src.DocComment)
chompDocComment =
oneOfWithFallback
[ do
Expand All @@ -59,7 +60,7 @@ chompDocComment =

-- DEFINITION and ANNOTATION

valueDecl :: Maybe Src.Comment -> A.Position -> Space.Parser E.Decl Decl
valueDecl :: Maybe Src.DocComment -> A.Position -> Space.Parser E.Decl Decl
valueDecl maybeDocs start =
do
name <- Var.lower E.DeclStart
Expand All @@ -80,7 +81,7 @@ valueDecl maybeDocs start =
chompDefArgsAndBody maybeDocs start (A.at start end name) Nothing []
]

chompDefArgsAndBody :: Maybe Src.Comment -> A.Position -> A.Located Name.Name -> Maybe Src.Type -> [Src.Pattern] -> Space.Parser E.DeclDef Decl
chompDefArgsAndBody :: Maybe Src.DocComment -> A.Position -> A.Located Name.Name -> Maybe Src.Type -> [Src.Pattern] -> Space.Parser E.DeclDef Decl
chompDefArgsAndBody maybeDocs start name tipe revArgs =
oneOf
E.DeclDefEquals
Expand Down Expand Up @@ -114,7 +115,7 @@ chompMatchingName expectedName =

-- TYPE DECLARATIONS

typeDecl :: Maybe Src.Comment -> A.Position -> Space.Parser E.Decl Decl
typeDecl :: Maybe Src.DocComment -> A.Position -> Space.Parser E.Decl Decl
typeDecl maybeDocs start =
inContext E.DeclType (Keyword.type_ E.DeclStart) $
do
Expand Down Expand Up @@ -197,7 +198,7 @@ chompVariants variants end =

-- PORT

portDecl :: Maybe Src.Comment -> Space.Parser E.Decl Decl
portDecl :: Maybe Src.DocComment -> Space.Parser E.Decl Decl
portDecl maybeDocs =
inContext E.Port (Keyword.port_ E.DeclStart) $
do
Expand Down
3 changes: 2 additions & 1 deletion compiler/src/Parse/Expression.hs
View file
Open in desktop
Original file line number Diff line number Diff line change
@@ -1,5 +1,6 @@
{-# LANGUAGE OverloadedStrings #-}
{-# OPTIONS_GHC -Wall -fno-warn-unused-do-bind #-}
-- Temporary while implementing gren format
{-# OPTIONS_GHC -Wno-error=unused-do-bind #-}

module Parse.Expression
( expression,
Expand Down
22 changes: 13 additions & 9 deletions compiler/src/Parse/Module.hs
View file
Open in desktop
Original file line number Diff line number Diff line change
@@ -1,5 +1,8 @@
{-# LANGUAGE OverloadedStrings #-}
{-# OPTIONS_GHC -Wall #-}
-- Temporary while implementing gren format
{-# OPTIONS_GHC -Wno-error=unused-do-bind #-}
{-# OPTIONS_GHC -Wno-error=unused-matches #-}

module Parse.Module
( fromByteString,
Expand Down Expand Up @@ -125,15 +128,15 @@ categorizeDecls values unions aliases ports decls =

-- TO DOCS

toDocs :: Either A.Region Src.Comment -> [Decl.Decl] -> Src.Docs
toDocs :: Either A.Region Src.DocComment -> [Decl.Decl] -> Src.Docs
toDocs comment decls =
case comment of
Right overview ->
Src.YesDocs overview (getComments decls [])
Left region ->
Src.NoDocs region

getComments :: [Decl.Decl] -> [(Name.Name, Src.Comment)] -> [(Name.Name, Src.Comment)]
getComments :: [Decl.Decl] -> [(Name.Name, Src.DocComment)] -> [(Name.Name, Src.DocComment)]
getComments decls comments =
case decls of
[] ->
Expand All @@ -145,19 +148,20 @@ getComments decls comments =
Decl.Alias c (A.At _ (Src.Alias n _ _)) -> getComments otherDecls (addComment c n comments)
Decl.Port c (Src.Port n _) -> getComments otherDecls (addComment c n comments)

addComment :: Maybe Src.Comment -> A.Located Name.Name -> [(Name.Name, Src.Comment)] -> [(Name.Name, Src.Comment)]
addComment :: Maybe Src.DocComment -> A.Located Name.Name -> [(Name.Name, Src.DocComment)] -> [(Name.Name, Src.DocComment)]
addComment maybeComment (A.At _ name) comments =
case maybeComment of
Just comment -> (name, comment) : comments
Nothing -> comments

-- FRESH LINES

freshLine :: (Row -> Col -> E.Module) -> Parser E.Module ()
freshLine :: (Row -> Col -> E.Module) -> Parser E.Module [Src.Comment]
freshLine toFreshLineError =
do
Space.chomp E.ModuleSpace
comments <- Space.chomp E.ModuleSpace
Space.checkFreshLine toFreshLineError
return comments

-- CHOMP DECLARATIONS

Expand All @@ -183,10 +187,10 @@ chompInfixes infixes =

-- MODULE DOC COMMENT

chompModuleDocCommentSpace :: Parser E.Module (Either A.Region Src.Comment)
chompModuleDocCommentSpace :: Parser E.Module (Either A.Region Src.DocComment)
chompModuleDocCommentSpace =
do
(A.At region ()) <- addLocation (freshLine E.FreshLine)
(A.At region comments) <- addLocation (freshLine E.FreshLine)
oneOfWithFallback
[ do
docComment <- Space.docComment E.ImportStart E.ModuleSpace
Expand All @@ -199,7 +203,7 @@ chompModuleDocCommentSpace =
-- HEADER

data Header
= Header (A.Located Name.Name) Effects (A.Located Src.Exposing) (Either A.Region Src.Comment)
= Header (A.Located Name.Name) Effects (A.Located Src.Exposing) (Either A.Region Src.DocComment)

data Effects
= NoEffects A.Region
Expand Down Expand Up @@ -329,7 +333,7 @@ chompSubscription =
spaces_em
addLocation (Var.upper E.Effect)

spaces_em :: Parser E.Module ()
spaces_em :: Parser E.Module [Src.Comment]
Copy link
Member

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

Why change () to [Src.Comment] here? Is it for easier composition later?

Copy link
Contributor Author

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

I didn't really look where spaces_em is used yet, but I just pushed that up since this is just a wrapper for Space.compAndCheckIndent. My plan to making sure we don't accidentally discard any comments is to keep pushing the [Src.Comment] up at every level until we get to the parse that actually creates the AST node, and rely on the unused-bind warning to tell us when there are still comments that are discarded.

Copy link
Member

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

Makes sense :)

spaces_em =
Space.chompAndCheckIndent E.ModuleSpace E.Effect

Expand Down
3 changes: 2 additions & 1 deletion compiler/src/Parse/Pattern.hs
View file
Open in desktop
Original file line number Diff line number Diff line change
@@ -1,7 +1,8 @@
{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE UnboxedTuples #-}
{-# OPTIONS_GHC -Wall -fno-warn-unused-do-bind #-}
-- Temporary while implementing gren format
{-# OPTIONS_GHC -Wno-error=unused-do-bind #-}

module Parse.Pattern
( term,
Expand Down
2 changes: 1 addition & 1 deletion compiler/src/Parse/Primitives.hs
View file
Open in desktop
Original file line number Diff line number Diff line change
@@ -1,7 +1,7 @@
{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE Rank2Types #-}
{-# LANGUAGE UnboxedTuples #-}
{-# OPTIONS_GHC -Wall -fno-warn-unused-do-bind -fno-warn-name-shadowing #-}
{-# OPTIONS_GHC -fno-warn-name-shadowing #-}

module Parse.Primitives
( fromByteString,
Expand Down
Loading