mirror of
https://github.com/gren-lang/compiler.git
synced 2024-10-27 02:07:54 +03:00
format: retain comments between top-level declarations
This commit is contained in:
parent
c0a4082c1a
commit
56df4e9c6b
@ -269,7 +269,7 @@ crawlFile env@(Env _ root projectType _ _ buildID _ _) mvar docsNeed expectedNam
|
||||
case Parse.fromByteString projectType source of
|
||||
Left err ->
|
||||
return $ SBadSyntax path time source err
|
||||
Right modul@(Src.Module maybeActualName _ _ imports values _ _ _ _ _) ->
|
||||
Right modul@(Src.Module maybeActualName _ _ imports values _ _ _ _ _ _) ->
|
||||
case maybeActualName of
|
||||
Nothing ->
|
||||
return $ SBadSyntax path time source (Syntax.ModuleNameUnspecified expectedName)
|
||||
@ -335,11 +335,11 @@ checkModule env@(Env _ root projectType _ _ _ _ _) foreigns resultsMVar name sta
|
||||
RProblem $
|
||||
Error.Module name path time source $
|
||||
case Parse.fromByteString projectType source of
|
||||
Right (Src.Module _ _ _ imports _ _ _ _ _ _) ->
|
||||
Right (Src.Module _ _ _ imports _ _ _ _ _ _ _) ->
|
||||
Error.BadImports (toImportErrors env results imports problems)
|
||||
Left err ->
|
||||
Error.BadSyntax err
|
||||
SChanged local@(Details.Local path time deps _ _ lastCompile) source modul@(Src.Module _ _ _ imports _ _ _ _ _ _) docsNeed ->
|
||||
SChanged local@(Details.Local path time deps _ _ lastCompile) source modul@(Src.Module _ _ _ imports _ _ _ _ _ _ _) docsNeed ->
|
||||
do
|
||||
results <- readMVar resultsMVar
|
||||
depsStatus <- checkDeps root results deps lastCompile
|
||||
@ -760,7 +760,7 @@ fromRepl root details source =
|
||||
case Parse.fromByteString projectType source of
|
||||
Left syntaxError ->
|
||||
return $ Left $ Exit.ReplBadInput source $ Error.BadSyntax syntaxError
|
||||
Right modul@(Src.Module _ _ _ imports _ _ _ _ _ _) ->
|
||||
Right modul@(Src.Module _ _ _ imports _ _ _ _ _ _ _) ->
|
||||
do
|
||||
dmvar <- Details.loadInterfaces root details
|
||||
|
||||
@ -785,7 +785,7 @@ fromRepl root details source =
|
||||
finalizeReplArtifacts env source modul depsStatus resultMVars results
|
||||
|
||||
finalizeReplArtifacts :: Env -> B.ByteString -> Src.Module -> DepsStatus -> ResultDict -> Map.Map ModuleName.Raw Result -> IO (Either Exit.Repl ReplArtifacts)
|
||||
finalizeReplArtifacts env@(Env _ root projectType platform _ _ _ _) source modul@(Src.Module _ _ _ imports _ _ _ _ _ _) depsStatus resultMVars results =
|
||||
finalizeReplArtifacts env@(Env _ root projectType platform _ _ _ _) source modul@(Src.Module _ _ _ imports _ _ _ _ _ _ _) depsStatus resultMVars results =
|
||||
let pkg =
|
||||
projectTypeToPkg projectType
|
||||
|
||||
@ -951,7 +951,7 @@ crawlRoot env@(Env _ _ projectType _ _ buildID _ _) mvar root =
|
||||
time <- File.getTime path
|
||||
source <- File.readUtf8 path
|
||||
case Parse.fromByteString projectType source of
|
||||
Right modul@(Src.Module _ _ _ imports values _ _ _ _ _) ->
|
||||
Right modul@(Src.Module _ _ _ imports values _ _ _ _ _ _) ->
|
||||
do
|
||||
let deps = map Src.getImportName imports
|
||||
let local = Details.Local path time deps (any (isMain . snd) values) buildID buildID
|
||||
@ -976,7 +976,7 @@ checkRoot env@(Env _ root _ _ _ _ _ _) results rootStatus =
|
||||
return (RInside name)
|
||||
SOutsideErr err ->
|
||||
return (ROutsideErr err)
|
||||
SOutsideOk local@(Details.Local path time deps _ _ lastCompile) source modul@(Src.Module _ _ _ imports _ _ _ _ _ _) ->
|
||||
SOutsideOk local@(Details.Local path time deps _ _ lastCompile) source modul@(Src.Module _ _ _ imports _ _ _ _ _ _ _) ->
|
||||
do
|
||||
depsStatus <- checkDeps root results deps lastCompile
|
||||
case depsStatus of
|
||||
|
@ -491,7 +491,7 @@ crawlFile foreignDeps mvar pkg src docsStatus expectedName path =
|
||||
do
|
||||
bytes <- File.readUtf8 path
|
||||
case Parse.fromByteString (Parse.Package pkg) bytes of
|
||||
Right modul@(Src.Module (Just (A.At _ actualName)) _ _ imports _ _ _ _ _ _) | expectedName == actualName ->
|
||||
Right modul@(Src.Module (Just (A.At _ actualName)) _ _ imports _ _ _ _ _ _ _) | expectedName == actualName ->
|
||||
do
|
||||
deps <- crawlImports foreignDeps mvar pkg src imports
|
||||
return (Just (SLocal docsStatus deps modul))
|
||||
|
@ -37,6 +37,7 @@ where
|
||||
import AST.SourceComments (Comment, GREN_COMMENT)
|
||||
import AST.SourceComments qualified as SC
|
||||
import AST.Utils.Binop qualified as Binop
|
||||
import Data.List.NonEmpty (NonEmpty)
|
||||
import Data.Name (Name)
|
||||
import Data.Name qualified as Name
|
||||
import Gren.Float qualified as EF
|
||||
@ -58,9 +59,9 @@ data Expr_
|
||||
| Array [Expr]
|
||||
| Op Name
|
||||
| Negate Expr
|
||||
| Binops [(Expr, A.Located Name)] Expr
|
||||
| Binops [(Expr, [Comment], A.Located Name)] Expr
|
||||
| Lambda [Pattern] Expr
|
||||
| Call Expr [Expr]
|
||||
| Call Expr [([Comment], Expr)]
|
||||
| If [(Expr, Expr)] Expr
|
||||
| Let [A.Located Def] Expr
|
||||
| Case Expr [(Pattern, Expr)]
|
||||
@ -129,13 +130,14 @@ data Module = Module
|
||||
_unions :: [(SourceOrder, A.Located Union)],
|
||||
_aliases :: [(SourceOrder, A.Located Alias)],
|
||||
_binops :: [A.Located Infix],
|
||||
_topLevelComments :: [(SourceOrder, NonEmpty Comment)],
|
||||
_headerComments :: SC.HeaderComments,
|
||||
_effects :: Effects
|
||||
}
|
||||
deriving (Show)
|
||||
|
||||
getName :: Module -> Name
|
||||
getName (Module maybeName _ _ _ _ _ _ _ _ _) =
|
||||
getName (Module maybeName _ _ _ _ _ _ _ _ _ _) =
|
||||
case maybeName of
|
||||
Just (A.At _ name) ->
|
||||
name
|
||||
|
@ -46,7 +46,7 @@ addVars module_ (Env.Env home vs ts cs bs qvs qts qcs) =
|
||||
Result.ok $ Env.Env home vs2 ts cs bs qvs qts qcs
|
||||
|
||||
collectVars :: Src.Module -> Result i w (Map.Map Name.Name Env.Var)
|
||||
collectVars (Src.Module _ _ _ _ values _ _ _ _ effects) =
|
||||
collectVars (Src.Module _ _ _ _ values _ _ _ _ _ effects) =
|
||||
let addDecl dict (A.At _ (Src.Value (A.At region name) _ _ _)) =
|
||||
Dups.insert name region (Env.TopLevel region) dict
|
||||
in Dups.detect Error.DuplicateDecl $
|
||||
@ -75,7 +75,7 @@ toEffectDups effects =
|
||||
-- ADD TYPES
|
||||
|
||||
addTypes :: Src.Module -> Env.Env -> Result i w Env.Env
|
||||
addTypes (Src.Module _ _ _ _ _ unions aliases _ _ _) (Env.Env home vs ts cs bs qvs qts qcs) =
|
||||
addTypes (Src.Module _ _ _ _ _ unions aliases _ _ _ _) (Env.Env home vs ts cs bs qvs qts qcs) =
|
||||
let addAliasDups dups (A.At _ (Src.Alias (A.At region name) _ _)) = Dups.insert name region () dups
|
||||
addUnionDups dups (A.At _ (Src.Union (A.At region name) _ _)) = Dups.insert name region () dups
|
||||
typeNameDups =
|
||||
@ -199,7 +199,7 @@ addFreeVars freeVars (A.At region tipe) =
|
||||
-- ADD CTORS
|
||||
|
||||
addCtors :: Src.Module -> Env.Env -> Result i w (Env.Env, Unions, Aliases)
|
||||
addCtors (Src.Module _ _ _ _ _ unions aliases _ _ _) env@(Env.Env home vs ts cs bs qvs qts qcs) =
|
||||
addCtors (Src.Module _ _ _ _ _ unions aliases _ _ _ _) env@(Env.Env home vs ts cs bs qvs qts qcs) =
|
||||
do
|
||||
unionInfo <- traverse (canonicalizeUnion env) (fmap snd unions)
|
||||
aliasInfo <- traverse (canonicalizeAlias env) (fmap snd aliases)
|
||||
|
@ -93,7 +93,7 @@ canonicalize env (A.At region expression) =
|
||||
Src.Call func args ->
|
||||
Can.Call
|
||||
<$> canonicalize env func
|
||||
<*> traverse (canonicalize env) args
|
||||
<*> traverse (canonicalize env) (fmap snd args)
|
||||
Src.If branches finally ->
|
||||
Can.If
|
||||
<$> traverse (canonicalizeIfBranch env) branches
|
||||
@ -149,9 +149,9 @@ canonicalizeCaseBranch env (pattern, expr) =
|
||||
|
||||
-- CANONICALIZE BINOPS
|
||||
|
||||
canonicalizeBinops :: A.Region -> Env.Env -> [(Src.Expr, A.Located Name.Name)] -> Src.Expr -> Result FreeLocals [W.Warning] Can.Expr
|
||||
canonicalizeBinops :: A.Region -> Env.Env -> [(Src.Expr, [Src.Comment], A.Located Name.Name)] -> Src.Expr -> Result FreeLocals [W.Warning] Can.Expr
|
||||
canonicalizeBinops overallRegion env ops final =
|
||||
let canonicalizeHelp (expr, A.At region op) =
|
||||
let canonicalizeHelp (expr, _, A.At region op) =
|
||||
(,)
|
||||
<$> canonicalize env expr
|
||||
<*> Env.findBinop region env op
|
||||
|
@ -35,7 +35,7 @@ type Result i w a =
|
||||
-- MODULES
|
||||
|
||||
canonicalize :: Pkg.Name -> Map.Map ModuleName.Raw I.Interface -> Src.Module -> Result i [W.Warning] Can.Module
|
||||
canonicalize pkg ifaces modul@(Src.Module _ exports docs imports valuesWithSourceOrder _ _ binops _ effects) =
|
||||
canonicalize pkg ifaces modul@(Src.Module _ exports docs imports valuesWithSourceOrder _ _ binops _ _ effects) =
|
||||
do
|
||||
let values = fmap snd valuesWithSourceOrder
|
||||
let home = ModuleName.Canonical pkg (Src.getName modul)
|
||||
|
@ -87,7 +87,7 @@ encode tipe =
|
||||
decoder :: D.Decoder () Type
|
||||
decoder =
|
||||
let parser =
|
||||
P.specialize (\_ _ _ -> ()) (fromRawType . fst <$> Type.expression)
|
||||
P.specialize (\_ _ _ -> ()) (fromRawType . fst . fst <$> Type.expression)
|
||||
in D.customString parser (\_ _ -> ())
|
||||
|
||||
fromRawType :: Src.Type -> Type
|
||||
|
@ -34,15 +34,15 @@ toByteStringBuilder module_ =
|
||||
-- Data structure extras
|
||||
--
|
||||
|
||||
repair :: [(a, b)] -> a -> (a, [(b, a)])
|
||||
repair [] single = (single, [])
|
||||
repair ((first, b) : rest) final =
|
||||
(first, repairHelp b rest final)
|
||||
repair3 :: [(a, b, c)] -> a -> (a, [(b, c, a)])
|
||||
repair3 [] single = (single, [])
|
||||
repair3 ((first, b, c) : rest) final =
|
||||
(first, repair3Help b c rest final)
|
||||
|
||||
repairHelp :: b -> [(a, b)] -> a -> [(b, a)]
|
||||
repairHelp b [] a = [(b, a)]
|
||||
repairHelp b1 ((a1, b2) : rest) a2 =
|
||||
(b1, a1) : repairHelp b2 rest a2
|
||||
repair3Help :: b -> c -> [(a, b, c)] -> a -> [(b, c, a)]
|
||||
repair3Help b c [] a = [(b, c, a)]
|
||||
repair3Help b1 c1 ((a1, b2, c2) : rest) a2 =
|
||||
(b1, c1, a1) : repair3Help b2 c2 rest a2
|
||||
|
||||
--
|
||||
-- Helper functions
|
||||
@ -158,10 +158,15 @@ formatComment = \case
|
||||
in Block.mustBreak $ Block.string7 open <> utf8 text
|
||||
|
||||
formatCommentBlock :: [Src.Comment] -> Maybe Block
|
||||
formatCommentBlock = fmap spaceOrStack . nonEmpty . fmap formatComment
|
||||
formatCommentBlock =
|
||||
fmap formatCommentBlockNonEmpty . nonEmpty
|
||||
|
||||
formatCommentBlockNonEmpty :: NonEmpty Src.Comment -> Block
|
||||
formatCommentBlockNonEmpty =
|
||||
spaceOrStack . fmap formatComment
|
||||
|
||||
formatModule :: Src.Module -> Block
|
||||
formatModule (Src.Module moduleName exports docs imports values unions aliases binops comments effects) =
|
||||
formatModule (Src.Module moduleName exports docs imports values unions aliases binops topLevelComments comments effects) =
|
||||
Block.stack $
|
||||
NonEmpty.fromList $
|
||||
catMaybes
|
||||
@ -195,6 +200,7 @@ formatModule (Src.Module moduleName exports docs imports values unions aliases b
|
||||
[ fmap (formatWithDocComment valueName formatValue . A.toValue) <$> values,
|
||||
fmap (formatWithDocComment unionName formatUnion . A.toValue) <$> unions,
|
||||
fmap (formatWithDocComment aliasName formatAlias . A.toValue) <$> aliases,
|
||||
fmap formatTopLevelCommentBlock <$> topLevelComments,
|
||||
case effects of
|
||||
Src.NoEffects -> []
|
||||
Src.Ports ports _ -> fmap (formatWithDocComment portName formatPort) <$> ports
|
||||
@ -242,6 +248,13 @@ formatModule (Src.Module moduleName exports docs imports values unions aliases b
|
||||
Block.stack $ fmap (formatInfix . A.toValue) some
|
||||
]
|
||||
|
||||
formatTopLevelCommentBlock :: NonEmpty Src.Comment -> Block
|
||||
formatTopLevelCommentBlock comments =
|
||||
Block.stack
|
||||
[ Block.blankLine,
|
||||
formatCommentBlockNonEmpty comments
|
||||
]
|
||||
|
||||
formatEffectsModuleWhereClause :: Src.Effects -> Maybe Block
|
||||
formatEffectsModuleWhereClause = \case
|
||||
Src.NoEffects -> Nothing
|
||||
@ -493,7 +506,7 @@ formatExpr = \case
|
||||
formatExpr $
|
||||
A.toValue expr
|
||||
Src.Binops postfixOps final ->
|
||||
let (first, rest) = repair postfixOps final
|
||||
let (first, rest) = repair3 postfixOps final
|
||||
in ExpressionContainsInfixOps $
|
||||
spaceOrIndentForce forceMultiline $
|
||||
exprParensProtectInfixOps (formatExpr $ A.toValue first)
|
||||
@ -501,8 +514,9 @@ formatExpr = \case
|
||||
where
|
||||
-- for now we just use multiline formatting for specific operators,
|
||||
-- since we don't yet track where the linebreaks are in the source
|
||||
forceMultiline = any (opForcesMultiline . A.toValue . snd) postfixOps
|
||||
formatPair (op, expr) =
|
||||
forceMultiline = any (opForcesMultiline . opFromPair) postfixOps
|
||||
opFromPair (_, _, name) = A.toValue name
|
||||
formatPair (commentsBeforeOp, op, expr) =
|
||||
Block.prefix
|
||||
4
|
||||
(utf8 (A.toValue op) <> Block.space)
|
||||
@ -526,7 +540,10 @@ formatExpr = \case
|
||||
ExpressionContainsSpaces $
|
||||
spaceOrIndent $
|
||||
exprParensProtectInfixOps (formatExpr $ A.toValue fn)
|
||||
:| fmap (exprParensProtectSpaces . formatExpr . A.toValue) args
|
||||
:| fmap formatArg args
|
||||
where
|
||||
formatArg (commentsBefore, arg) =
|
||||
exprParensProtectSpaces (formatExpr $ A.toValue arg)
|
||||
Src.If [] else_ ->
|
||||
formatExpr $ A.toValue else_
|
||||
Src.If (if_ : elseifs) else_ ->
|
||||
|
@ -1,6 +1,7 @@
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
-- Temporary while implementing gren format
|
||||
{-# OPTIONS_GHC -Wno-error=unused-do-bind #-}
|
||||
{-# OPTIONS_GHC -Wno-error=unused-matches #-}
|
||||
|
||||
module Parse.Declaration
|
||||
( Decl (..),
|
||||
@ -11,6 +12,7 @@ where
|
||||
|
||||
import AST.Source qualified as Src
|
||||
import AST.Utils.Binop qualified as Binop
|
||||
import Data.List.NonEmpty (NonEmpty)
|
||||
import Data.Name qualified as Name
|
||||
import Parse.Expression qualified as Expr
|
||||
import Parse.Keyword qualified as Keyword
|
||||
@ -32,8 +34,9 @@ data Decl
|
||||
| Union (Maybe Src.DocComment) (A.Located Src.Union)
|
||||
| Alias (Maybe Src.DocComment) (A.Located Src.Alias)
|
||||
| Port (Maybe Src.DocComment) Src.Port
|
||||
| TopLevelComments (NonEmpty Src.Comment)
|
||||
|
||||
declaration :: Space.Parser E.Decl Decl
|
||||
declaration :: Space.Parser E.Decl (Decl, [Src.Comment])
|
||||
declaration =
|
||||
do
|
||||
maybeDocs <- chompDocComment
|
||||
@ -60,7 +63,7 @@ chompDocComment =
|
||||
|
||||
-- DEFINITION and ANNOTATION
|
||||
|
||||
valueDecl :: Maybe Src.DocComment -> A.Position -> Space.Parser E.Decl Decl
|
||||
valueDecl :: Maybe Src.DocComment -> A.Position -> Space.Parser E.Decl (Decl, [Src.Comment])
|
||||
valueDecl maybeDocs start =
|
||||
do
|
||||
name <- Var.lower E.DeclStart
|
||||
@ -73,7 +76,7 @@ valueDecl maybeDocs start =
|
||||
[ do
|
||||
word1 0x3A {-:-} E.DeclDefEquals
|
||||
Space.chompAndCheckIndent E.DeclDefSpace E.DeclDefIndentType
|
||||
(tipe, _) <- specialize E.DeclDefType Type.expression
|
||||
((tipe, commentsAfterTipe), _) <- specialize E.DeclDefType Type.expression
|
||||
Space.checkFreshLine E.DeclDefNameRepeat
|
||||
defName <- chompMatchingName name
|
||||
Space.chompAndCheckIndent E.DeclDefSpace E.DeclDefIndentEquals
|
||||
@ -81,7 +84,7 @@ valueDecl maybeDocs start =
|
||||
chompDefArgsAndBody maybeDocs start (A.at start end name) Nothing []
|
||||
]
|
||||
|
||||
chompDefArgsAndBody :: Maybe Src.DocComment -> 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, [Src.Comment])
|
||||
chompDefArgsAndBody maybeDocs start name tipe revArgs =
|
||||
oneOf
|
||||
E.DeclDefEquals
|
||||
@ -92,10 +95,10 @@ chompDefArgsAndBody maybeDocs start name tipe revArgs =
|
||||
do
|
||||
word1 0x3D {-=-} E.DeclDefEquals
|
||||
Space.chompAndCheckIndent E.DeclDefSpace E.DeclDefIndentBody
|
||||
(body, end) <- specialize E.DeclDefBody Expr.expression
|
||||
((body, commentsAfter), end) <- specialize E.DeclDefBody Expr.expression
|
||||
let value = Src.Value name (reverse revArgs) body tipe
|
||||
let avalue = A.at start end value
|
||||
return (Value maybeDocs avalue, end)
|
||||
return ((Value maybeDocs avalue, commentsAfter), end)
|
||||
]
|
||||
|
||||
chompMatchingName :: Name.Name -> Parser E.DeclDef (A.Located Name.Name)
|
||||
@ -115,7 +118,7 @@ chompMatchingName expectedName =
|
||||
|
||||
-- TYPE DECLARATIONS
|
||||
|
||||
typeDecl :: Maybe Src.DocComment -> A.Position -> Space.Parser E.Decl Decl
|
||||
typeDecl :: Maybe Src.DocComment -> A.Position -> Space.Parser E.Decl (Decl, [Src.Comment])
|
||||
typeDecl maybeDocs start =
|
||||
inContext E.DeclType (Keyword.type_ E.DeclStart) $
|
||||
do
|
||||
@ -126,16 +129,17 @@ typeDecl maybeDocs start =
|
||||
do
|
||||
Space.chompAndCheckIndent E.AliasSpace E.AliasIndentEquals
|
||||
(name, args) <- chompAliasNameToEquals
|
||||
(tipe, end) <- specialize E.AliasBody Type.expression
|
||||
((tipe, commentsAfterTipe), end) <- specialize E.AliasBody Type.expression
|
||||
let alias = A.at start end (Src.Alias name args tipe)
|
||||
return (Alias maybeDocs alias, end),
|
||||
return ((Alias maybeDocs alias, commentsAfterTipe), end),
|
||||
specialize E.DT_Union $
|
||||
do
|
||||
(name, args) <- chompCustomNameToEquals
|
||||
(firstVariant, firstEnd) <- Type.variant
|
||||
(variants, end) <- chompVariants [firstVariant] firstEnd
|
||||
let union = A.at start end (Src.Union name args variants)
|
||||
return (Union maybeDocs union, end)
|
||||
let commentsAfter = [] -- TODO: implement this throughout chompVariants and Type.variant
|
||||
return ((Union maybeDocs union, commentsAfter), end)
|
||||
]
|
||||
|
||||
-- TYPE ALIASES
|
||||
@ -198,7 +202,7 @@ chompVariants variants end =
|
||||
|
||||
-- PORT
|
||||
|
||||
portDecl :: Maybe Src.DocComment -> Space.Parser E.Decl Decl
|
||||
portDecl :: Maybe Src.DocComment -> Space.Parser E.Decl (Decl, [Src.Comment])
|
||||
portDecl maybeDocs =
|
||||
inContext E.Port (Keyword.port_ E.DeclStart) $
|
||||
do
|
||||
@ -207,9 +211,9 @@ portDecl maybeDocs =
|
||||
Space.chompAndCheckIndent E.PortSpace E.PortIndentColon
|
||||
word1 0x3A {-:-} E.PortColon
|
||||
Space.chompAndCheckIndent E.PortSpace E.PortIndentType
|
||||
(tipe, end) <- specialize E.PortType Type.expression
|
||||
((tipe, commentsAfterTipe), end) <- specialize E.PortType Type.expression
|
||||
return
|
||||
( Port maybeDocs (Src.Port name tipe),
|
||||
( (Port maybeDocs (Src.Port name tipe), commentsAfterTipe),
|
||||
end
|
||||
)
|
||||
|
||||
|
@ -1,6 +1,7 @@
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
-- Temporary while implementing gren format
|
||||
{-# OPTIONS_GHC -Wno-error=unused-do-bind #-}
|
||||
{-# OPTIONS_GHC -Wno-error=unused-matches #-}
|
||||
|
||||
module Parse.Expression
|
||||
( expression,
|
||||
@ -79,25 +80,25 @@ parenthesizedExpr start@(A.Position row col) =
|
||||
word1 0x29 {-)-} E.ParenthesizedOperatorClose
|
||||
addEnd start (Src.Op op),
|
||||
do
|
||||
(comments2, (expr, end)) <-
|
||||
((expr, commentsAfter), end) <-
|
||||
specialize E.ParenthesizedExpr $
|
||||
do
|
||||
negatedExpr@(A.At (A.Region _ end) _) <- term
|
||||
comments2_ <- Space.chomp E.Space
|
||||
commentsAfterTerm <- Space.chomp E.Space
|
||||
let exprStart = A.Position row (col + 2)
|
||||
let expr = A.at exprStart end (Src.Negate negatedExpr)
|
||||
(,) comments2_ <$> chompExprEnd exprStart (State [] expr [] end)
|
||||
chompExprEnd exprStart (State [] expr [] end commentsAfterTerm)
|
||||
Space.checkIndent end E.ParenthesizedIndentEnd
|
||||
word1 0x29 {-)-} E.ParenthesizedOperatorClose
|
||||
addEnd start (Src.Parens comments1 expr comments2)
|
||||
addEnd start (Src.Parens comments1 expr commentsAfter)
|
||||
]
|
||||
else do
|
||||
word1 0x29 {-)-} E.ParenthesizedOperatorClose
|
||||
addEnd start (Src.Op op),
|
||||
do
|
||||
(expr, _) <- specialize E.ParenthesizedExpr expression
|
||||
((expr, commentsAfter), _) <- specialize E.ParenthesizedExpr expression
|
||||
word1 0x29 {-)-} E.ParenthesizedEnd
|
||||
addEnd start (Src.Parens comments1 expr [])
|
||||
addEnd start (Src.Parens comments1 expr commentsAfter)
|
||||
]
|
||||
|
||||
accessor :: A.Position -> Parser E.Expr Src.Expr
|
||||
@ -145,7 +146,7 @@ array start =
|
||||
oneOf
|
||||
E.ArrayOpen
|
||||
[ do
|
||||
(entry, end) <- specialize E.ArrayExpr expression
|
||||
((entry, commentsAfterEntry), end) <- specialize E.ArrayExpr expression
|
||||
Space.checkIndent end E.ArrayIndentEnd
|
||||
chompArrayEnd start [entry],
|
||||
do
|
||||
@ -160,7 +161,7 @@ chompArrayEnd start entries =
|
||||
[ do
|
||||
word1 0x2C {-,-} E.ArrayEnd
|
||||
Space.chompAndCheckIndent E.ArraySpace E.ArrayIndentExpr
|
||||
(entry, end) <- specialize E.ArrayExpr expression
|
||||
((entry, commentsAfterEntry), end) <- specialize E.ArrayExpr expression
|
||||
Space.checkIndent end E.ArrayIndentEnd
|
||||
chompArrayEnd start (entry : entries),
|
||||
do
|
||||
@ -194,7 +195,7 @@ record start =
|
||||
do
|
||||
word1 0x3D {-=-} E.RecordEquals
|
||||
Space.chompAndCheckIndent E.RecordSpace E.RecordIndentExpr
|
||||
(value, end) <- specialize E.RecordExpr expression
|
||||
((value, commentsAfterValue), end) <- specialize E.RecordExpr expression
|
||||
Space.checkIndent end E.RecordIndentEnd
|
||||
case expr of
|
||||
A.At exprRegion (Src.Var Src.LowVar name) -> do
|
||||
@ -229,13 +230,13 @@ chompField =
|
||||
Space.chompAndCheckIndent E.RecordSpace E.RecordIndentEquals
|
||||
word1 0x3D {-=-} E.RecordEquals
|
||||
Space.chompAndCheckIndent E.RecordSpace E.RecordIndentExpr
|
||||
(value, end) <- specialize E.RecordExpr expression
|
||||
((value, commentsAfter), end) <- specialize E.RecordExpr expression
|
||||
Space.checkIndent end E.RecordIndentEnd
|
||||
return (key, value)
|
||||
|
||||
-- EXPRESSIONS
|
||||
|
||||
expression :: Space.Parser E.Expr Src.Expr
|
||||
expression :: Space.Parser E.Expr (Src.Expr, [Src.Comment])
|
||||
expression =
|
||||
do
|
||||
start <- getPosition
|
||||
@ -248,27 +249,28 @@ expression =
|
||||
do
|
||||
expr <- possiblyNegativeTerm start
|
||||
end <- getPosition
|
||||
Space.chomp E.Space
|
||||
chompExprEnd start (State [] expr [] end)
|
||||
commentsAfter <- Space.chomp E.Space
|
||||
chompExprEnd start (State [] expr [] end commentsAfter)
|
||||
]
|
||||
|
||||
data State = State
|
||||
{ _ops :: ![(Src.Expr, A.Located Name.Name)],
|
||||
{ _ops :: ![(Src.Expr, [Src.Comment], A.Located Name.Name)],
|
||||
_expr :: !Src.Expr,
|
||||
_args :: ![Src.Expr],
|
||||
_end :: !A.Position
|
||||
_args :: ![([Src.Comment], Src.Expr)],
|
||||
_end :: !A.Position,
|
||||
_commentsAfter :: [Src.Comment]
|
||||
}
|
||||
|
||||
chompExprEnd :: A.Position -> State -> Space.Parser E.Expr Src.Expr
|
||||
chompExprEnd start (State ops expr args end) =
|
||||
chompExprEnd :: A.Position -> State -> Space.Parser E.Expr (Src.Expr, [Src.Comment])
|
||||
chompExprEnd start (State ops expr args end commentsBefore) =
|
||||
oneOfWithFallback
|
||||
[ -- argument
|
||||
do
|
||||
Space.checkIndent end E.Start
|
||||
arg <- term
|
||||
newEnd <- getPosition
|
||||
Space.chomp E.Space
|
||||
chompExprEnd start (State ops expr (arg : args) newEnd),
|
||||
commentsAfter <- Space.chomp E.Space
|
||||
chompExprEnd start (State ops expr ((commentsBefore, arg) : args) newEnd commentsAfter),
|
||||
-- operator
|
||||
do
|
||||
Space.checkIndent end E.Start
|
||||
@ -280,9 +282,9 @@ chompExprEnd start (State ops expr args end) =
|
||||
do
|
||||
negatedExpr <- term
|
||||
newEnd <- getPosition
|
||||
Space.chomp E.Space
|
||||
commentsAfter <- Space.chomp E.Space
|
||||
let arg = A.at opStart newEnd (Src.Negate negatedExpr)
|
||||
chompExprEnd start (State ops expr (arg : args) newEnd)
|
||||
chompExprEnd start (State ops expr ((commentsBefore, arg) : args) newEnd commentsAfter)
|
||||
else
|
||||
let err = E.OperatorRight opName
|
||||
in oneOf
|
||||
@ -291,12 +293,12 @@ chompExprEnd start (State ops expr args end) =
|
||||
do
|
||||
newExpr <- possiblyNegativeTerm newStart
|
||||
newEnd <- getPosition
|
||||
Space.chomp E.Space
|
||||
let newOps = (toCall expr args, op) : ops
|
||||
chompExprEnd start (State newOps newExpr [] newEnd),
|
||||
commentsAfter <- Space.chomp E.Space
|
||||
let newOps = (toCall expr args, commentsBefore, op) : ops
|
||||
chompExprEnd start (State newOps newExpr [] newEnd commentsAfter),
|
||||
-- final term
|
||||
do
|
||||
(newLast, newEnd) <-
|
||||
((newLast, commentsAfter), newEnd) <-
|
||||
oneOf
|
||||
err
|
||||
[ let_ newStart,
|
||||
@ -304,19 +306,21 @@ chompExprEnd start (State ops expr args end) =
|
||||
if_ newStart,
|
||||
function newStart
|
||||
]
|
||||
let newOps = (toCall expr args, op) : ops
|
||||
let newOps = (toCall expr args, commentsBefore, op) : ops
|
||||
let finalExpr = Src.Binops (reverse newOps) newLast
|
||||
return (A.at start newEnd finalExpr, newEnd)
|
||||
return ((A.at start newEnd finalExpr, commentsAfter), newEnd)
|
||||
]
|
||||
]
|
||||
-- done
|
||||
( case ops of
|
||||
[] ->
|
||||
( toCall expr args,
|
||||
( (toCall expr args, commentsBefore),
|
||||
end
|
||||
)
|
||||
_ ->
|
||||
( A.at start end (Src.Binops (reverse ops) (toCall expr args)),
|
||||
( ( A.at start end (Src.Binops (reverse ops) (toCall expr args)),
|
||||
commentsBefore
|
||||
),
|
||||
end
|
||||
)
|
||||
)
|
||||
@ -332,30 +336,30 @@ possiblyNegativeTerm start =
|
||||
term
|
||||
]
|
||||
|
||||
toCall :: Src.Expr -> [Src.Expr] -> Src.Expr
|
||||
toCall :: Src.Expr -> [([Src.Comment], Src.Expr)] -> Src.Expr
|
||||
toCall func revArgs =
|
||||
case revArgs of
|
||||
[] ->
|
||||
func
|
||||
lastArg : _ ->
|
||||
(_, lastArg) : _ ->
|
||||
A.merge func lastArg (Src.Call func (reverse revArgs))
|
||||
|
||||
-- IF EXPRESSION
|
||||
|
||||
if_ :: A.Position -> Space.Parser E.Expr Src.Expr
|
||||
if_ :: A.Position -> Space.Parser E.Expr (Src.Expr, [Src.Comment])
|
||||
if_ start =
|
||||
inContext E.If (Keyword.if_ E.Start) $
|
||||
chompIfEnd start []
|
||||
|
||||
chompIfEnd :: A.Position -> [(Src.Expr, Src.Expr)] -> Space.Parser E.If Src.Expr
|
||||
chompIfEnd :: A.Position -> [(Src.Expr, Src.Expr)] -> Space.Parser E.If (Src.Expr, [Src.Comment])
|
||||
chompIfEnd start branches =
|
||||
do
|
||||
Space.chompAndCheckIndent E.IfSpace E.IfIndentCondition
|
||||
(condition, condEnd) <- specialize E.IfCondition expression
|
||||
((condition, commentsAfterCondition), condEnd) <- specialize E.IfCondition expression
|
||||
Space.checkIndent condEnd E.IfIndentThen
|
||||
Keyword.then_ E.IfThen
|
||||
Space.chompAndCheckIndent E.IfSpace E.IfIndentThenBranch
|
||||
(thenBranch, thenEnd) <- specialize E.IfThenBranch expression
|
||||
((thenBranch, commentsAfterThen), thenEnd) <- specialize E.IfThenBranch expression
|
||||
Space.checkIndent thenEnd E.IfIndentElse
|
||||
Keyword.else_ E.IfElse
|
||||
Space.chompAndCheckIndent E.IfSpace E.IfIndentElseBranch
|
||||
@ -366,14 +370,14 @@ chompIfEnd start branches =
|
||||
Keyword.if_ E.IfElseBranchStart
|
||||
chompIfEnd start newBranches,
|
||||
do
|
||||
(elseBranch, elseEnd) <- specialize E.IfElseBranch expression
|
||||
((elseBranch, commentsAfterElse), elseEnd) <- specialize E.IfElseBranch expression
|
||||
let ifExpr = Src.If (reverse newBranches) elseBranch
|
||||
return (A.at start elseEnd ifExpr, elseEnd)
|
||||
return ((A.at start elseEnd ifExpr, commentsAfterElse), elseEnd)
|
||||
]
|
||||
|
||||
-- LAMBDA EXPRESSION
|
||||
|
||||
function :: A.Position -> Space.Parser E.Expr Src.Expr
|
||||
function :: A.Position -> Space.Parser E.Expr (Src.Expr, [Src.Comment])
|
||||
function start =
|
||||
inContext E.Func (word1 0x5C {-\-} E.Start) $
|
||||
do
|
||||
@ -382,9 +386,9 @@ function start =
|
||||
Space.chompAndCheckIndent E.FuncSpace E.FuncIndentArrow
|
||||
revArgs <- chompArgs [arg]
|
||||
Space.chompAndCheckIndent E.FuncSpace E.FuncIndentBody
|
||||
(body, end) <- specialize E.FuncBody expression
|
||||
((body, commentsAfterBody), end) <- specialize E.FuncBody expression
|
||||
let funcExpr = Src.Lambda (reverse revArgs) body
|
||||
return (A.at start end funcExpr, end)
|
||||
return ((A.at start end funcExpr, commentsAfterBody), end)
|
||||
|
||||
chompArgs :: [Src.Pattern] -> Parser E.Func [Src.Pattern]
|
||||
chompArgs revArgs =
|
||||
@ -401,12 +405,12 @@ chompArgs revArgs =
|
||||
|
||||
-- CASE EXPRESSIONS
|
||||
|
||||
case_ :: A.Position -> Space.Parser E.Expr Src.Expr
|
||||
case_ :: A.Position -> Space.Parser E.Expr (Src.Expr, [Src.Comment])
|
||||
case_ start =
|
||||
inContext E.Case (Keyword.case_ E.Start) $
|
||||
do
|
||||
Space.chompAndCheckIndent E.CaseSpace E.CaseIndentExpr
|
||||
(expr, exprEnd) <- specialize E.CaseExpr expression
|
||||
((expr, commentsAfterExpr), exprEnd) <- specialize E.CaseExpr expression
|
||||
Space.checkIndent exprEnd E.CaseIndentOf
|
||||
Keyword.of_ E.CaseOf
|
||||
Space.chompAndCheckIndent E.CaseSpace E.CaseIndentPattern
|
||||
@ -414,8 +418,9 @@ case_ start =
|
||||
do
|
||||
(firstBranch, firstEnd) <- chompBranch
|
||||
(branches, end) <- chompCaseEnd [firstBranch] firstEnd
|
||||
let commentsAfter = [] -- TODO: once indentation sensitivity for expression and case branch comments is implemented, then there will be additional comments to capture here
|
||||
return
|
||||
( A.at start end (Src.Case expr branches),
|
||||
( (A.at start end (Src.Case expr branches), commentsAfter),
|
||||
end
|
||||
)
|
||||
|
||||
@ -426,7 +431,7 @@ chompBranch =
|
||||
Space.checkIndent patternEnd E.CaseIndentArrow
|
||||
word2 0x2D 0x3E {-->-} E.CaseArrow
|
||||
Space.chompAndCheckIndent E.CaseSpace E.CaseIndentBranch
|
||||
(branchExpr, end) <- specialize E.CaseBranch expression
|
||||
((branchExpr, commentsAfterBranch), end) <- specialize E.CaseBranch expression
|
||||
return ((pattern, branchExpr), end)
|
||||
|
||||
chompCaseEnd :: [(Src.Pattern, Src.Expr)] -> A.Position -> Space.Parser E.Case [(Src.Pattern, Src.Expr)]
|
||||
@ -441,7 +446,7 @@ chompCaseEnd branches end =
|
||||
|
||||
-- LET EXPRESSION
|
||||
|
||||
let_ :: A.Position -> Space.Parser E.Expr Src.Expr
|
||||
let_ :: A.Position -> Space.Parser E.Expr (Src.Expr, [Src.Comment])
|
||||
let_ start =
|
||||
inContext E.Let (Keyword.let_ E.Start) $
|
||||
do
|
||||
@ -457,9 +462,9 @@ let_ start =
|
||||
Space.checkIndent defsEnd E.LetIndentIn
|
||||
Keyword.in_ E.LetIn
|
||||
Space.chompAndCheckIndent E.LetSpace E.LetIndentBody
|
||||
(body, end) <- specialize E.LetBody expression
|
||||
((body, commentsAfter), end) <- specialize E.LetBody expression
|
||||
return
|
||||
( A.at start end (Src.Let defs body),
|
||||
( (A.at start end (Src.Let defs body), commentsAfter),
|
||||
end
|
||||
)
|
||||
|
||||
@ -497,7 +502,7 @@ definition =
|
||||
[ do
|
||||
word1 0x3A {-:-} E.DefEquals
|
||||
Space.chompAndCheckIndent E.DefSpace E.DefIndentType
|
||||
(tipe, _) <- specialize E.DefType Type.expression
|
||||
((tipe, commentsAfterTipe), _) <- specialize E.DefType Type.expression
|
||||
Space.checkAligned E.DefAlignment
|
||||
defName <- chompMatchingName name
|
||||
Space.chompAndCheckIndent E.DefSpace E.DefIndentEquals
|
||||
@ -516,7 +521,7 @@ chompDefArgsAndBody start name tipe revArgs =
|
||||
do
|
||||
word1 0x3D {-=-} E.DefEquals
|
||||
Space.chompAndCheckIndent E.DefSpace E.DefIndentBody
|
||||
(body, end) <- specialize E.DefBody expression
|
||||
((body, commentsAfterBody), end) <- specialize E.DefBody expression
|
||||
return
|
||||
( A.at start end (Src.Define name (reverse revArgs) body tipe),
|
||||
end
|
||||
@ -549,5 +554,5 @@ destructure =
|
||||
Space.chompAndCheckIndent E.DestructSpace E.DestructIndentEquals
|
||||
word1 0x3D {-=-} E.DestructEquals
|
||||
Space.chompAndCheckIndent E.DestructSpace E.DestructIndentBody
|
||||
(expr, end) <- specialize E.DestructBody expression
|
||||
((expr, commentsAfter), end) <- specialize E.DestructBody expression
|
||||
return (A.at start end (Src.Destruct pattern expr), end)
|
||||
|
@ -16,6 +16,7 @@ where
|
||||
import AST.Source qualified as Src
|
||||
import AST.SourceComments qualified as SC
|
||||
import Data.ByteString qualified as BS
|
||||
import Data.List.NonEmpty (NonEmpty, nonEmpty)
|
||||
import Data.Name qualified as Name
|
||||
import Gren.Compiler.Imports qualified as Imports
|
||||
import Gren.Package qualified as Pkg
|
||||
@ -77,15 +78,15 @@ chompModule projectType =
|
||||
|
||||
checkModule :: ProjectType -> Module -> Either E.Error Src.Module
|
||||
checkModule projectType (Module maybeHeader imports infixes decls) =
|
||||
let (values, unions, aliases, ports) = categorizeDecls [] [] [] [] 0 decls
|
||||
let (values, unions, aliases, ports, topLevelComments) = categorizeDecls [] [] [] [] [] 0 decls
|
||||
in case maybeHeader of
|
||||
Just (Header name effects exports docs comments) ->
|
||||
Src.Module (Just name) exports (toDocs docs decls) imports values unions aliases infixes comments
|
||||
Src.Module (Just name) exports (toDocs docs decls) imports values unions aliases infixes topLevelComments comments
|
||||
<$> checkEffects projectType ports effects
|
||||
Nothing ->
|
||||
let comments = SC.HeaderComments [] [] [] [] [] []
|
||||
in Right $
|
||||
Src.Module Nothing (A.At A.one Src.Open) (Src.NoDocs A.one) imports values unions aliases infixes comments $
|
||||
Src.Module Nothing (A.At A.one Src.Open) (Src.NoDocs A.one) imports values unions aliases infixes topLevelComments comments $
|
||||
case ports of
|
||||
[] -> Src.NoEffects
|
||||
_ : _ -> Src.Ports ports (SC.PortsComments [])
|
||||
@ -121,23 +122,26 @@ categorizeDecls ::
|
||||
[(Src.SourceOrder, A.Located Src.Union)] ->
|
||||
[(Src.SourceOrder, A.Located Src.Alias)] ->
|
||||
[(Src.SourceOrder, Src.Port)] ->
|
||||
[(Src.SourceOrder, NonEmpty Src.Comment)] ->
|
||||
Src.SourceOrder ->
|
||||
[Decl.Decl] ->
|
||||
( [(Src.SourceOrder, A.Located Src.Value)],
|
||||
[(Src.SourceOrder, A.Located Src.Union)],
|
||||
[(Src.SourceOrder, A.Located Src.Alias)],
|
||||
[(Src.SourceOrder, Src.Port)]
|
||||
[(Src.SourceOrder, Src.Port)],
|
||||
[(Src.SourceOrder, NonEmpty Src.Comment)]
|
||||
)
|
||||
categorizeDecls values unions aliases ports index decls =
|
||||
categorizeDecls values unions aliases ports topLevelComments index decls =
|
||||
case decls of
|
||||
[] ->
|
||||
(values, unions, aliases, ports)
|
||||
(values, unions, aliases, ports, topLevelComments)
|
||||
decl : otherDecls ->
|
||||
case decl of
|
||||
Decl.Value _ value -> categorizeDecls ((index, value) : values) unions aliases ports (index + 1) otherDecls
|
||||
Decl.Union _ union -> categorizeDecls values ((index, union) : unions) aliases ports (index + 1) otherDecls
|
||||
Decl.Alias _ alias -> categorizeDecls values unions ((index, alias) : aliases) ports (index + 1) otherDecls
|
||||
Decl.Port _ port_ -> categorizeDecls values unions aliases ((index, port_) : ports) (index + 1) otherDecls
|
||||
Decl.Value _ value -> categorizeDecls ((index, value) : values) unions aliases ports topLevelComments (index + 1) otherDecls
|
||||
Decl.Union _ union -> categorizeDecls values ((index, union) : unions) aliases ports topLevelComments (index + 1) otherDecls
|
||||
Decl.Alias _ alias -> categorizeDecls values unions ((index, alias) : aliases) ports topLevelComments (index + 1) otherDecls
|
||||
Decl.Port _ port_ -> categorizeDecls values unions aliases ((index, port_) : ports) topLevelComments (index + 1) otherDecls
|
||||
Decl.TopLevelComments comments -> categorizeDecls values unions aliases ports ((index, comments) : topLevelComments) (index + 1) otherDecls
|
||||
|
||||
-- TO DOCS
|
||||
|
||||
@ -145,21 +149,22 @@ toDocs :: Either A.Region Src.DocComment -> [Decl.Decl] -> Src.Docs
|
||||
toDocs comment decls =
|
||||
case comment of
|
||||
Right overview ->
|
||||
Src.YesDocs overview (getComments decls [])
|
||||
Src.YesDocs overview (getDocComments decls [])
|
||||
Left region ->
|
||||
Src.NoDocs region
|
||||
|
||||
getComments :: [Decl.Decl] -> [(Name.Name, Src.DocComment)] -> [(Name.Name, Src.DocComment)]
|
||||
getComments decls comments =
|
||||
getDocComments :: [Decl.Decl] -> [(Name.Name, Src.DocComment)] -> [(Name.Name, Src.DocComment)]
|
||||
getDocComments decls comments =
|
||||
case decls of
|
||||
[] ->
|
||||
comments
|
||||
decl : otherDecls ->
|
||||
case decl of
|
||||
Decl.Value c (A.At _ (Src.Value n _ _ _)) -> getComments otherDecls (addComment c n comments)
|
||||
Decl.Union c (A.At _ (Src.Union n _ _)) -> getComments otherDecls (addComment c n 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)
|
||||
Decl.Value c (A.At _ (Src.Value n _ _ _)) -> getDocComments otherDecls (addComment c n comments)
|
||||
Decl.Union c (A.At _ (Src.Union n _ _)) -> getDocComments otherDecls (addComment c n comments)
|
||||
Decl.Alias c (A.At _ (Src.Alias n _ _)) -> getDocComments otherDecls (addComment c n comments)
|
||||
Decl.Port c (Src.Port n _) -> getDocComments otherDecls (addComment c n comments)
|
||||
Decl.TopLevelComments _ -> getDocComments otherDecls comments
|
||||
|
||||
addComment :: Maybe Src.DocComment -> A.Located Name.Name -> [(Name.Name, Src.DocComment)] -> [(Name.Name, Src.DocComment)]
|
||||
addComment maybeComment (A.At _ name) comments =
|
||||
@ -181,13 +186,17 @@ freshLine toFreshLineError =
|
||||
chompDecls :: [Decl.Decl] -> Parser E.Decl [Decl.Decl]
|
||||
chompDecls decls =
|
||||
do
|
||||
(decl, _) <- Decl.declaration
|
||||
((decl, commentsAfterDecl), _) <- Decl.declaration
|
||||
let newDecls =
|
||||
case nonEmpty commentsAfterDecl of
|
||||
Nothing -> decl : decls
|
||||
Just comments -> Decl.TopLevelComments comments : decl : decls
|
||||
oneOfWithFallback
|
||||
[ do
|
||||
Space.checkFreshLine E.DeclStart
|
||||
chompDecls (decl : decls)
|
||||
chompDecls newDecls
|
||||
]
|
||||
(reverse (decl : decls))
|
||||
(reverse newDecls)
|
||||
|
||||
chompInfixes :: [A.Located Src.Infix] -> Parser E.Module [A.Located Src.Infix]
|
||||
chompInfixes infixes =
|
||||
|
@ -1,6 +1,7 @@
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
-- Temporary while implementing gren format
|
||||
{-# OPTIONS_GHC -Wno-error=unused-do-bind #-}
|
||||
{-# OPTIONS_GHC -Wno-error=unused-matches #-}
|
||||
|
||||
module Parse.Type
|
||||
( expression,
|
||||
@ -43,8 +44,8 @@ term =
|
||||
-- parenthesis
|
||||
inContext E.TParenthesis (word1 0x28 {-(-} E.TStart) $
|
||||
do
|
||||
Space.chompAndCheckIndent E.TParenthesisSpace E.TParenthesisIndentOpen
|
||||
(tipe, end) <- specialize E.TParenthesisType expression
|
||||
commentsBeforeOpeningParen <- Space.chompAndCheckIndent E.TParenthesisSpace E.TParenthesisIndentOpen
|
||||
((tipe, commentsBeforeClosingParen), end) <- specialize E.TParenthesisType expression
|
||||
Space.checkIndent end E.TParenthesisIndentEnd
|
||||
word1 0x29 {-)-} E.TParenthesisEnd
|
||||
return tipe,
|
||||
@ -71,7 +72,7 @@ term =
|
||||
do
|
||||
word1 0x3A {-:-} E.TRecordColon
|
||||
Space.chompAndCheckIndent E.TRecordSpace E.TRecordIndentType
|
||||
(tipe, end) <- specialize E.TRecordType expression
|
||||
((tipe, commentsAfterTipe), end) <- specialize E.TRecordType expression
|
||||
Space.checkIndent end E.TRecordIndentEnd
|
||||
fields <- chompRecordEnd [(name, tipe)]
|
||||
addEnd start (Src.TRecord fields Nothing)
|
||||
@ -81,39 +82,39 @@ term =
|
||||
|
||||
-- TYPE EXPRESSIONS
|
||||
|
||||
expression :: Space.Parser E.Type Src.Type
|
||||
expression :: Space.Parser E.Type (Src.Type, [Src.Comment])
|
||||
expression =
|
||||
do
|
||||
start <- getPosition
|
||||
term1@(tipe1, end1) <-
|
||||
term1@((tipe1, commentsBeforeArrow), end1) <-
|
||||
oneOf
|
||||
E.TStart
|
||||
[ app start,
|
||||
do
|
||||
eterm <- term
|
||||
end <- getPosition
|
||||
Space.chomp E.TSpace
|
||||
return (eterm, end)
|
||||
commentsAfter <- Space.chomp E.TSpace
|
||||
return ((eterm, commentsAfter), end)
|
||||
]
|
||||
oneOfWithFallback
|
||||
[ do
|
||||
Space.checkIndent end1 E.TIndentStart -- should never trigger
|
||||
word2 0x2D 0x3E {-->-} E.TStart -- could just be another type instead
|
||||
Space.chompAndCheckIndent E.TSpace E.TIndentStart
|
||||
(tipe2, end2) <- expression
|
||||
commentsAfterArrow <- Space.chompAndCheckIndent E.TSpace E.TIndentStart
|
||||
((tipe2, commentsAfter), end2) <- expression
|
||||
let tipe = A.at start end2 (Src.TLambda tipe1 tipe2)
|
||||
return (tipe, end2)
|
||||
return ((tipe, commentsAfter), end2)
|
||||
]
|
||||
term1
|
||||
|
||||
-- TYPE CONSTRUCTORS
|
||||
|
||||
app :: A.Position -> Space.Parser E.Type Src.Type
|
||||
app :: A.Position -> Space.Parser E.Type (Src.Type, [Src.Comment])
|
||||
app start =
|
||||
do
|
||||
upper <- Var.foreignUpper E.TStart
|
||||
upperEnd <- getPosition
|
||||
Space.chomp E.TSpace
|
||||
commentsAfter <- Space.chomp E.TSpace
|
||||
(args, end) <- chompArgs [] upperEnd
|
||||
|
||||
let region = A.Region start upperEnd
|
||||
@ -124,7 +125,7 @@ app start =
|
||||
Var.Qualified home name ->
|
||||
Src.TTypeQual region home name args
|
||||
|
||||
return (A.at start end tipe, end)
|
||||
return ((A.at start end tipe, commentsAfter), end)
|
||||
|
||||
chompArgs :: [Src.Type] -> A.Position -> Space.Parser E.Type [Src.Type]
|
||||
chompArgs args end =
|
||||
@ -163,7 +164,7 @@ chompField =
|
||||
Space.chompAndCheckIndent E.TRecordSpace E.TRecordIndentColon
|
||||
word1 0x3A {-:-} E.TRecordColon
|
||||
Space.chompAndCheckIndent E.TRecordSpace E.TRecordIndentType
|
||||
(tipe, end) <- specialize E.TRecordType expression
|
||||
((tipe, commentsAfterTipe), end) <- specialize E.TRecordType expression
|
||||
Space.checkIndent end E.TRecordIndentEnd
|
||||
return (name, tipe)
|
||||
|
||||
|
@ -66,7 +66,7 @@ fromNames names =
|
||||
-- FROM MODULE
|
||||
|
||||
fromModule :: Src.Module -> Localizer
|
||||
fromModule modul@(Src.Module _ _ _ imports _ _ _ _ _ _) =
|
||||
fromModule modul@(Src.Module _ _ _ imports _ _ _ _ _ _ _) =
|
||||
Localizer $
|
||||
Map.fromList $
|
||||
(Src.getName modul, Import Nothing All) : map toPair imports
|
||||
|
@ -280,12 +280,13 @@ attemptDeclOrExpr lines =
|
||||
exprParser = P.specialize (toExprPosition src) PE.expression
|
||||
declParser = P.specialize (toDeclPosition src) PD.declaration
|
||||
in case P.fromByteString declParser (,) src of
|
||||
Right (decl, _) ->
|
||||
Right ((decl, _), _) ->
|
||||
case decl of
|
||||
PD.Value _ (A.At _ (Src.Value (A.At _ name) _ _ _)) -> ifDone lines (Decl name src)
|
||||
PD.Union _ (A.At _ (Src.Union (A.At _ name) _ _)) -> ifDone lines (Type name src)
|
||||
PD.Alias _ (A.At _ (Src.Alias (A.At _ name) _ _)) -> ifDone lines (Type name src)
|
||||
PD.Port _ _ -> Done Port
|
||||
PD.TopLevelComments _ -> Done Skip
|
||||
Left declPosition
|
||||
| startsWithKeyword "type" lines ->
|
||||
ifFail lines (Type "ERR" src)
|
||||
|
@ -13,7 +13,7 @@ import Parse.Space qualified as Space
|
||||
import Reporting.Annotation qualified as A
|
||||
import Test.Hspec qualified as Hspec
|
||||
|
||||
checkParse :: (Show error, Show target) => Space.Parser error (A.Located target) -> (P.Row -> P.Col -> error) -> (Either error (A.Located target, A.Position) -> Bool) -> BS.ByteString -> IO ()
|
||||
checkParse :: (Show error, Show target) => Space.Parser error target -> (P.Row -> P.Col -> error) -> (Either error (target, A.Position) -> Bool) -> BS.ByteString -> IO ()
|
||||
checkParse parser toBadEnd checkResult str =
|
||||
Hspec.shouldSatisfy
|
||||
(P.fromByteString parser toBadEnd str)
|
||||
@ -29,7 +29,7 @@ checkSuccessfulParse parser toBadEnd checkTarget =
|
||||
False
|
||||
in checkParse parser toBadEnd checkResult
|
||||
|
||||
checkParseError :: (Show error, Show target) => Space.Parser error (A.Located target) -> (P.Row -> P.Col -> error) -> (error -> Bool) -> BS.ByteString -> IO ()
|
||||
checkParseError :: (Show error, Show target) => Space.Parser error target -> (P.Row -> P.Col -> error) -> (error -> Bool) -> BS.ByteString -> IO ()
|
||||
checkParseError parser toBadEnd checkError =
|
||||
let checkResult result =
|
||||
case result of
|
||||
|
@ -133,6 +133,40 @@ spec = do
|
||||
`shouldFormatModuleBodyAs` [ "f =",
|
||||
" {}"
|
||||
]
|
||||
it "formats comments between top-level definitions" $
|
||||
[ "module Main exposing (..)",
|
||||
"import Html",
|
||||
"f = {}",
|
||||
"-- B",
|
||||
"g = {}",
|
||||
"-- C",
|
||||
"h = {}"
|
||||
]
|
||||
`shouldFormatAs` [ "module Main exposing (..)",
|
||||
"",
|
||||
"import Html",
|
||||
"",
|
||||
"",
|
||||
"f =",
|
||||
" {}",
|
||||
"",
|
||||
"",
|
||||
"",
|
||||
"-- B",
|
||||
"",
|
||||
"",
|
||||
"g =",
|
||||
" {}",
|
||||
"",
|
||||
"",
|
||||
"",
|
||||
"-- C",
|
||||
"",
|
||||
"",
|
||||
"h =",
|
||||
" {}"
|
||||
]
|
||||
|
||||
describe "expressions" $ do
|
||||
describe "record" $ do
|
||||
describe "empty" $ do
|
||||
|
@ -53,10 +53,10 @@ parse str =
|
||||
)
|
||||
`shouldSatisfy` isUpdateExpr
|
||||
|
||||
isUpdateExpr :: Either x (Src.Expr, A.Position) -> Bool
|
||||
isUpdateExpr :: Either x ((Src.Expr, [Src.Comment]), A.Position) -> Bool
|
||||
isUpdateExpr result =
|
||||
case result of
|
||||
Right (A.At _ (Src.Update _ _), _) -> True
|
||||
Right ((A.At _ (Src.Update _ _), _), _) -> True
|
||||
_ -> False
|
||||
|
||||
--
|
||||
@ -70,8 +70,8 @@ parseRecordLiteral str =
|
||||
)
|
||||
`shouldSatisfy` isRecordLiteral
|
||||
|
||||
isRecordLiteral :: Either x (Src.Expr, A.Position) -> Bool
|
||||
isRecordLiteral :: Either x ((Src.Expr, [Src.Comment]), A.Position) -> Bool
|
||||
isRecordLiteral result =
|
||||
case result of
|
||||
Right (A.At _ (Src.Record _), _) -> True
|
||||
Right ((A.At _ (Src.Record _), _), _) -> True
|
||||
_ -> False
|
||||
|
Loading…
Reference in New Issue
Block a user