mirror of
https://github.com/github/semantic.git
synced 2024-12-20 05:11:44 +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
|
convergingModules recur m = do
|
||||||
c <- getConfiguration (subterm (moduleBody m))
|
c <- getConfiguration (subterm (moduleBody m))
|
||||||
-- Convergence here is predicated upon an Eq instance, not α-equivalence
|
-- 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))
|
TermEvaluator (putHeap (configurationHeap c))
|
||||||
-- We need to reset fresh generation so that this invocation converges.
|
-- We need to reset fresh generation so that this invocation converges.
|
||||||
resetFresh 0 $
|
resetFresh 0 $
|
||||||
|
@ -62,7 +62,7 @@ class Show1 constr => Evaluatable constr where
|
|||||||
, Member Trace effects
|
, Member Trace effects
|
||||||
)
|
)
|
||||||
=> SubtermAlgebra constr term (Evaluator address value effects (ValueRef address))
|
=> 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
|
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)))
|
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
|
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
|
instance GShow1 f => GShow1 (M1 S c f) where
|
||||||
gliftShowsPrec opts sp sl d (M1 a) = gliftShowsPrec opts sp sl d a
|
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.
|
-- | Get the first element of a non-empty record.
|
||||||
rhead :: Record (head ': tail) -> head
|
rhead :: Record (head ': tail) -> head
|
||||||
rhead (head :. _) = head
|
rhead (head_ :. _) = head_
|
||||||
|
|
||||||
-- | Get the first element of a non-empty record.
|
-- | Get the first element of a non-empty record.
|
||||||
rtail :: Record (head ': tail) -> Record tail
|
rtail :: Record (head ': tail) -> Record tail
|
||||||
rtail (_ :. tail) = tail
|
rtail (_ :. tail_) = tail_
|
||||||
|
|
||||||
|
|
||||||
-- Classes
|
-- Classes
|
||||||
|
@ -106,3 +106,5 @@ parser = signed (choice [hex, oct, bin, dec]) where
|
|||||||
attemptUnsafeArithmetic :: a -> Either ArithException a
|
attemptUnsafeArithmetic :: a -> Either ArithException a
|
||||||
attemptUnsafeArithmetic = unsafePerformIO . Exc.try . evaluate
|
attemptUnsafeArithmetic = unsafePerformIO . Exc.try . evaluate
|
||||||
{-# NOINLINE attemptUnsafeArithmetic #-}
|
{-# NOINLINE attemptUnsafeArithmetic #-}
|
||||||
|
|
||||||
|
{-# ANN attemptUnsafeArithmetic ("HLint: ignore Avoid restricted function" :: String) #-}
|
||||||
|
@ -23,6 +23,7 @@ import GHC.Types (Constraint)
|
|||||||
import GHC.TypeLits
|
import GHC.TypeLits
|
||||||
import qualified Proto3.Suite.DotProto as Proto
|
import qualified Proto3.Suite.DotProto as Proto
|
||||||
import Data.Char (toLower)
|
import Data.Char (toLower)
|
||||||
|
|
||||||
-- Combinators
|
-- Combinators
|
||||||
|
|
||||||
-- | Lift syntax and an annotation into a term, injecting the syntax into a union & ensuring the annotation encompasses all children.
|
-- | 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
|
liftDecodeMessage decodeMessage _ = oneof undefined listOfParsers
|
||||||
where
|
where
|
||||||
listOfParsers =
|
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 _ =
|
liftDotProto _ =
|
||||||
[Proto.DotProtoMessageOneOf (Proto.Single "syntax") (generate @Named1 @fs @fs (\ (_ :: proxy f) i ->
|
[Proto.DotProtoMessageOneOf (Proto.Single "syntax") (generate @Named1 @fs @fs (\ (_ :: proxy f) i ->
|
||||||
let
|
let
|
||||||
|
@ -316,7 +316,7 @@ sliceType :: Assignment
|
|||||||
sliceType = makeTerm <$> symbol SliceType <*> children (Type.Slice <$> expression)
|
sliceType = makeTerm <$> symbol SliceType <*> children (Type.Slice <$> expression)
|
||||||
|
|
||||||
structType :: Assignment
|
structType :: Assignment
|
||||||
structType = makeTerm <$> symbol StructType <*> children (Declaration.Constructor <$> pure [] <*> emptyTerm <*> expressions)
|
structType = makeTerm <$> symbol StructType <*> children (Declaration.Constructor [] <$> emptyTerm <*> expressions)
|
||||||
|
|
||||||
typeAlias :: Assignment
|
typeAlias :: Assignment
|
||||||
typeAlias = makeTerm <$> symbol TypeAlias <*> children (Declaration.TypeAlias [] <$> expression <*> expression)
|
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))
|
defaultExpressionCase = makeTerm <$> symbol DefaultCase <*> (Go.Syntax.DefaultPattern <$ rawSource <*> (expressions <|> emptyTerm))
|
||||||
|
|
||||||
callExpression :: Assignment
|
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 :: Assignment
|
||||||
expressionCase = makeTerm <$> symbol ExpressionCase <*> (Statement.Pattern <$> children expressions <*> expressions)
|
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
|
plainImport = inject <$> (symbol InterpretedStringLiteral >>= \loc -> do
|
||||||
from <- importPath <$> source
|
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()`)
|
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)
|
dot = makeTerm <$> symbol Dot <*> (Literal.TextElement <$> source)
|
||||||
underscore = makeTerm <$> symbol BlankIdentifier <*> (Literal.TextElement <$> source)
|
underscore = makeTerm <$> symbol BlankIdentifier <*> (Literal.TextElement <$> source)
|
||||||
@ -487,13 +487,13 @@ varDeclaration :: Assignment
|
|||||||
varDeclaration = (symbol ConstDeclaration <|> symbol VarDeclaration) *> children expressions
|
varDeclaration = (symbol ConstDeclaration <|> symbol VarDeclaration) *> children expressions
|
||||||
|
|
||||||
variadicArgument :: Assignment
|
variadicArgument :: Assignment
|
||||||
variadicArgument = makeTerm <$> symbol VariadicArgument <*> children (Go.Syntax.Variadic <$> pure [] <*> expression)
|
variadicArgument = makeTerm <$> symbol VariadicArgument <*> children (Go.Syntax.Variadic [] <$> expression)
|
||||||
|
|
||||||
variadicParameterDeclaration :: Assignment
|
variadicParameterDeclaration :: Assignment
|
||||||
variadicParameterDeclaration = makeTerm <$> symbol VariadicParameterDeclaration <*> children (flip Go.Syntax.Variadic <$> (expression <|> emptyTerm) <* token AnonDotDotDot <*> many expression)
|
variadicParameterDeclaration = makeTerm <$> symbol VariadicParameterDeclaration <*> children (flip Go.Syntax.Variadic <$> (expression <|> emptyTerm) <* token AnonDotDotDot <*> many expression)
|
||||||
|
|
||||||
varSpecification :: Assignment
|
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
|
where
|
||||||
annotatedLHS = makeTerm <$> location <*> (Type.Annotation <$> (makeTerm <$> location <*> manyTermsTill identifier (void (symbol TypeIdentifier))) <*> expression)
|
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)
|
receiveStatement = makeTerm <$> symbol ReceiveStatement <*> children (Go.Syntax.Receive <$> (expression <|> emptyTerm) <*> expression)
|
||||||
|
|
||||||
shortVarDeclaration :: Assignment
|
shortVarDeclaration :: Assignment
|
||||||
shortVarDeclaration = makeTerm <$> symbol ShortVarDeclaration <*> children (Statement.Assignment <$> pure [] <*> expression <*> expression)
|
shortVarDeclaration = makeTerm <$> symbol ShortVarDeclaration <*> children (Statement.Assignment [] <$> expression <*> expression)
|
||||||
|
|
||||||
selectStatement :: Assignment
|
selectStatement :: Assignment
|
||||||
selectStatement = makeTerm <$> symbol SelectStatement <*> children (Go.Syntax.Select <$> expressions)
|
selectStatement = makeTerm <$> symbol SelectStatement <*> children (Go.Syntax.Select <$> expressions)
|
||||||
|
@ -85,7 +85,7 @@ instance Evaluatable QualifiedImport where
|
|||||||
eval (QualifiedImport importPath aliasTerm) = do
|
eval (QualifiedImport importPath aliasTerm) = do
|
||||||
paths <- resolveGoImport importPath
|
paths <- resolveGoImport importPath
|
||||||
alias <- either (throwEvalError . FreeVariablesError) pure (freeVariable $ subterm aliasTerm)
|
alias <- either (throwEvalError . FreeVariablesError) pure (freeVariable $ subterm aliasTerm)
|
||||||
void $ letrec' alias $ \addr -> do
|
void . letrec' alias $ \addr -> do
|
||||||
for_ paths $ \p -> do
|
for_ paths $ \p -> do
|
||||||
traceResolve (unPath importPath) p
|
traceResolve (unPath importPath) p
|
||||||
importedEnv <- maybe lowerBound snd <$> require p
|
importedEnv <- maybe lowerBound snd <$> require p
|
||||||
|
@ -312,9 +312,8 @@ functionConstructor = makeTerm <$> token FunctionConstructor <*> pure Syntax.Fu
|
|||||||
functionDeclaration :: Assignment
|
functionDeclaration :: Assignment
|
||||||
functionDeclaration = makeTerm
|
functionDeclaration = makeTerm
|
||||||
<$> symbol FunctionDeclaration
|
<$> symbol FunctionDeclaration
|
||||||
<*> children (Declaration.Function
|
<*> children (Declaration.Function []
|
||||||
<$> pure []
|
<$> variableIdentifier
|
||||||
<*> variableIdentifier
|
|
||||||
<*> (manyTermsTill expression (symbol FunctionBody) <|> pure [])
|
<*> (manyTermsTill expression (symbol FunctionBody) <|> pure [])
|
||||||
<*> functionBody)
|
<*> functionBody)
|
||||||
|
|
||||||
|
@ -252,7 +252,7 @@ superInterfaces = symbol SuperInterfaces *> children (symbol InterfaceTypeList *
|
|||||||
class' :: Assignment
|
class' :: Assignment
|
||||||
class' = makeTerm <$> symbol ClassDeclaration <*> children (makeClass <$> many modifier <*> term identifier <*> (typeParameters <|> pure []) <*> optional superClass <*> (superInterfaces <|> pure []) <*> classBody)
|
class' = makeTerm <$> symbol ClassDeclaration <*> children (makeClass <$> many modifier <*> term identifier <*> (typeParameters <|> pure []) <*> optional superClass <*> (superInterfaces <|> pure []) <*> classBody)
|
||||||
where
|
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)
|
classBody = makeTerm <$> symbol ClassBody <*> children (manyTerm expression)
|
||||||
superClass = symbol Superclass *> children type'
|
superClass = symbol Superclass *> children type'
|
||||||
-- TODO: superclass
|
-- TODO: superclass
|
||||||
@ -269,7 +269,7 @@ method = makeTerm <$> symbol MethodDeclaration <*> children (makeMethod <$> many
|
|||||||
methodBody = symbol MethodBody *> children (term expression <|> emptyTerm)
|
methodBody = symbol MethodBody *> children (term expression <|> emptyTerm)
|
||||||
methodDeclarator = symbol MethodDeclarator *> children ( (,) <$> identifier <*> formalParameters)
|
methodDeclarator = symbol MethodDeclarator *> children ( (,) <$> identifier <*> formalParameters)
|
||||||
methodHeader = symbol MethodHeader *> children ((,,,,) <$> (typeParameters <|> pure []) <*> manyTerm annotation <*> type' <*> methodDeclarator <*> (throws <|> pure []))
|
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)
|
-- methodHeader needs to include typeParameters (it does)
|
||||||
|
|
||||||
generic :: Assignment
|
generic :: Assignment
|
||||||
@ -299,7 +299,7 @@ interface = makeTerm <$> symbol InterfaceDeclaration <*> children (normal <|> an
|
|||||||
where
|
where
|
||||||
interfaceBody = makeTerm <$> symbol InterfaceBody <*> children (manyTerm interfaceMemberDeclaration)
|
interfaceBody = makeTerm <$> symbol InterfaceBody <*> children (manyTerm interfaceMemberDeclaration)
|
||||||
normal = symbol NormalInterfaceDeclaration *> children (makeInterface <$> manyTerm modifier <*> identifier <*> (typeParameters <|> pure []) <*> interfaceBody)
|
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)
|
annotationType = symbol AnnotationTypeDeclaration *> children (Declaration.InterfaceDeclaration [] <$> identifier <*> annotationTypeBody)
|
||||||
annotationTypeBody = makeTerm <$> symbol AnnotationTypeBody <*> children (many expression)
|
annotationTypeBody = makeTerm <$> symbol AnnotationTypeBody <*> children (many expression)
|
||||||
interfaceMemberDeclaration = symbol InterfaceMemberDeclaration *> children (term 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)
|
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
|
where
|
||||||
functionDefinitionParts = symbol FunctionDefinition *> children ((,,,) <$> term name <*> parameters <*> term (returnType <|> emptyTerm) <*> (term compoundStatement <|> emptyTerm))
|
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
|
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
|
makeMethod2 modifiers receiver name params returnType compoundStatement = Declaration.Method (modifiers <> [returnType]) receiver name params compoundStatement
|
||||||
|
|
||||||
classBaseClause :: Assignment
|
classBaseClause :: Assignment
|
||||||
classBaseClause = makeTerm <$> symbol ClassBaseClause <*> children (Syntax.ClassBaseClause <$> term qualifiedName)
|
classBaseClause = makeTerm <$> symbol ClassBaseClause <*> children (Syntax.ClassBaseClause <$> term qualifiedName)
|
||||||
@ -505,7 +505,7 @@ selectionStatement :: Assignment
|
|||||||
selectionStatement = ifStatement <|> switchStatement
|
selectionStatement = ifStatement <|> switchStatement
|
||||||
|
|
||||||
ifStatement :: Assignment
|
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 :: Assignment
|
||||||
switchStatement = makeTerm <$> symbol SwitchStatement <*> children (Statement.Match <$> term expression <*> (makeTerm <$> location <*> manyTerm (caseStatement <|> defaultStatement)))
|
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 :: 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 :: Assignment
|
||||||
catchClause = makeTerm <$> symbol CatchClause <*> children (Statement.Catch <$> (makeTerm <$> location <*> ((\a b -> [a, b]) <$> term qualifiedName <*> term variableName)) <*> term compoundStatement)
|
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
|
-- Helpers
|
||||||
|
|
||||||
append :: a -> [a] -> [a]
|
append :: a -> [a] -> [a]
|
||||||
append x xs = xs ++ [x]
|
append x xs = xs <> [x]
|
||||||
|
|
||||||
bookend :: a -> [a] -> a -> [a]
|
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 :: Assignment -> Assignment
|
||||||
term term = contextualize (comment <|> textInterpolation) (postContextualize (comment <|> textInterpolation) term)
|
term term = contextualize (comment <|> textInterpolation) (postContextualize (comment <|> textInterpolation) term)
|
||||||
|
@ -271,12 +271,12 @@ parameter = postContextualize comment (term uncontextualizedParameter)
|
|||||||
optionalParameter = symbol OptionalParameter *> children (lhsIdent <* expression)
|
optionalParameter = symbol OptionalParameter *> children (lhsIdent <* expression)
|
||||||
|
|
||||||
method :: Assignment
|
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 []
|
where params = symbol MethodParameters *> children (many parameter) <|> pure []
|
||||||
expressions' = makeTerm <$> location <*> many expression
|
expressions' = makeTerm <$> location <*> many expression
|
||||||
|
|
||||||
singletonMethod :: Assignment
|
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 []
|
where params = symbol MethodParameters *> children (many parameter) <|> pure []
|
||||||
|
|
||||||
lambda :: Assignment
|
lambda :: Assignment
|
||||||
@ -289,18 +289,18 @@ block :: Assignment
|
|||||||
block = makeTerm <$> symbol DoBlock <*> scopedBlockChildren
|
block = makeTerm <$> symbol DoBlock <*> scopedBlockChildren
|
||||||
<|> makeTerm <$> symbol Block <*> scopedBlockChildren
|
<|> makeTerm <$> symbol Block <*> scopedBlockChildren
|
||||||
where scopedBlockChildren = withExtendedScope blockChildren
|
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 []
|
params = symbol BlockParameters *> children (many parameter) <|> pure []
|
||||||
|
|
||||||
comment :: Assignment
|
comment :: Assignment
|
||||||
comment = makeTerm <$> symbol Comment <*> (Comment.Comment <$> source)
|
comment = makeTerm <$> symbol Comment <*> (Comment.Comment <$> source)
|
||||||
|
|
||||||
alias :: Assignment
|
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)
|
where name' = makeTerm <$> location <*> (Syntax.Identifier . name <$> source)
|
||||||
|
|
||||||
undef :: Assignment
|
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)
|
where name' = makeTerm <$> location <*> (Syntax.Identifier . name <$> source)
|
||||||
|
|
||||||
if' :: Assignment
|
if' :: Assignment
|
||||||
@ -445,7 +445,7 @@ unary = symbol Unary >>= \ location ->
|
|||||||
makeTerm location . Expression.Complement <$> children ( symbol AnonTilde *> expression )
|
makeTerm location . Expression.Complement <$> children ( symbol AnonTilde *> expression )
|
||||||
<|> makeTerm location . Expression.Not <$> children ( symbol AnonBang *> expression )
|
<|> makeTerm location . Expression.Not <$> children ( symbol AnonBang *> expression )
|
||||||
<|> makeTerm location . Expression.Not <$> children ( symbol AnonNot *> 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 )
|
<|> makeTerm location . Expression.Negate <$> children ( symbol AnonMinus' *> expression )
|
||||||
<|> children ( symbol AnonPlus *> expression )
|
<|> children ( symbol AnonPlus *> expression )
|
||||||
|
|
||||||
|
@ -291,7 +291,7 @@ null' :: Assignment
|
|||||||
null' = makeTerm <$> symbol Null <*> (Literal.Null <$ rawSource)
|
null' = makeTerm <$> symbol Null <*> (Literal.Null <$ rawSource)
|
||||||
|
|
||||||
anonymousClass :: Assignment
|
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 :: Assignment
|
||||||
abstractClass = makeTerm <$> symbol Grammar.AbstractClass <*> children (TypeScript.Syntax.AbstractClass <$> term identifier <*> (term typeParameters <|> emptyTerm) <*> (classHeritage' <|> pure []) <*> classBodyStatements)
|
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' :: Assignment
|
||||||
class' = makeClass <$> symbol Class <*> children ((,,,,) <$> manyTerm decorator <*> term identifier <*> (symbol TypeParameters *> children (manyTerm typeParameter') <|> pure []) <*> (classHeritage' <|> pure []) <*> classBodyStatements)
|
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 :: Assignment
|
||||||
object = makeTerm <$> (symbol Object <|> symbol ObjectPattern) <*> children (Literal.Hash <$> manyTerm (pair <|> spreadElement <|> methodDefinition <|> assignmentPattern <|> shorthandPropertyIdentifier))
|
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)
|
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 :: 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
|
where
|
||||||
contextualize' (cs, formalParams) = case nonEmpty cs of
|
contextualize' (cs, formalParams) = case nonEmpty cs of
|
||||||
Just cs -> toList cs ++ formalParams
|
Just cs -> toList cs <> formalParams
|
||||||
Nothing -> formalParams
|
Nothing -> formalParams
|
||||||
postContextualize' formalParams cs = case nonEmpty cs of
|
postContextualize' formalParams cs = case nonEmpty cs of
|
||||||
Just cs -> formalParams ++ toList cs
|
Just cs -> formalParams <> toList cs
|
||||||
Nothing -> formalParams
|
Nothing -> formalParams
|
||||||
|
|
||||||
|
|
||||||
@ -573,13 +573,13 @@ statementBlock :: Assignment
|
|||||||
statementBlock = makeTerm <$> symbol StatementBlock <*> children (manyTerm statement)
|
statementBlock = makeTerm <$> symbol StatementBlock <*> children (manyTerm statement)
|
||||||
|
|
||||||
classBodyStatements :: Assignment
|
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
|
where
|
||||||
contextualize' (cs, formalParams) = case nonEmpty cs of
|
contextualize' (cs, formalParams) = case nonEmpty cs of
|
||||||
Just cs -> toList cs ++ formalParams
|
Just cs -> toList cs <> formalParams
|
||||||
Nothing -> formalParams
|
Nothing -> formalParams
|
||||||
postContextualize' formalParams cs = case nonEmpty cs of
|
postContextualize' formalParams cs = case nonEmpty cs of
|
||||||
Just cs -> formalParams ++ toList cs
|
Just cs -> formalParams <> toList cs
|
||||||
Nothing -> formalParams
|
Nothing -> formalParams
|
||||||
|
|
||||||
publicFieldDefinition :: Assignment
|
publicFieldDefinition :: Assignment
|
||||||
|
@ -1,9 +1,9 @@
|
|||||||
module Main (main) where
|
module Main (main) where
|
||||||
|
|
||||||
import Language.Haskell.HLint (hlint)
|
import Language.Haskell.HLint (Severity(..), hlint, suggestionSeverity)
|
||||||
import System.Exit (exitFailure, exitSuccess)
|
import System.Exit (exitFailure, exitSuccess)
|
||||||
|
|
||||||
main :: IO ()
|
main :: IO ()
|
||||||
main = do
|
main = do
|
||||||
hints <- hlint [ "--language=TypeApplications", "src" ]
|
hints <- hlint [ "src" ]
|
||||||
if null hints then exitSuccess else exitFailure
|
if null (filter ((>= Warning) . suggestionSeverity) hints) then exitSuccess else exitFailure
|
||||||
|
Loading…
Reference in New Issue
Block a user