mirror of
https://github.com/gren-lang/compiler.git
synced 2024-09-11 16:56:29 +03:00
Merge pull request #161 from avh4/retain-comments/7-expressions
format: retain comments in remaining expressions
This commit is contained in:
commit
3182e17a00
@ -9,6 +9,7 @@ module AST.Source
|
||||
Expr_ (..),
|
||||
VarType (..),
|
||||
ArrayEntry,
|
||||
BinopsSegment,
|
||||
IfBranch,
|
||||
CaseBranch,
|
||||
RecordField,
|
||||
@ -66,7 +67,7 @@ data Expr_
|
||||
| Array [ArrayEntry]
|
||||
| Op Name
|
||||
| Negate Expr
|
||||
| Binops [(Expr, [Comment], A.Located Name)] Expr
|
||||
| Binops [BinopsSegment] Expr
|
||||
| Lambda [([Comment], Pattern)] Expr SC.LambdaComments
|
||||
| Call Expr [([Comment], Expr)]
|
||||
| If [IfBranch] Expr SC.IfComments
|
||||
@ -85,6 +86,9 @@ data VarType = LowVar | CapVar
|
||||
type ArrayEntry =
|
||||
(Expr, SC.ArrayEntryComments)
|
||||
|
||||
type BinopsSegment =
|
||||
(Expr, A.Located Name, SC.BinopsSegmentComments)
|
||||
|
||||
type IfBranch =
|
||||
(Expr, Expr, SC.IfBranchComments)
|
||||
|
||||
@ -97,8 +101,8 @@ type RecordField =
|
||||
-- DEFINITIONS
|
||||
|
||||
data Def
|
||||
= Define (A.Located Name) [([Comment], Pattern)] Expr (Maybe Type) SC.ValueComments
|
||||
| Destruct Pattern Expr
|
||||
= Define (A.Located Name) [([Comment], Pattern)] Expr (Maybe (Type, SC.ValueTypeComments)) SC.ValueComments
|
||||
| Destruct Pattern Expr SC.ValueComments
|
||||
deriving (Show)
|
||||
|
||||
-- PATTERN
|
||||
@ -180,7 +184,7 @@ data Import = Import
|
||||
}
|
||||
deriving (Show)
|
||||
|
||||
data Value = Value (A.Located Name) [([Comment], Pattern)] Expr (Maybe Type) SC.ValueComments
|
||||
data Value = Value (A.Located Name) [([Comment], Pattern)] Expr (Maybe (Type, SC.ValueTypeComments)) SC.ValueComments
|
||||
deriving (Show)
|
||||
|
||||
data Union = Union (A.Located Name) [A.Located Name] [(A.Located Name, [([Comment], Type)])]
|
||||
|
@ -87,8 +87,21 @@ data ValueComments = ValueComments
|
||||
}
|
||||
deriving (Show)
|
||||
|
||||
data ValueTypeComments = ValueTypeComments
|
||||
{ _beforeTypeColon :: [Comment],
|
||||
_afterTypeColon :: [Comment],
|
||||
_afterValueType :: [Comment]
|
||||
}
|
||||
deriving (Show)
|
||||
|
||||
-- Expressions
|
||||
|
||||
data BinopsSegmentComments = BinopsSegmentComments
|
||||
{ _beforeOperator :: [Comment],
|
||||
_afterOperator :: [Comment]
|
||||
}
|
||||
deriving (Show)
|
||||
|
||||
data ArrayEntryComments = ArrayEntryComments
|
||||
{ _beforeArrayEntry :: [Comment],
|
||||
_afterArrayEntry :: [Comment]
|
||||
|
@ -149,9 +149,9 @@ canonicalizeCaseBranch env (pattern, expr, _) =
|
||||
|
||||
-- CANONICALIZE BINOPS
|
||||
|
||||
canonicalizeBinops :: A.Region -> Env.Env -> [(Src.Expr, [Src.Comment], A.Located Name.Name)] -> Src.Expr -> Result FreeLocals [W.Warning] Can.Expr
|
||||
canonicalizeBinops :: A.Region -> Env.Env -> [Src.BinopsSegment] -> 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
|
||||
@ -233,7 +233,7 @@ addBindings bindings (A.At _ def) =
|
||||
case def of
|
||||
Src.Define (A.At region name) _ _ _ _ ->
|
||||
Dups.insert name region region bindings
|
||||
Src.Destruct pattern _ ->
|
||||
Src.Destruct pattern _ _ ->
|
||||
addBindingsHelp bindings pattern
|
||||
|
||||
addBindingsHelp :: Dups.Dict A.Region -> Src.Pattern -> Dups.Dict A.Region
|
||||
@ -291,7 +291,7 @@ addDefNodes env nodes (A.At _ def) =
|
||||
let cdef = Can.Def aname args cbody
|
||||
let node = (Define cdef, name, Map.keys freeLocals)
|
||||
logLetLocals args freeLocals (node : nodes)
|
||||
Just tipe ->
|
||||
Just (tipe, _) ->
|
||||
do
|
||||
(Can.Forall freeVars ctipe) <- Type.toAnnotation env tipe
|
||||
((args, resultType), argBindings) <-
|
||||
@ -307,7 +307,7 @@ addDefNodes env nodes (A.At _ def) =
|
||||
let cdef = Can.TypedDef aname freeVars args cbody resultType
|
||||
let node = (Define cdef, name, Map.keys freeLocals)
|
||||
logLetLocals args freeLocals (node : nodes)
|
||||
Src.Destruct pattern body ->
|
||||
Src.Destruct pattern body _ ->
|
||||
do
|
||||
(cpattern, _bindings) <-
|
||||
Pattern.verify Error.DPDestruct $
|
||||
|
@ -141,7 +141,7 @@ toNodeOne env (A.At _ (Src.Value aname@(A.At _ name) srcArgs body maybeType _))
|
||||
name,
|
||||
Map.keys freeLocals
|
||||
)
|
||||
Just srcType ->
|
||||
Just (srcType, _) ->
|
||||
do
|
||||
(Can.Forall freeVars tipe) <- Type.toAnnotation env srcType
|
||||
|
||||
|
@ -405,9 +405,9 @@ formatAssociativity = \case
|
||||
|
||||
formatValue :: Src.Value -> Block
|
||||
formatValue (Src.Value name args body type_ comments) =
|
||||
formatBasicDef (A.toValue name) args (A.toValue body) (fmap A.toValue type_) comments
|
||||
formatBasicDef (A.toValue name) args (A.toValue body) type_ comments
|
||||
|
||||
formatBasicDef :: Name -> [([Src.Comment], Src.Pattern)] -> Src.Expr_ -> Maybe Src.Type_ -> SC.ValueComments -> Block
|
||||
formatBasicDef :: Name -> [([Src.Comment], Src.Pattern)] -> Src.Expr_ -> Maybe (Src.Type, SC.ValueTypeComments) -> SC.ValueComments -> Block
|
||||
formatBasicDef name args body type_ (SC.ValueComments commentsBeforeEquals commentsBeforeBody commentsAfterBody) =
|
||||
Block.stack $
|
||||
NonEmpty.fromList $
|
||||
@ -432,11 +432,19 @@ formatBasicDef name args body type_ (SC.ValueComments commentsBeforeEquals comme
|
||||
patternParensProtectSpaces $
|
||||
formatPattern (A.toValue pat)
|
||||
|
||||
formatTypeAnnotation :: Maybe String -> Name -> Src.Type_ -> Block
|
||||
formatTypeAnnotation prefix name t =
|
||||
spaceOrIndent
|
||||
[ Block.line $ withPrefix $ utf8 name <> Block.space <> Block.char7 ':',
|
||||
typeParensNone $ formatType t
|
||||
formatTypeAnnotation :: Maybe String -> Name -> (Src.Type, SC.ValueTypeComments) -> Block
|
||||
formatTypeAnnotation prefix name (t, SC.ValueTypeComments commentsBeforeColon commentsAfterColon commentsAfterType) =
|
||||
spaceOrIndent $
|
||||
[ spaceOrStack $
|
||||
NonEmpty.fromList $
|
||||
catMaybes
|
||||
[ Just $ Block.line $ withPrefix $ utf8 name,
|
||||
formatCommentBlock commentsBeforeColon,
|
||||
Just $ Block.line $ Block.char7 ':'
|
||||
],
|
||||
withCommentsAround commentsAfterColon commentsAfterType $
|
||||
typeParensNone $
|
||||
formatType (A.toValue t)
|
||||
]
|
||||
where
|
||||
withPrefix a =
|
||||
@ -486,7 +494,7 @@ formatAlias (Src.Alias name args type_) =
|
||||
formatPort :: Src.Port -> Block
|
||||
formatPort = \case
|
||||
Src.Port name type_ ->
|
||||
formatTypeAnnotation (Just "port") (A.toValue name) (A.toValue type_)
|
||||
formatTypeAnnotation (Just "port") (A.toValue name) (type_, SC.ValueTypeComments [] [] [])
|
||||
|
||||
data ExpressionBlock
|
||||
= NoExpressionParens Block
|
||||
@ -566,17 +574,21 @@ formatExpr = \case
|
||||
in ExpressionContainsInfixOps $
|
||||
spaceOrIndentForce forceMultiline $
|
||||
exprParensProtectInfixOps (formatExpr $ A.toValue first)
|
||||
:| fmap formatPair rest
|
||||
:| fmap formatSegment rest
|
||||
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 . opFromPair) postfixOps
|
||||
opFromPair (_, _, name) = A.toValue name
|
||||
formatPair (commentsBeforeOp, op, expr) =
|
||||
Block.prefix
|
||||
4
|
||||
(utf8 (A.toValue op) <> Block.space)
|
||||
(exprParensProtectInfixOps $ formatExpr $ A.toValue expr)
|
||||
forceMultiline = any (opForcesMultiline . opFromSegment) postfixOps
|
||||
opFromSegment (_, name, _) = A.toValue name
|
||||
formatSegment (op, SC.BinopsSegmentComments commentsBeforeOp commentsAfterOp, expr) =
|
||||
withCommentsBefore commentsBeforeOp $
|
||||
Block.prefix
|
||||
4
|
||||
(utf8 (A.toValue op) <> Block.space)
|
||||
( withCommentsBefore commentsAfterOp $
|
||||
exprParensProtectInfixOps $
|
||||
formatExpr (A.toValue expr)
|
||||
)
|
||||
Src.Lambda [] body _ ->
|
||||
formatExpr $ A.toValue body
|
||||
Src.Lambda (arg1 : args) body (SC.LambdaComments commentsBeforeArrow commentsAfterArrow) ->
|
||||
@ -609,7 +621,8 @@ formatExpr = \case
|
||||
:| fmap formatArg args
|
||||
where
|
||||
formatArg (commentsBefore, arg) =
|
||||
exprParensProtectSpaces (formatExpr $ A.toValue arg)
|
||||
withCommentsBefore commentsBefore $
|
||||
exprParensProtectSpaces (formatExpr $ A.toValue arg)
|
||||
Src.If [] else_ _ ->
|
||||
formatExpr $ A.toValue else_
|
||||
Src.If (if_ : elseifs) else_ (SC.IfComments commentsBeforeElseBody commentsAfterElseBody) ->
|
||||
@ -765,14 +778,19 @@ formatDef (commentsBefore, def) =
|
||||
withCommentsStackBefore commentsBefore $
|
||||
case A.toValue def of
|
||||
Src.Define name args body ann comments ->
|
||||
formatBasicDef (A.toValue name) args (A.toValue body) (fmap A.toValue ann) comments
|
||||
Src.Destruct pat body ->
|
||||
formatBasicDef (A.toValue name) args (A.toValue body) ann comments
|
||||
Src.Destruct pat body (SC.ValueComments commentsBeforeEquals commentsBeforeBody commentsAfterBody) ->
|
||||
Block.stack
|
||||
[ spaceOrIndent
|
||||
[ patternParensProtectSpaces $ formatPattern $ A.toValue pat,
|
||||
[ withCommentsAround [] commentsBeforeEquals $
|
||||
patternParensProtectSpaces $
|
||||
formatPattern (A.toValue pat),
|
||||
Block.line $ Block.char7 '='
|
||||
],
|
||||
Block.indent $ exprParensNone $ formatExpr $ A.toValue body
|
||||
Block.indent $
|
||||
withCommentsStackAround commentsBeforeBody commentsAfterBody $
|
||||
exprParensNone $
|
||||
formatExpr (A.toValue body)
|
||||
]
|
||||
|
||||
data TypeBlock
|
||||
|
@ -79,16 +79,17 @@ valueDecl maybeDocs start =
|
||||
[ do
|
||||
word1 0x3A {-:-} E.DeclDefEquals
|
||||
let commentsBeforeColon = commentsAfterName
|
||||
Space.chompAndCheckIndent E.DeclDefSpace E.DeclDefIndentType
|
||||
commentsAfterColon <- Space.chompAndCheckIndent E.DeclDefSpace E.DeclDefIndentType
|
||||
((tipe, commentsAfterTipe), _) <- specialize E.DeclDefType Type.expression
|
||||
Space.checkFreshLine E.DeclDefNameRepeat
|
||||
defName <- chompMatchingName name
|
||||
commentsAfterMatchingName <- Space.chompAndCheckIndent E.DeclDefSpace E.DeclDefIndentEquals
|
||||
chompDefArgsAndBody maybeDocs start defName (Just tipe) [] commentsAfterMatchingName,
|
||||
let tipeComments = SC.ValueTypeComments commentsBeforeColon commentsAfterColon commentsAfterTipe
|
||||
chompDefArgsAndBody maybeDocs start defName (Just (tipe, tipeComments)) [] commentsAfterMatchingName,
|
||||
chompDefArgsAndBody maybeDocs start (A.at start end name) Nothing [] commentsAfterName
|
||||
]
|
||||
|
||||
chompDefArgsAndBody :: Maybe Src.DocComment -> A.Position -> A.Located Name.Name -> Maybe Src.Type -> [([Src.Comment], Src.Pattern)] -> [Src.Comment] -> Space.Parser E.DeclDef (Decl, [Src.Comment])
|
||||
chompDefArgsAndBody :: Maybe Src.DocComment -> A.Position -> A.Located Name.Name -> Maybe (Src.Type, SC.ValueTypeComments) -> [([Src.Comment], Src.Pattern)] -> [Src.Comment] -> Space.Parser E.DeclDef (Decl, [Src.Comment])
|
||||
chompDefArgsAndBody maybeDocs start name tipe revArgs commentsBefore =
|
||||
oneOf
|
||||
E.DeclDefEquals
|
||||
|
@ -1,8 +1,4 @@
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
-- Temporary while implementing gren format
|
||||
{-# OPTIONS_GHC -Wno-error=unused-do-bind #-}
|
||||
{-# OPTIONS_GHC -Wno-error=unused-local-binds #-}
|
||||
{-# OPTIONS_GHC -Wno-error=unused-matches #-}
|
||||
|
||||
module Parse.Expression
|
||||
( expression,
|
||||
@ -265,7 +261,7 @@ expression =
|
||||
]
|
||||
|
||||
data State = State
|
||||
{ _ops :: ![(Src.Expr, [Src.Comment], A.Located Name.Name)],
|
||||
{ _ops :: ![Src.BinopsSegment],
|
||||
_expr :: !Src.Expr,
|
||||
_args :: ![([Src.Comment], Src.Expr)],
|
||||
_end :: !A.Position,
|
||||
@ -286,7 +282,7 @@ chompExprEnd start (State ops expr args end commentsBefore) =
|
||||
do
|
||||
Space.checkIndent end E.Start
|
||||
op@(A.At (A.Region opStart opEnd) opName) <- addLocation (Symbol.operator E.Start E.OperatorReserved)
|
||||
Space.chompAndCheckIndent E.Space (E.IndentOperatorRight opName)
|
||||
commentsAfterOp <- Space.chompAndCheckIndent E.Space (E.IndentOperatorRight opName)
|
||||
newStart <- getPosition
|
||||
if "-" == opName && end /= opStart && opEnd == newStart
|
||||
then -- negative terms
|
||||
@ -298,6 +294,7 @@ chompExprEnd start (State ops expr args end commentsBefore) =
|
||||
chompExprEnd start (State ops expr ((commentsBefore, arg) : args) newEnd commentsAfter)
|
||||
else
|
||||
let err = E.OperatorRight opName
|
||||
opComments = SC.BinopsSegmentComments commentsBefore commentsAfterOp
|
||||
in oneOf
|
||||
err
|
||||
[ -- term
|
||||
@ -305,7 +302,7 @@ chompExprEnd start (State ops expr args end commentsBefore) =
|
||||
newExpr <- possiblyNegativeTerm newStart
|
||||
newEnd <- getPosition
|
||||
commentsAfter <- Space.chomp E.Space
|
||||
let newOps = (toCall expr args, commentsBefore, op) : ops
|
||||
let newOps = (toCall expr args, op, opComments) : ops
|
||||
chompExprEnd start (State newOps newExpr [] newEnd commentsAfter),
|
||||
-- final term
|
||||
do
|
||||
@ -317,7 +314,7 @@ chompExprEnd start (State ops expr args end commentsBefore) =
|
||||
if_ newStart,
|
||||
function newStart
|
||||
]
|
||||
let newOps = (toCall expr args, commentsBefore, op) : ops
|
||||
let newOps = (toCall expr args, op, opComments) : ops
|
||||
let finalExpr = Src.Binops (reverse newOps) newLast
|
||||
return ((A.at start newEnd finalExpr, commentsAfter), newEnd)
|
||||
]
|
||||
@ -521,17 +518,17 @@ definition =
|
||||
E.DefEquals
|
||||
[ do
|
||||
word1 0x3A {-:-} E.DefEquals
|
||||
let commentsBeforeColon = commentsAfterName
|
||||
Space.chompAndCheckIndent E.DefSpace E.DefIndentType
|
||||
commentsAfterColon <- Space.chompAndCheckIndent E.DefSpace E.DefIndentType
|
||||
((tipe, commentsAfterTipe), _) <- specialize E.DefType Type.expression
|
||||
Space.checkAligned E.DefAlignment
|
||||
defName <- chompMatchingName name
|
||||
commentsAfterMatchingName <- Space.chompAndCheckIndent E.DefSpace E.DefIndentEquals
|
||||
chompDefArgsAndBody start defName (Just tipe) [] commentsAfterMatchingName,
|
||||
let tipeComments = SC.ValueTypeComments commentsAfterName commentsAfterColon commentsAfterTipe
|
||||
chompDefArgsAndBody start defName (Just (tipe, tipeComments)) [] commentsAfterMatchingName,
|
||||
chompDefArgsAndBody start aname Nothing [] commentsAfterName
|
||||
]
|
||||
|
||||
chompDefArgsAndBody :: A.Position -> A.Located Name.Name -> Maybe Src.Type -> [([Src.Comment], Src.Pattern)] -> [Src.Comment] -> Space.Parser E.Def (A.Located Src.Def, [Src.Comment])
|
||||
chompDefArgsAndBody :: A.Position -> A.Located Name.Name -> Maybe (Src.Type, SC.ValueTypeComments) -> [([Src.Comment], Src.Pattern)] -> [Src.Comment] -> Space.Parser E.Def (A.Located Src.Def, [Src.Comment])
|
||||
chompDefArgsAndBody start@(A.Position _ startCol) name tipe revArgs commentsBefore =
|
||||
oneOf
|
||||
E.DefEquals
|
||||
@ -572,10 +569,12 @@ destructure :: Space.Parser E.Let (A.Located Src.Def, [Src.Comment])
|
||||
destructure =
|
||||
specialize E.LetDestruct $
|
||||
do
|
||||
start <- getPosition
|
||||
start@(A.Position _ startCol) <- getPosition
|
||||
pattern <- specialize E.DestructPattern Pattern.term
|
||||
Space.chompAndCheckIndent E.DestructSpace E.DestructIndentEquals
|
||||
commentsAfterPattern <- Space.chompAndCheckIndent E.DestructSpace E.DestructIndentEquals
|
||||
word1 0x3D {-=-} E.DestructEquals
|
||||
Space.chompAndCheckIndent E.DestructSpace E.DestructIndentBody
|
||||
commentsAfterEquals <- Space.chompAndCheckIndent E.DestructSpace E.DestructIndentBody
|
||||
((expr, commentsAfter), end) <- specialize E.DestructBody expression
|
||||
return ((A.at start end (Src.Destruct pattern expr), commentsAfter), end)
|
||||
let (commentsAfterBody, commentsAfterDef) = List.span (A.isIndentedMoreThan startCol) commentsAfter
|
||||
let comments = SC.ValueComments commentsAfterPattern commentsAfterEquals commentsAfterBody
|
||||
return ((A.at start end (Src.Destruct pattern expr comments), commentsAfterDef), end)
|
||||
|
@ -126,7 +126,7 @@ spec = do
|
||||
formattedModuleBody
|
||||
]
|
||||
|
||||
describe "top-level definition" $ do
|
||||
describe "top-level definitions" $ do
|
||||
it "formats already formatted" $
|
||||
assertFormattedModuleBody
|
||||
[ "f x =",
|
||||
@ -281,14 +281,23 @@ spec = do
|
||||
" {- D -}",
|
||||
" []"
|
||||
]
|
||||
it "formats indented comments after the body" $ do
|
||||
it "formats indented comments after the body" $
|
||||
[ "f = []",
|
||||
" {-B-}"
|
||||
]
|
||||
]
|
||||
`shouldFormatModuleBodyAs` [ "f =",
|
||||
" []",
|
||||
" {- B -}"
|
||||
]
|
||||
it "formats comments in type annotations" $
|
||||
[ "f{-A-}:{-B-}Int{-C-}",
|
||||
"f =",
|
||||
" 0"
|
||||
]
|
||||
`shouldFormatModuleBodyAs` [ "f {- A -} : {- B -} Int {- C -}",
|
||||
"f =",
|
||||
" 0"
|
||||
]
|
||||
|
||||
describe "expressions" $ do
|
||||
describe "array literals" $ do
|
||||
@ -316,11 +325,38 @@ spec = do
|
||||
"]"
|
||||
]
|
||||
|
||||
describe "unary operators (negation)" $ do
|
||||
it "formats" $
|
||||
["-x"]
|
||||
`shouldFormatExpressionAs` ["-x"]
|
||||
it "formats multiline value" $
|
||||
[ "-(x --A",
|
||||
")"
|
||||
]
|
||||
`shouldFormatExpressionAs` [ "-(x",
|
||||
" -- A",
|
||||
" )"
|
||||
]
|
||||
|
||||
describe "binary operators" $ do
|
||||
it "formats" $
|
||||
["1+2*3"]
|
||||
`shouldFormatExpressionAs` ["1 + 2 * 3"]
|
||||
|
||||
it "formats comments" $
|
||||
["1{-A-}+{-B-}2{-C-}*{-D-}3"]
|
||||
`shouldFormatExpressionAs` ["1 {- A -} + {- B -} 2 {- C -} * {- D -} 3"]
|
||||
|
||||
describe "lambda" $ do
|
||||
it "formats comments" $
|
||||
["\\{-A-}x{-B-}y{-C-}->{-D-}[]"]
|
||||
`shouldFormatExpressionAs` ["\\{- A -} x {- B -} y {- C -} -> {- D -} []"]
|
||||
|
||||
describe "function call" $ do
|
||||
it "formats comments" $
|
||||
["f{-A-}x{-B-}y{-C-}z"]
|
||||
`shouldFormatExpressionAs` ["f {- A -} x {- B -} y {- C -} z"]
|
||||
|
||||
describe "if" $ do
|
||||
it "formats comments" $
|
||||
["if{-A-}x{-B-}then{-C-}1{-D-}else{-E-}if{-F-}y{-G-}then{-H-}2{-I-}else{-J-}3"]
|
||||
@ -361,6 +397,28 @@ spec = do
|
||||
"{- C -}",
|
||||
"x"
|
||||
]
|
||||
it "formats comments in type annotations" $
|
||||
[ "let f{-A-}:{-B-}Int{-C-}",
|
||||
" f =",
|
||||
" 0",
|
||||
"in x"
|
||||
]
|
||||
`shouldFormatExpressionAs` [ "let",
|
||||
" f {- A -} : {- B -} Int {- C -}",
|
||||
" f =",
|
||||
" 0",
|
||||
"in",
|
||||
"x"
|
||||
]
|
||||
it "formats comments in destructure declarations" $
|
||||
["let{ x, y }{-A-}={-B-}r in x"]
|
||||
`shouldFormatExpressionAs` [ "let",
|
||||
" { x, y } {- A -} =",
|
||||
" {- B -}",
|
||||
" r",
|
||||
"in",
|
||||
"x"
|
||||
]
|
||||
it "formats comments between and after declarations" $
|
||||
[ "let",
|
||||
" x = 1",
|
||||
@ -387,12 +445,18 @@ spec = do
|
||||
[ "let",
|
||||
" x = 1",
|
||||
" {-A-}",
|
||||
" {y,z} = r",
|
||||
" {-B-}",
|
||||
"in x"
|
||||
]
|
||||
`shouldFormatExpressionAs` [ "let",
|
||||
" x =",
|
||||
" 1",
|
||||
" {- A -}",
|
||||
"",
|
||||
" { y, z } =",
|
||||
" r",
|
||||
" {- B -}",
|
||||
"in",
|
||||
"x"
|
||||
]
|
||||
@ -469,6 +533,7 @@ spec = do
|
||||
" b {- F -} = {- G -} 2 {- H -}",
|
||||
"}"
|
||||
]
|
||||
|
||||
describe "record update" $ do
|
||||
it "formats" $
|
||||
["{base|a=1,b=2}"]
|
||||
@ -583,8 +648,8 @@ shouldFormatModuleBodyAs inputLines expectedOutputLines =
|
||||
expectedOutput = LazyText.unlines $ fmap LazyText.fromStrict expectedOutputLines
|
||||
actualOutput = LTE.decodeUtf8 . Builder.toLazyByteString <$> Format.formatByteString Parse.Application input
|
||||
in case LazyText.stripPrefix "module Main exposing (..)\n\n\n\n" <$> actualOutput of
|
||||
Left _ ->
|
||||
expectationFailure "shouldFormatModuleBodyAs: failed to format"
|
||||
Left err ->
|
||||
expectationFailure ("shouldFormatModuleBodyAs: failed to format" <> show err)
|
||||
Right Nothing ->
|
||||
expectationFailure "shouldFormatModuleBodyAs: internal error: could not strip module header"
|
||||
Right (Just actualModuleBody) ->
|
||||
|
Loading…
Reference in New Issue
Block a user