1
1
mirror of https://github.com/github/semantic.git synced 2024-12-18 20:31:55 +03:00

Merge branch 'topologically-sorted-imports' of https://github.com/github/semantic into topologically-sorted-imports

This commit is contained in:
Rob Rix 2018-06-19 14:46:58 -04:00
commit 75d670be2a
16 changed files with 97 additions and 77 deletions

51
.hlint.yaml Normal file
View File

@ -0,0 +1,51 @@
# HLint configuration file
# https://github.com/ndmitchell/hlint
- arguments: [--color=auto, -XDataKinds, -XDeriveFoldable, -XDeriveFunctor, -XDeriveGeneric, -XDeriveTraversable, -XFlexibleContexts, -XFlexibleInstances, -XMultiParamTypeClasses, -XOverloadedStrings, -XRecordWildCards, -XStandaloneDeriving, -XStrictData, -XTypeApplications]
# Blacklist some functions by default.
- functions:
- {name: unsafePerformIO, within: []}
- {name: unsafeCoerce, within: []}
- {name: head, within: []}
- {name: tail, within: []}
- {name: init, within: []}
- {name: last, within: []}
- {name: fromJust, within: []}
# Replace a $ b $ c with a . b $ c
- group: {name: dollar, enabled: true}
# Generalise map to fmap, ++ to <>
- group: {name: generalise, enabled: true}
# Ignore some builtin hints
- ignore: {name: Use mappend}
- ignore: {name: Redundant do}
- ignore: {name: Use lambda-case} # TODO: investigate whether cost-center analysis is better with lambda-case than it was
- ignore: {name: Use fmap} # Ignored because map has better type inference.
# Change the severity of hints we dont want to fail CI for
- suggest: {name: Eta reduce}
# Our customized warnings
# AMP fallout
- warning: {lhs: mapM, rhs: traverse, name: Generalize mapM}
- warning: {lhs: mapM_, rhs: traverse_, name: Generalize mapM_}
- warning: {lhs: forM, rhs: for, name: Generalize forM}
- warning: {lhs: forM_, rhs: for_, name: Generalize forM_}
- warning: {lhs: sequence, rhs: sequenceA, name: Generalize sequence}
- warning: {lhs: sequence_, rhs: sequenceA_, name: Generalize sequence_}
- warning: {lhs: return, rhs: pure, name: Avoid return}
# Terms
- warning: {lhs: termFAnnotation . unTerm, rhs: termAnnotation, name: Use termAnnotation}
- warning: {lhs: termFOut . unTerm, rhs: termOut, name: Use termOut}
# Conveniences
- warning: {lhs: maybe a pure, rhs: maybeM a, name: Use maybeM}
# Applicative style
- warning: {lhs: f <$> pure a <*> b, rhs: f a <$> b, name: Avoid redundant pure}
- warning: {lhs: f <$> pure a <* b, rhs: f a <$ b, name: Avoid redundant pure}

View File

@ -1,35 +0,0 @@
import "hint" HLint.Default
import "hint" HLint.Dollar
import "hint" HLint.Generalise
ignore "Use mappend"
ignore "Redundant do"
-- TODO: investigate whether cost-center analysis is better with lambda-case than it was
ignore "Use lambda-case"
error "generalize ++" = (++) ==> (<>)
-- AMP fallout
error "generalize mapM" = mapM ==> traverse
error "generalize mapM_" = mapM_ ==> traverse_
error "generalize forM" = forM ==> for
error "generalize forM_" = forM_ ==> for_
error "Avoid return" =
return ==> pure
where note = "return is obsolete as of GHC 7.10"
error "use termAnnotation" = termFAnnotation . unTerm ==> termAnnotation
error "use termOut" = termFOut . unTerm ==> termOut
error "avoid head" = head
where note = "head is partial; consider using Data.Maybe.listToMaybe"
error "avoid tail" = tail
where note = "tail is partial; consider pattern-matching"
error "avoid init" = init
where note = "init is partial; consider pattern-matching"
error "avoid last" = last
where note = "last is partial; consider pattern-matching"
error "use maybeM" = maybe a pure ==> maybeM a

View File

