Merge branch 'master' into topologically-sorted-imports

.hlint.yaml

@@ -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}

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

src/Analysis/Abstract/Caching.hs

@@ -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 $

src/Data/Abstract/Evaluatable.hs

@@ -61,7 +61,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 (LoopControl address ': Return address ': Env address ': Allocator address value ': Reader ModuleInfo ': Modules address ': effects)

src/Data/Functor/Classes/Generic.hs

@@ -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

src/Data/Record.hs

@@ -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

src/Data/Scientific/Exts.hs

@@ -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) #-}

src/Data/Syntax.hs

@@ -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

src/Language/Go/Assignment.hs

@@ -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)

src/Language/Go/Syntax.hs

@@ -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

src/Language/Haskell/Assignment.hs

@@ -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)
 

src/Language/Java/Assignment.hs

@@ -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)

src/Language/PHP/Assignment.hs

@@ -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)

src/Language/Ruby/Assignment.hs

@@ -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 )
 

src/Language/TypeScript/Assignment.hs

@@ -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

test/Lint.hs

@@ -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