implement hlint suggestions

src/bin/ProjectM36/Cli.hs

@@ -1,4 +1,4 @@
-{-# LANGUAGE LambdaCase, DeriveGeneric #-}
+{-# LANGUAGE LambdaCase #-}
 -- functions common to both tutd and sqlegacy command line interfaces
 module ProjectM36.Cli where
 import qualified ProjectM36.Client as C

src/bin/SQL/Interpreter/Base.hs

@@ -4,6 +4,7 @@ import Text.Megaparsec
 import Text.Megaparsec.Char
 import qualified Text.Megaparsec.Char.Lexer as Lex
 import Data.Text as T (Text, singleton, pack, splitOn, toLower)
+import Data.Functor (($>))
 
 -- consumes only horizontal spaces
 spaceConsumer :: Parser ()
@@ -23,8 +24,7 @@ reserveds words' = do
   reserveds' words''
 
 reserveds' :: [Text] -> Parser ()
-reserveds' words' =
-  sequence_ (map reserved words')
+reserveds' = mapM_ reserved 
 
 -- does not consume trailing spaces
 qualifiedNameSegment :: Text -> Parser Text
@@ -51,7 +51,7 @@ identifierRemainder c = do
   pure (pack (c:rest))
 
 symbol :: Text -> Parser Text
-symbol sym = Lex.symbol spaceConsumer sym
+symbol = Lex.symbol spaceConsumer
 
 comma :: Parser Text
 comma = symbol ","
@@ -86,7 +86,7 @@ quotedIdentifier =
   (T.pack <$> (doubleQuote *> many (escapedDoubleQuote <|> notDoubleQuote) <* doubleQuote)) <* spaceConsumer
   where
     doubleQuote = char '"'
-    escapedDoubleQuote = chunk "\"\"" *> pure '"'
+    escapedDoubleQuote = chunk "\"\"" $> '"'
     notDoubleQuote = satisfy ('"' /=)
 
 

src/bin/SQL/Interpreter/CreateTable.hs

@@ -6,6 +6,7 @@ import SQL.Interpreter.Base
 import ProjectM36.Interpreter
 import Text.Megaparsec
 import Control.Monad.Permutations
+import Data.Functor (($>))
 
 createTableP :: Parser CreateTable
 createTableP = do
@@ -25,7 +26,7 @@ columnNamesAndTypesP =
     pure (colName, colType, perColConstraints) 
 
 columnTypeP :: Parser ColumnType
-columnTypeP = choice (map (\(nam, typ) -> reserved nam *> pure typ) types)
+columnTypeP = choice (map (\(nam, typ) -> reserved nam $> typ) types)
   where
     types = [("integer", IntegerColumnType),
              ("int", IntegerColumnType),
@@ -50,11 +51,11 @@ perColConstraintsP :: Parser PerColumnConstraints
 perColConstraintsP = do
   parsed <- runPermutation $
     PerColumnConstraintsParse <$>
-      toPermutationWithDefault False (try (reserveds "not null" *> pure True)) <*>
-      toPermutationWithDefault False (reserved "unique" *> pure True) <*>
-      toPermutationWithDefault False (reserved "primary key" *> pure True) <*>
+      toPermutationWithDefault False (try (reserveds "not null" $> True)) <*>
+      toPermutationWithDefault False (reserved "unique" $> True) <*>
+      toPermutationWithDefault False (reserved "primary key" $> True) <*>
       toPermutationWithDefault Nothing (Just <$> referencesP)
-  pure (PerColumnConstraints { notNullConstraint = (parse_notNullConstraint parsed) || (parse_primaryKeyConstraint parsed),
-                               uniquenessConstraint = (parse_uniquenessConstraint parsed) || (parse_primaryKeyConstraint parsed),
+  pure (PerColumnConstraints { notNullConstraint = parse_notNullConstraint parsed || parse_primaryKeyConstraint parsed,
+                               uniquenessConstraint = parse_uniquenessConstraint parsed || parse_primaryKeyConstraint parsed,
                                references = parse_references parsed })
 

src/bin/SQL/Interpreter/ImportBasicExample.hs

@@ -3,7 +3,7 @@ import qualified Data.Text as T
 import SQL.Interpreter.Base
 import ProjectM36.Interpreter
 
-data ImportBasicExampleOperator = ImportBasicExampleOperator T.Text
+newtype ImportBasicExampleOperator = ImportBasicExampleOperator T.Text
   deriving (Show)
 
 importBasicExampleP :: Parser ImportBasicExampleOperator

src/bin/SQL/Interpreter/Select.hs

@@ -1,4 +1,4 @@
-{-# LANGUAGE TemplateHaskell, KindSignatures, TypeFamilies, DeriveTraversable, GeneralizedNewtypeDeriving #-}
+{-# LANGUAGE TypeFamilies #-}
 module SQL.Interpreter.Select where
 import ProjectM36.Interpreter
 import ProjectM36.SQL.Select
@@ -31,7 +31,7 @@ queryP = E.makeExprParser queryTermP queryOpP
     infixOpP nam op =
       E.InfixL $ do
         reserved nam
-        pure (\a b -> QueryOp op a b)
+        pure (QueryOp op)
 
 valuesP :: Parser [[ScalarExpr]]
 valuesP = do
@@ -77,7 +77,7 @@ tableExprP =
 fromP :: Parser [TableRef]
 fromP = reserved "from" *> (concat <$> sepByComma trefs)
   where
-    trefs = ((:) <$> nonJoinTref <*> many joinP)
+    trefs = (:) <$> nonJoinTref <*> many joinP
     nonJoinTref = choice [parens $ QueryTableRef <$> selectP,
                           try (AliasedTableRef <$> simpleRef <*> (reserved "as" *> tableAliasP)),
                           simpleRef]
@@ -123,7 +123,7 @@ havingP = reserved "having" *> (HavingExpr <$> scalarExprP)
 
 orderByP :: Parser [SortExpr]
 orderByP =
-  reserveds "order by" *> (sepByComma1 (SortExpr <$> scalarExprP <*> optional directionP <*> optional nullsOrderP))
+  reserveds "order by" *> sepByComma1 (SortExpr <$> scalarExprP <*> optional directionP <*> optional nullsOrderP)
   where
     directionP = (reserved "asc" $> Ascending) <|>
                  (reserved "desc" $> Descending)
@@ -179,7 +179,7 @@ scalarExprOp =
    binarySymbolL s = E.InfixL $ binary s
    binary s = do
      op <- qualifiedOperatorP s
-     pure (\a b -> BinaryOperator a op b)
+     pure (`BinaryOperator` op)
    binarySymbolR s = E.InfixR $ binary s
    binarySymbolN s = E.InfixN $ binary s
    qComparisonOp = E.Postfix $ try quantifiedComparisonSuffixP
@@ -280,7 +280,7 @@ stringLiteralP = StringLiteral <$> stringP
 
 nullLiteralP :: Parser (ScalarExprBase a)
 nullLiteralP = 
-  reserved "NULL" *> pure NullLiteral
+  reserved "NULL" $> NullLiteral
 
 scalarTermP :: QualifiedNameP a => Parser (ScalarExprBase a)
 scalarTermP = choice [
@@ -359,7 +359,7 @@ offsetP = optional (reserved "offset" *> integer)
 withP :: Parser WithClause
 withP = do
   reserved "with"
-  recursive <- try (reserved "recursive" *> pure True) <|> pure False  
+  recursive <- try (reserved "recursive" $> True) <|> pure False  
   wExprs <- sepByComma1 $ do
     wName <- withExprAliasP
     reserved "as"

src/bin/SQL/Interpreter/TransactionGraphOperator.hs

@@ -2,6 +2,7 @@ module SQL.Interpreter.TransactionGraphOperator where
 import ProjectM36.Interpreter
 import SQL.Interpreter.Base
 import Control.Applicative
+import Data.Functor (($>))
 
 data TransactionGraphOperator = Commit | Rollback
   deriving (Show, Eq)
@@ -10,7 +11,7 @@ transactionGraphOperatorP :: Parser TransactionGraphOperator
 transactionGraphOperatorP = commitP <|> rollbackP
 
 commitP :: Parser TransactionGraphOperator
-commitP = reserved "commit" *> pure Commit
+commitP = reserved "commit" $> Commit
 
 rollbackP :: Parser TransactionGraphOperator
-rollbackP = reserved "rollback" *> pure Rollback
+rollbackP = reserved "rollback" $> Rollback

src/bin/TutorialD/Interpreter.hs

@@ -1,4 +1,4 @@
-{-# LANGUAGE GADTs, LambdaCase, CPP #-}
+{-# LANGUAGE GADTs, CPP #-}
 module TutorialD.Interpreter where
 import ProjectM36.Interpreter
 import TutorialD.Interpreter.Base

src/bin/TutorialD/Interpreter/Base.hs

@@ -1,4 +1,4 @@
-{-# LANGUAGE DeriveGeneric, CPP #-}
+{-# LANGUAGE CPP #-}
 module TutorialD.Interpreter.Base (
   module TutorialD.Interpreter.Base,
   module Text.Megaparsec,

src/bin/TutorialD/Interpreter/RODatabaseContextOperator.hs

@@ -203,8 +203,7 @@ interpretRODatabaseContextOp sessionId conn tutdstring = case parse roDatabaseCo
 showDataFrameP :: Parser RODatabaseContextOperator
 showDataFrameP = do
   colonOp ":showdataframe"
-  dfExpr <- dataFrameP
-  pure (ShowDataFrame dfExpr)
+  ShowDataFrame <$> dataFrameP
 
 dataFrameP :: Parser DF.DataFrameExpr
 dataFrameP = do

src/bin/TutorialD/Interpreter/RelationalExpr.hs

@@ -245,8 +245,7 @@ ifThenAtomExprP = do
   reserved "then"
   thenE <- atomExprP
   reserved "else"
-  elseE <- atomExprP
-  pure (IfThenAtomExpr ifE thenE elseE)
+  IfThenAtomExpr ifE thenE <$> atomExprP
 
 functionAtomExprP :: RelationalMarkerExpr a => Parser (AtomExprBase a)
 functionAtomExprP =

src/bin/TutorialD/Printer.hs

@@ -178,7 +178,7 @@ instance Pretty RestrictionPredicateExpr where
 
 prettyAttributeName :: AttributeName -> Doc a
 prettyAttributeName attrName | nameNeedsQuoting attrName = pretty $ "`" <> attrName <> "`"
-prettyAttributeName attrName = pretty $ attrName 
+prettyAttributeName attrName = pretty attrName 
 
 instance Pretty WithNameExpr where
   pretty (WithNameExpr name _) = pretty name

src/lib/ProjectM36/Relation.hs

@@ -80,12 +80,12 @@ singletonTuple rel@(Relation _ tupleSet) = if cardinality rel == Finite 1 then
 
 -- this is still unncessarily expensive for (bigx union bigx) because each tuple is hashed and compared for equality (when the hashes match), but the major expense is attributesEqual, but we already know that all tuple attributes are equal (it's a precondition)
 union :: Relation -> Relation -> Either RelationalError Relation
-union (Relation attrs1 tupSet1) (Relation attrs2 tupSet2) =
-  if not (A.attributeNameSet attrs1 == A.attributeNameSet attrs2) then
+union (Relation attrs1 tupSet1) (Relation attrs2 tupSet2) 
+  | A.attributeNameSet attrs1 /= A.attributeNameSet attrs2 =
     Left $ AttributeNamesMismatchError (A.attributeNameSet (A.attributesDifference attrs1 attrs2))
-  else if not (A.attributesEqual attrs1 attrs2) then
+  | not (A.attributesEqual attrs1 attrs2) =
     Left $ AttributeTypesMismatchError $ A.attributesDifference attrs1 attrs2
-  else
+  | otherwise =
     Right $ Relation attrs1 newtuples
   where
     newtuples = tupleSetUnion attrs1 tupSet1 tupSet2

src/lib/ProjectM36/RelationalExpression.hs

@@ -337,7 +337,7 @@ evalGraphRefDatabaseContextExpr (Update relVarName atomExprMap pred') = do
           else 
             tmpAttrName
       updateAttr nam atomExpr = Extend (AttributeExtendTupleExpr (tmpAttr nam) atomExpr)
-      projectAndRename attr expr = Rename (S.singleton ((tmpAttr attr), attr)) (Project (InvertedAttributeNames (S.singleton attr)) expr)
+      projectAndRename attr expr = Rename (S.singleton (tmpAttr attr, attr)) (Project (InvertedAttributeNames (S.singleton attr)) expr)
       restrictedPortion = Restrict pred' rvExpr
       updated = foldr (\(oldname, atomExpr) accum ->
                                  let procAtomExpr = runProcessExprM UncommittedContextMarker (processAtomExpr atomExpr) in