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:
commit
75d670be2a
51
.hlint.yaml
Normal file
51
.hlint.yaml
Normal 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 don’t 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}
|
35
HLint.hs
35
HLint.hs
@ -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
|
@ -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 $
|
||||
|
@ -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
|
||||
|
@ -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
|
||||
|
@ -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
|
||||
|
@ -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) #-}
|
||||
|
@ -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
|
||||
|
@ -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)
|
||||
|
@ -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
|
||||
|
@ -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)
|
||||
|
||||
|
@ -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)
|
||||
|
@ -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)
|
||||
|
@ -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 )
|
||||
|
||||
|
@ -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
|
||||
|
@ -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
|
||||
|
Loading…
Reference in New Issue
Block a user