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