@ -92,7 +92,7 @@ convergingModules :: ( AbstractValue address value effects
convergingModules recur m = do
c <- getConfiguration (subterm (moduleBody m))
-- Convergence here is predicated upon an Eq instance, not α-equivalence
cache <- converge lowerBound (\ prevCache -> isolateCache $ raiseHandler locally $ do
cache <- converge lowerBound (\ prevCache -> isolateCache . raiseHandler locally $ do
TermEvaluator (putHeap (configurationHeap c))
-- We need to reset fresh generation so that this invocation converges.
resetFresh 0 $

View File

@ -62,7 +62,7 @@ class Show1 constr => Evaluatable constr where
, Member Trace effects
)
=> SubtermAlgebra constr term (Evaluator address value effects (ValueRef address))
eval expr = rvalBox =<< throwResumable (Unspecialized ("Eval unspecialized for " ++ liftShowsPrec (const (const id)) (const id) 0 expr ""))
eval expr = rvalBox =<< throwResumable (Unspecialized ("Eval unspecialized for " <> liftShowsPrec (const (const id)) (const id) 0 expr ""))
evaluate :: ( AbstractValue address value inner

View File

@ -163,7 +163,7 @@ instance (GShow1Body f, GShow1Body g) => GShow1Body (f :*: g) where
else foldr (.) id (intersperse (showString " ") (gliftShowsPrecAll opts conIsRecord sp sl 11 (a :*: b)))
Infix _ prec -> showParen (d > prec) $ gliftShowsPrec opts sp sl (succ prec) a . showChar ' ' . showString conName . showChar ' ' . gliftShowsPrec opts sp sl (succ prec) b
gliftShowsPrecAll opts conIsRecord sp sl d (a :*: b) = gliftShowsPrecAll opts conIsRecord sp sl d a ++ gliftShowsPrecAll opts conIsRecord sp sl d b
gliftShowsPrecAll opts conIsRecord sp sl d (a :*: b) = gliftShowsPrecAll opts conIsRecord sp sl d a <> gliftShowsPrecAll opts conIsRecord sp sl d b
instance GShow1 f => GShow1 (M1 S c f) where
gliftShowsPrec opts sp sl d (M1 a) = gliftShowsPrec opts sp sl d a

View File

@ -17,11 +17,11 @@ infixr 0 :.
-- | Get the first element of a non-empty record.
rhead :: Record (head ': tail) -> head
rhead (head :. _) = head
rhead (head_ :. _) = head_
-- | Get the first element of a non-empty record.
rtail :: Record (head ': tail) -> Record tail
rtail (_ :. tail) = tail
rtail (_ :. tail_) = tail_
-- Classes

View File

@ -106,3 +106,5 @@ parser = signed (choice [hex, oct, bin, dec]) where
attemptUnsafeArithmetic :: a -> Either ArithException a
attemptUnsafeArithmetic = unsafePerformIO . Exc.try . evaluate
{-# NOINLINE attemptUnsafeArithmetic #-}
{-# ANN attemptUnsafeArithmetic ("HLint: ignore Avoid restricted function" :: String) #-}

View File

@ -23,6 +23,7 @@ import GHC.Types (Constraint)
import GHC.TypeLits
import qualified Proto3.Suite.DotProto as Proto
import Data.Char (toLower)
-- Combinators
-- | Lift syntax and an annotation into a term, injecting the syntax into a union & ensuring the annotation encompasses all children.
@ -108,7 +109,9 @@ instance (Apply Message1 fs, Generate Message1 fs fs, Generate Named1 fs fs) =>
liftDecodeMessage decodeMessage _ = oneof undefined listOfParsers
where
listOfParsers =
generate @Message1 @fs @fs (\ (_ :: proxy f) i -> let num = FieldNumber (fromInteger (succ i)) in [(num, fromJust <$> embedded (inject @f @fs <$> liftDecodeMessage decodeMessage num))])
generate @Message1 @fs @fs (\ (_ :: proxy f) i -> let num = FieldNumber (fromInteger (succ i)) in [(num, trustMe <$> embedded (inject @f @fs <$> liftDecodeMessage decodeMessage num))])
trustMe (Just a) = a
trustMe Nothing = error "liftDecodeMessage (Sum): embedded parser returned Nothing"
liftDotProto _ =
[Proto.DotProtoMessageOneOf (Proto.Single "syntax") (generate @Named1 @fs @fs (\ (_ :: proxy f) i ->
let

View File

@ -316,7 +316,7 @@ sliceType :: Assignment
sliceType = makeTerm <$> symbol SliceType <*> children (Type.Slice <$> expression)
structType :: Assignment
structType = makeTerm <$> symbol StructType <*> children (Declaration.Constructor <$> pure [] <*> emptyTerm <*> expressions)
structType = makeTerm <$> symbol StructType <*> children (Declaration.Constructor [] <$> emptyTerm <*> expressions)
typeAlias :: Assignment
typeAlias = makeTerm <$> symbol TypeAlias <*> children (Declaration.TypeAlias [] <$> expression <*> expression)
@ -367,7 +367,7 @@ defaultExpressionCase :: Assignment
defaultExpressionCase = makeTerm <$> symbol DefaultCase <*> (Go.Syntax.DefaultPattern <$ rawSource <*> (expressions <|> emptyTerm))
callExpression :: Assignment
callExpression = makeTerm <$> symbol CallExpression <*> children (Expression.Call <$> pure [] <*> expression <*> manyTerm expression <*> emptyTerm)
callExpression = makeTerm <$> symbol CallExpression <*> children (Expression.Call [] <$> expression <*> manyTerm expression <*> emptyTerm)
expressionCase :: Assignment
expressionCase = makeTerm <$> symbol ExpressionCase <*> (Statement.Pattern <$> children expressions <*> expressions)
@ -403,7 +403,7 @@ importDeclaration = makeTerm'' <$> symbol ImportDeclaration <*> children (manyTe
plainImport = inject <$> (symbol InterpretedStringLiteral >>= \loc -> do
from <- importPath <$> source
let alias = makeTerm loc (Syntax.Identifier (defaultAlias from)) -- Go takes `import "lib/Math"` and uses `Math` as the qualified name (e.g. `Math.Sin()`)
Go.Syntax.QualifiedImport <$> pure from <*> pure alias)
pure $! Go.Syntax.QualifiedImport from alias)
dot = makeTerm <$> symbol Dot <*> (Literal.TextElement <$> source)
underscore = makeTerm <$> symbol BlankIdentifier <*> (Literal.TextElement <$> source)
@ -487,13 +487,13 @@ varDeclaration :: Assignment
varDeclaration = (symbol ConstDeclaration <|> symbol VarDeclaration) *> children expressions
variadicArgument :: Assignment
variadicArgument = makeTerm <$> symbol VariadicArgument <*> children (Go.Syntax.Variadic <$> pure [] <*> expression)
variadicArgument = makeTerm <$> symbol VariadicArgument <*> children (Go.Syntax.Variadic [] <$> expression)
variadicParameterDeclaration :: Assignment
variadicParameterDeclaration = makeTerm <$> symbol VariadicParameterDeclaration <*> children (flip Go.Syntax.Variadic <$> (expression <|> emptyTerm) <* token AnonDotDotDot <*> many expression)
varSpecification :: Assignment
varSpecification = makeTerm <$> (symbol ConstSpec <|> symbol VarSpec) <*> children (Statement.Assignment <$> pure [] <*> (annotatedLHS <|> identifiers) <*> expressions)
varSpecification = makeTerm <$> (symbol ConstSpec <|> symbol VarSpec) <*> children (Statement.Assignment [] <$> (annotatedLHS <|> identifiers) <*> expressions)
where
annotatedLHS = makeTerm <$> location <*> (Type.Annotation <$> (makeTerm <$> location <*> manyTermsTill identifier (void (symbol TypeIdentifier))) <*> expression)
@ -585,7 +585,7 @@ receiveStatement :: Assignment
receiveStatement = makeTerm <$> symbol ReceiveStatement <*> children (Go.Syntax.Receive <$> (expression <|> emptyTerm) <*> expression)
shortVarDeclaration :: Assignment
shortVarDeclaration = makeTerm <$> symbol ShortVarDeclaration <*> children (Statement.Assignment <$> pure [] <*> expression <*> expression)
shortVarDeclaration = makeTerm <$> symbol ShortVarDeclaration <*> children (Statement.Assignment [] <$> expression <*> expression)
selectStatement :: Assignment
selectStatement = makeTerm <$> symbol SelectStatement <*> children (Go.Syntax.Select <$> expressions)

View File

@ -85,7 +85,7 @@ instance Evaluatable QualifiedImport where
eval (QualifiedImport importPath aliasTerm) = do
paths <- resolveGoImport importPath
alias <- either (throwEvalError . FreeVariablesError) pure (freeVariable $ subterm aliasTerm)
void $ letrec' alias $ \addr -> do
void . letrec' alias $ \addr -> do
for_ paths $ \p -> do
traceResolve (unPath importPath) p
importedEnv <- maybe lowerBound snd <$> require p

View File

@ -312,9 +312,8 @@ functionConstructor = makeTerm <$> token FunctionConstructor <*> pure Syntax.Fu
functionDeclaration :: Assignment
functionDeclaration = makeTerm
<$> symbol FunctionDeclaration
<*> children (Declaration.Function
<$> pure []
<*> variableIdentifier
<*> children (Declaration.Function []
<$> variableIdentifier
<*> (manyTermsTill expression (symbol FunctionBody) <|> pure [])
<*> functionBody)

View File

@ -252,7 +252,7 @@ superInterfaces = symbol SuperInterfaces *> children (symbol InterfaceTypeList *
class' :: Assignment
class' = makeTerm <$> symbol ClassDeclaration <*> children (makeClass <$> many modifier <*> term identifier <*> (typeParameters <|> pure []) <*> optional superClass <*> (superInterfaces <|> pure []) <*> classBody)
where
makeClass modifiers identifier typeParams superClass superInterfaces = Declaration.Class (modifiers ++ typeParams) identifier (maybeToList superClass ++ superInterfaces) -- not doing an assignment, just straight up function
makeClass modifiers identifier typeParams superClass superInterfaces = Declaration.Class (modifiers <> typeParams) identifier (maybeToList superClass <> superInterfaces) -- not doing an assignment, just straight up function
classBody = makeTerm <$> symbol ClassBody <*> children (manyTerm expression)
superClass = symbol Superclass *> children type'
-- TODO: superclass
@ -269,7 +269,7 @@ method = makeTerm <$> symbol MethodDeclaration <*> children (makeMethod <$> many
methodBody = symbol MethodBody *> children (term expression <|> emptyTerm)
methodDeclarator = symbol MethodDeclarator *> children ( (,) <$> identifier <*> formalParameters)
methodHeader = symbol MethodHeader *> children ((,,,,) <$> (typeParameters <|> pure []) <*> manyTerm annotation <*> type' <*> methodDeclarator <*> (throws <|> pure []))
makeMethod modifiers receiver (typeParams, annotations, returnType, (name, params), throws) = Declaration.Method (returnType : modifiers ++ typeParams ++ annotations ++ throws) receiver name params
makeMethod modifiers receiver (typeParams, annotations, returnType, (name, params), throws) = Declaration.Method (returnType : modifiers <> typeParams <> annotations <> throws) receiver name params
-- methodHeader needs to include typeParameters (it does)
generic :: Assignment
@ -299,7 +299,7 @@ interface = makeTerm <$> symbol InterfaceDeclaration <*> children (normal <|> an
where
interfaceBody = makeTerm <$> symbol InterfaceBody <*> children (manyTerm interfaceMemberDeclaration)
normal = symbol NormalInterfaceDeclaration *> children (makeInterface <$> manyTerm modifier <*> identifier <*> (typeParameters <|> pure []) <*> interfaceBody)
makeInterface modifiers identifier typeParams = Declaration.InterfaceDeclaration (modifiers ++ typeParams) identifier
makeInterface modifiers identifier typeParams = Declaration.InterfaceDeclaration (modifiers <> typeParams) identifier
annotationType = symbol AnnotationTypeDeclaration *> children (Declaration.InterfaceDeclaration [] <$> identifier <*> annotationTypeBody)
annotationTypeBody = makeTerm <$> symbol AnnotationTypeBody <*> children (many expression)
interfaceMemberDeclaration = symbol InterfaceMemberDeclaration *> children (term expression)

View File

@ -420,8 +420,8 @@ methodDeclaration :: Assignment
methodDeclaration = (makeTerm <$> symbol MethodDeclaration <*> children (makeMethod1 <$> manyTerm methodModifier <*> emptyTerm <*> functionDefinitionParts)) <|> makeTerm <$> symbol MethodDeclaration <*> children (makeMethod2 <$> someTerm methodModifier <*> emptyTerm <*> term name <*> parameters <*> term (returnType <|> emptyTerm) <*> emptyTerm)
where
functionDefinitionParts = symbol FunctionDefinition *> children ((,,,) <$> term name <*> parameters <*> term (returnType <|> emptyTerm) <*> (term compoundStatement <|> emptyTerm))
makeMethod1 modifiers receiver (name, params, returnType, compoundStatement) = Declaration.Method (modifiers ++ [returnType]) receiver name params compoundStatement
makeMethod2 modifiers receiver name params returnType compoundStatement = Declaration.Method (modifiers ++ [returnType]) receiver name params compoundStatement
makeMethod1 modifiers receiver (name, params, returnType, compoundStatement) = Declaration.Method (modifiers <> [returnType]) receiver name params compoundStatement
makeMethod2 modifiers receiver name params returnType compoundStatement = Declaration.Method (modifiers <> [returnType]) receiver name params compoundStatement
classBaseClause :: Assignment
classBaseClause = makeTerm <$> symbol ClassBaseClause <*> children (Syntax.ClassBaseClause <$> term qualifiedName)
@ -505,7 +505,7 @@ selectionStatement :: Assignment
selectionStatement = ifStatement <|> switchStatement
ifStatement :: Assignment
ifStatement = makeTerm <$> symbol IfStatement <*> children (Statement.If <$> term expression <*> (makeTerm <$> location <*> manyTerm statement) <*> (makeTerm <$> location <*> ((\as b -> as ++ [b]) <$> manyTerm elseIfClause <*> (term elseClause <|> emptyTerm))))
ifStatement = makeTerm <$> symbol IfStatement <*> children (Statement.If <$> term expression <*> (makeTerm <$> location <*> manyTerm statement) <*> (makeTerm <$> location <*> ((\as b -> as <> [b]) <$> manyTerm elseIfClause <*> (term elseClause <|> emptyTerm))))
switchStatement :: Assignment
switchStatement = makeTerm <$> symbol SwitchStatement <*> children (Statement.Match <$> term expression <*> (makeTerm <$> location <*> manyTerm (caseStatement <|> defaultStatement)))
@ -575,7 +575,7 @@ throwStatement = makeTerm <$> symbol ThrowStatement <*> children (Statement.Thro
tryStatement :: Assignment
tryStatement = makeTerm <$> symbol TryStatement <*> children (Statement.Try <$> term compoundStatement <*> (((\as b -> as ++ [b]) <$> someTerm catchClause <*> term finallyClause) <|> someTerm catchClause <|> someTerm finallyClause))
tryStatement = makeTerm <$> symbol TryStatement <*> children (Statement.Try <$> term compoundStatement <*> (((\as b -> as <> [b]) <$> someTerm catchClause <*> term finallyClause) <|> someTerm catchClause <|> someTerm finallyClause))
catchClause :: Assignment
catchClause = makeTerm <$> symbol CatchClause <*> children (Statement.Catch <$> (makeTerm <$> location <*> ((\a b -> [a, b]) <$> term qualifiedName <*> term variableName)) <*> term compoundStatement)
@ -766,10 +766,10 @@ string = makeTerm <$> (symbol Grammar.String <|> symbol Heredoc) <*> (Literal.Te
-- Helpers
append :: a -> [a] -> [a]
append x xs = xs ++ [x]
append x xs = xs <> [x]
bookend :: a -> [a] -> a -> [a]
bookend head list last = head : append last list
bookend head_ list last_ = head_ : append last_ list
term :: Assignment -> Assignment
term term = contextualize (comment <|> textInterpolation) (postContextualize (comment <|> textInterpolation) term)

View File

@ -271,12 +271,12 @@ parameter = postContextualize comment (term uncontextualizedParameter)
optionalParameter = symbol OptionalParameter *> children (lhsIdent <* expression)
method :: Assignment
method = makeTerm <$> symbol Method <*> (withNewScope . children) (Declaration.Method <$> pure [] <*> emptyTerm <*> methodSelector <*> params <*> expressions')
method = makeTerm <$> symbol Method <*> (withNewScope . children) (Declaration.Method [] <$> emptyTerm <*> methodSelector <*> params <*> expressions')
where params = symbol MethodParameters *> children (many parameter) <|> pure []
expressions' = makeTerm <$> location <*> many expression
singletonMethod :: Assignment
singletonMethod = makeTerm <$> symbol SingletonMethod <*> (withNewScope . children) (Declaration.Method <$> pure [] <*> expression <*> methodSelector <*> params <*> expressions)
singletonMethod = makeTerm <$> symbol SingletonMethod <*> (withNewScope . children) (Declaration.Method [] <$> expression <*> methodSelector <*> params <*> expressions)
where params = symbol MethodParameters *> children (many parameter) <|> pure []
lambda :: Assignment
@ -289,18 +289,18 @@ block :: Assignment
block = makeTerm <$> symbol DoBlock <*> scopedBlockChildren
<|> makeTerm <$> symbol Block <*> scopedBlockChildren
where scopedBlockChildren = withExtendedScope blockChildren
blockChildren = children (Declaration.Function <$> pure [] <*> emptyTerm <*> params <*> expressions)
blockChildren = children (Declaration.Function [] <$> emptyTerm <*> params <*> expressions)
params = symbol BlockParameters *> children (many parameter) <|> pure []
comment :: Assignment
comment = makeTerm <$> symbol Comment <*> (Comment.Comment <$> source)
alias :: Assignment
alias = makeTerm <$> symbol Alias <*> children (Expression.Call <$> pure [] <*> name' <*> some expression <*> emptyTerm)
alias = makeTerm <$> symbol Alias <*> children (Expression.Call [] <$> name' <*> some expression <*> emptyTerm)
where name' = makeTerm <$> location <*> (Syntax.Identifier . name <$> source)
undef :: Assignment
undef = makeTerm <$> symbol Undef <*> children (Expression.Call <$> pure [] <*> name' <*> some expression <*> emptyTerm)
undef = makeTerm <$> symbol Undef <*> children (Expression.Call [] <$> name' <*> some expression <*> emptyTerm)
where name' = makeTerm <$> location <*> (Syntax.Identifier . name <$> source)
if' :: Assignment
@ -445,7 +445,7 @@ unary = symbol Unary >>= \ location ->
makeTerm location . Expression.Complement <$> children ( symbol AnonTilde *> expression )
<|> makeTerm location . Expression.Not <$> children ( symbol AnonBang *> expression )
<|> makeTerm location . Expression.Not <$> children ( symbol AnonNot *> expression )
<|> makeTerm location <$> children (Expression.Call <$> pure [] <*> (makeTerm <$> symbol AnonDefinedQuestion <*> (Syntax.Identifier . name <$> source)) <*> some expression <*> emptyTerm)
<|> makeTerm location <$> children (Expression.Call [] <$> (makeTerm <$> symbol AnonDefinedQuestion <*> (Syntax.Identifier . name <$> source)) <*> some expression <*> emptyTerm)
<|> makeTerm location . Expression.Negate <$> children ( symbol AnonMinus' *> expression )
<|> children ( symbol AnonPlus *> expression )

View File

@ -291,7 +291,7 @@ null' :: Assignment
null' = makeTerm <$> symbol Null <*> (Literal.Null <$ rawSource)
anonymousClass :: Assignment
anonymousClass = makeTerm <$> symbol Grammar.AnonymousClass <*> children (Declaration.Class <$> pure [] <*> emptyTerm <*> (classHeritage' <|> pure []) <*> classBodyStatements)
anonymousClass = makeTerm <$> symbol Grammar.AnonymousClass <*> children (Declaration.Class [] <$> emptyTerm <*> (classHeritage' <|> pure []) <*> classBodyStatements)
abstractClass :: Assignment
abstractClass = makeTerm <$> symbol Grammar.AbstractClass <*> children (TypeScript.Syntax.AbstractClass <$> term identifier <*> (term typeParameters <|> emptyTerm) <*> (classHeritage' <|> pure []) <*> classBodyStatements)
@ -350,7 +350,7 @@ identifier = makeTerm <$> (symbol Identifier <|> symbol Identifier') <*> (Syntax
class' :: Assignment
class' = makeClass <$> symbol Class <*> children ((,,,,) <$> manyTerm decorator <*> term identifier <*> (symbol TypeParameters *> children (manyTerm typeParameter') <|> pure []) <*> (classHeritage' <|> pure []) <*> classBodyStatements)
where makeClass loc (decorators, expression, typeParams, classHeritage, statements) = makeTerm loc (Declaration.Class (decorators ++ typeParams) expression classHeritage statements)
where makeClass loc (decorators, expression, typeParams, classHeritage, statements) = makeTerm loc (Declaration.Class (decorators <> typeParams) expression classHeritage statements)
object :: Assignment
object = makeTerm <$> (symbol Object <|> symbol ObjectPattern) <*> children (Literal.Hash <$> manyTerm (pair <|> spreadElement <|> methodDefinition <|> assignmentPattern <|> shorthandPropertyIdentifier))
@ -460,13 +460,13 @@ methodSignature = makeMethodSignature <$> symbol Grammar.MethodSignature <*> chi
where makeMethodSignature loc (modifier, readonly, propertyName, (typeParams, params, annotation)) = makeTerm loc (Declaration.MethodSignature [modifier, readonly, typeParams, annotation] propertyName params)
formalParameters :: Assignment.Assignment [] Grammar [Term]
formalParameters = symbol FormalParameters *> children (contextualize' <$> Assignment.manyThrough comment (postContextualize' <$> (concat <$> many ((\as b -> as ++ [b]) <$> manyTerm decorator <*> term parameter)) <*> many comment))
formalParameters = symbol FormalParameters *> children (contextualize' <$> Assignment.manyThrough comment (postContextualize' <$> (concat <$> many ((\as b -> as <> [b]) <$> manyTerm decorator <*> term parameter)) <*> many comment))
where
contextualize' (cs, formalParams) = case nonEmpty cs of
Just cs -> toList cs ++ formalParams
Just cs -> toList cs <> formalParams
Nothing -> formalParams
postContextualize' formalParams cs = case nonEmpty cs of
Just cs -> formalParams ++ toList cs
Just cs -> formalParams <> toList cs
Nothing -> formalParams
@ -573,13 +573,13 @@ statementBlock :: Assignment
statementBlock = makeTerm <$> symbol StatementBlock <*> children (manyTerm statement)
classBodyStatements :: Assignment
classBodyStatements = makeTerm'' <$> symbol ClassBody <*> children (contextualize' <$> Assignment.manyThrough comment (postContextualize' <$> (concat <$> many ((\as b -> as ++ [b]) <$> manyTerm decorator <*> term (methodDefinition <|> publicFieldDefinition <|> methodSignature <|> indexSignature <|> abstractMethodSignature))) <*> many comment))
classBodyStatements = makeTerm'' <$> symbol ClassBody <*> children (contextualize' <$> Assignment.manyThrough comment (postContextualize' <$> (concat <$> many ((\as b -> as <> [b]) <$> manyTerm decorator <*> term (methodDefinition <|> publicFieldDefinition <|> methodSignature <|> indexSignature <|> abstractMethodSignature))) <*> many comment))
where
contextualize' (cs, formalParams) = case nonEmpty cs of
Just cs -> toList cs ++ formalParams
Just cs -> toList cs <> formalParams
Nothing -> formalParams
postContextualize' formalParams cs = case nonEmpty cs of
Just cs -> formalParams ++ toList cs
Just cs -> formalParams <> toList cs
Nothing -> formalParams
publicFieldDefinition :: Assignment

View File

@ -1,9 +1,9 @@
module Main (main) where
import Language.Haskell.HLint (hlint)
import Language.Haskell.HLint (Severity(..), hlint, suggestionSeverity)
import System.Exit (exitFailure, exitSuccess)
main :: IO ()
main = do
hints <- hlint [ "--language=TypeApplications", "src" ]
if null hints then exitSuccess else exitFailure
hints <- hlint [ "src" ]
if null (filter ((>= Warning) . suggestionSeverity) hints) then exitSuccess else exitFailure