Merge pull request #353 from github/hlint-in-ci-again

Run hlint in CI again.

.hlint.yaml

@@ -34,6 +34,10 @@
 # Change the severity of hints we don’t want to fail CI for
 - suggest: {name: Eta reduce}
 
+# While I think DerivingStrategies is good, it's too noisy to suggest by default
+- ignore:
+    name: Use DerivingStrategies
+
 # Ignore eta reduce in the assignment modules
 - ignore:
     name: Eta reduce
@@ -45,8 +49,29 @@
 
 - ignore: {name: Use ., within: [Analysis.Abstract.Graph.graphingModules, Semantic.Distribute]}
 
-- ignore: {name: Reduce duplication, within: [Semantic.Util, Semantic.UtilDisabled]}
+- ignore:
-- ignore: {name: Use newtype instead of data, within: [Semantic.Api.V1.CodeAnalysisPB]}
+    within:
+      - Proto.Semantic
+      - Proto.Semantic_Fields
+      - Proto.Semantic_JSON
+
+- ignore:
+    name: Reduce duplication
+    within:
+      - Semantic.Util
+
+# hlint has issues with QuantifiedConstraints (see https://github.com/ndmitchell/hlint/issues/759)
+# Once the above is fixed, we can drop this error.
+
+- ignore: { name: Parse error }
+
+# hlint is too paranoid about NonEmpty functions (https://github.com/ndmitchell/hlint/issues/787)
+
+- ignore:
+    name: Avoid restricted function
+    within:
+      - Language.Python.Syntax
+      - Data.Syntax.Expression
 
 # Our customized warnings
 

.travis.yml

@@ -24,9 +24,14 @@ matrix:
 
 before_install:
 - mkdir -p $HOME/.local/bin
+- curl -L -o /tmp/hlint.tar.gz "https://github.com/ndmitchell/hlint/releases/download/v2.2.3/hlint-2.2.3-x86_64-linux.tar.gz"
+- tar -xf /tmp/hlint.tar.gz -C /tmp
+- cp /tmp/hlint-2.2.3/hlint $HOME/.local/bin
+- cp -r /tmp/hlint-2.2.3/data $HOME/.local/bin
 - "PATH=/opt/ghc/bin:$HOME/local/bin:$PATH"
 - ghc --version
 - cabal --version
+- hlint --version
 
 install:
 - cabal v2-update -v
@@ -34,6 +39,7 @@ install:
 - cabal v2-build --only-dependencies
 
 script:
+- hlint src semantic-python
 - cabal v2-build
 - cabal v2-run semantic:test
 - cabal v2-run semantic-core:test

semantic-python/test/Directive.hs

@@ -7,8 +7,8 @@ module Directive ( Directive (..)
 import           Control.Applicative
 import           Control.Monad
 import           Core.Core (Core)
-import qualified Core.Parser as Core.Parser
+import qualified Core.Parser
-import qualified Core.Pretty as Core.Pretty
+import qualified Core.Pretty
 import           Core.Name (Name)
 import           Data.ByteString.Char8 (ByteString)
 import qualified Data.ByteString.Char8 as ByteString

semantic-python/test/Instances.hs

@@ -1,4 +1,4 @@
-{-# LANGUAGE DeriveAnyClass, DerivingStrategies, GeneralizedNewtypeDeriving, LambdaCase, StandaloneDeriving, FlexibleInstances, NamedFieldPuns, OverloadedStrings, QuantifiedConstraints, TypeOperators, UndecidableInstances, TypeApplications #-}
+{-# LANGUAGE DerivingStrategies, GeneralizedNewtypeDeriving, StandaloneDeriving, FlexibleInstances, NamedFieldPuns, OverloadedStrings, QuantifiedConstraints, TypeOperators, UndecidableInstances #-}
 {-# OPTIONS_GHC -fno-warn-orphans #-}
 
 module Instances () where

src/Control/Abstract/Value.hs

@@ -292,15 +292,9 @@ liftNumeric2 :: (Member (Numeric value) sig, Carrier sig m)
              -> m value
 liftNumeric2 t v1 v2 = send (LiftNumeric2 (Numeric2Function t) v1 v2 pure)
 
-data NumericFunction = NumericFunction (forall a . Num a => a -> a)
+newtype NumericFunction = NumericFunction { runNumericFunction :: forall a . Num a => a -> a }
 
-runNumericFunction :: Num a => NumericFunction -> a -> a
+newtype Numeric2Function = Numeric2Function { runNumeric2Function :: forall a b. Number a -> Number b -> SomeNumber }
-runNumericFunction (NumericFunction f) a = f a
-
-data Numeric2Function = Numeric2Function (forall a b. Number a -> Number b -> SomeNumber)
-
-runNumeric2Function :: Numeric2Function -> Number a -> Number b -> SomeNumber
-runNumeric2Function (Numeric2Function f) a b = f a b
 
 data Numeric value (m :: * -> *) k
   = Integer Integer (value -> m k)
@@ -347,15 +341,9 @@ unsignedRShift :: (Member (Bitwise value) sig, Carrier sig m)
                -> m value
 unsignedRShift v1 v2 = send (UnsignedRShift v1 v2 pure)
 
-data BitwiseFunction = BitwiseFunction (forall a . Bits a => a -> a)
+newtype BitwiseFunction = BitwiseFunction { runBitwiseFunction :: forall a . Bits a => a -> a }
 
-runBitwiseFunction :: Bits a => BitwiseFunction -> a -> a
+newtype Bitwise2Function = Bitwise2Function { runBitwise2Function :: forall a . (Integral a, Bits a) => a -> a -> a }
-runBitwiseFunction (BitwiseFunction f) a = f a
-
-data Bitwise2Function = Bitwise2Function (forall a . (Integral a, Bits a) => a -> a -> a)
-
-runBitwise2Function :: (Integral a, Bits a) => Bitwise2Function -> a -> a -> a
-runBitwise2Function (Bitwise2Function f) a b = f a b
 
 data Bitwise value (m :: * -> *) k
   = CastToInteger value (value -> m k)

src/Control/Carrier/Parse/Simple.hs

@@ -63,7 +63,7 @@ runParser timeout blob@Blob{..} parser = case parser of
     let term = cmarkParser blobSource
     in length term `seq` pure term
 
-data ParseFailure = ParseFailure String
+newtype ParseFailure = ParseFailure String
   deriving (Show, Typeable)
 
 instance Exception ParseFailure

src/Data/Diff.hs

@@ -1,4 +1,4 @@
-{-# LANGUAGE DataKinds, RankNTypes, TypeFamilies, TypeOperators, ScopedTypeVariables, UndecidableInstances #-}
+{-# LANGUAGE DataKinds, LambdaCase, RankNTypes, TypeFamilies, TypeOperators, ScopedTypeVariables, UndecidableInstances #-}
 module Data.Diff
 ( Diff(..)
 , DiffF(..)
@@ -76,7 +76,7 @@ merging = cata (\ (In ann syntax) -> mergeF (In (ann, ann) syntax))
 
 
 diffPatches :: (Foldable syntax, Functor syntax) => Diff syntax ann1 ann2 -> [Edit (TermF syntax ann1 (Diff syntax ann1 ann2)) (TermF syntax ann2 (Diff syntax ann1 ann2))]
-diffPatches = para $ \ diff -> case diff of
+diffPatches = para $ \case
   Patch patch -> bimap (fmap fst) (fmap fst) patch : bifoldMap (foldMap snd) (foldMap snd) patch
   Merge merge -> foldMap snd merge
 

src/Data/ImportPath.hs

@@ -19,8 +19,9 @@ data ImportPath = ImportPath { unPath :: FilePath, pathIsRelative :: IsRelative
 importPath :: Text -> ImportPath
 importPath str = let path = stripQuotes str in ImportPath (T.unpack path) (pathType path)
   where
-    pathType xs | not (T.null xs), T.head xs == '.' = Relative -- head call here is safe
+    pathType xs | startsWithDot xs = Relative -- head call here is safe
-                | otherwise = NonRelative
+                | otherwise        = NonRelative
+    startsWithDot t = fmap fst (T.uncons t) == Just '.'
 
 defaultAlias :: ImportPath -> Name
 defaultAlias = name . T.pack . takeFileName . unPath

src/Data/Syntax/Declaration.hs

@@ -216,9 +216,7 @@ instance Evaluatable Class where
     currentScope' <- currentScope
 
     superScopes <- for classSuperclasses $ \superclass -> do
-      name <- case declaredName superclass of
+      name <- maybeM gensym (declaredName superclass)
-                Just name -> pure name
-                Nothing   -> gensym
       scope <- associatedScope (Declaration name)
       slot <- lookupSlot (Declaration name)
       superclassFrame <- scopedEnvironment =<< deref slot

src/Diffing/Algorithm/SES.hs

@@ -1,4 +1,4 @@
-{-# LANGUAGE BangPatterns, GADTs, LambdaCase, MultiParamTypeClasses, ScopedTypeVariables #-}
+{-# LANGUAGE BangPatterns, GADTs, MultiParamTypeClasses, ScopedTypeVariables #-}
 module Diffing.Algorithm.SES
 ( ses
 ) where

src/Rendering/TOC.hs

@@ -76,7 +76,7 @@ tableOfContentsBy :: (Foldable f, Functor f)
                   => (forall b. TermF f ann b -> Maybe a) -- ^ A function mapping relevant nodes onto values in Maybe.
                   -> Diff f ann ann                       -- ^ The diff to compute the table of contents for.
                   -> [(Change, a)]                        -- ^ A list of entries for relevant changed nodes in the diff.
-tableOfContentsBy selector = fromMaybe [] . cata (\ r -> case r of
+tableOfContentsBy selector = fromMaybe [] . cata (\case
   Patch edit -> (pure . patchEntry <$> select (bimap selector selector edit)) <> bifoldMap fold fold edit <> Just []
   Merge (In (_, ann2) r) -> case (selector (In ann2 r), fold r) of
     (Just a, Just entries) -> Just ((Changed, a) : entries)

src/Semantic/Analysis.hs

@@ -46,10 +46,10 @@ type DomainC term address value m
 -- | Evaluate a list of modules with the prelude for the passed language available, and applying the passed function to every module.
 evaluate :: ( Carrier outerSig outer
             , derefSig ~ (Deref value :+: allocatorSig)
-            , derefC ~ (DerefC address value allocatorC)
+            , derefC ~ DerefC address value allocatorC
             , Carrier derefSig derefC
             , allocatorSig ~ (Allocator address :+: Reader ModuleInfo :+: outerSig)
-            , allocatorC ~ (AllocatorC address (ReaderC ModuleInfo outer))
+            , allocatorC ~ AllocatorC address (ReaderC ModuleInfo outer)
             , Carrier allocatorSig allocatorC
             , Effect outerSig
             , Member Fresh outerSig

src/Semantic/Api/Bridge.hs

@@ -1,4 +1,4 @@
-{-# LANGUAGE FunctionalDependencies, LambdaCase #-}
+{-# LANGUAGE FunctionalDependencies #-}
 module Semantic.Api.Bridge
   ( APIBridge (..)
   , APIConvert (..)

src/Semantic/Task.hs

@@ -1,5 +1,5 @@
 {-# LANGUAGE ConstraintKinds, ExistentialQuantification, GADTs, GeneralizedNewtypeDeriving, KindSignatures,
-             ScopedTypeVariables, StandaloneDeriving, TypeOperators, UndecidableInstances #-}
+             ScopedTypeVariables, TypeOperators, UndecidableInstances #-}
 module Semantic.Task
 ( TaskC
 , Level(..)

src/Serializing/SExpression/Precise.hs

@@ -1,4 +1,4 @@
-{-# LANGUAGE AllowAmbiguousTypes, DataKinds, FlexibleContexts, FlexibleInstances, KindSignatures, MultiParamTypeClasses, OverloadedStrings, ScopedTypeVariables, TypeApplications, TypeFamilies, TypeOperators, UndecidableInstances #-}
+{-# LANGUAGE AllowAmbiguousTypes, DataKinds, FlexibleContexts, FlexibleInstances, MultiParamTypeClasses, OverloadedStrings, ScopedTypeVariables, TypeApplications, TypeFamilies, TypeOperators, UndecidableInstances #-}
 module Serializing.SExpression.Precise
 ( serializeSExpression
 , ToSExpression(..)

src/Tags/Taggable.hs

@@ -12,7 +12,7 @@ identify a new syntax as Taggable, you need to:
 constructor name of this syntax.
 
 -}
-{-# LANGUAGE AllowAmbiguousTypes, ConstraintKinds, KindSignatures, ScopedTypeVariables, TypeFamilies, UndecidableInstances #-}
+{-# LANGUAGE AllowAmbiguousTypes, ConstraintKinds, ScopedTypeVariables, TypeFamilies, UndecidableInstances #-}
 module Tags.Taggable
 ( Tagger
 , Token(..)

src/Tags/Tagging.hs

@@ -57,12 +57,11 @@ contextualizing :: ( Member (State [ContextToken]) sig
 contextualizing source toKind = Streaming.mapMaybeM $ \case
   Enter x r -> Nothing <$ enterScope (x, r)
   Exit  x r -> Nothing <$ exitScope (x, r)
-  Iden iden loc docsLiteralRange -> get @[ContextToken] >>= pure . \case
+  Iden iden loc docsLiteralRange -> fmap go (get @[ContextToken]) where
-    ((x, r):("Context", cr):_) | Just kind <- toKind x
+    go = \case
-      -> Just $ Tag iden kind loc (firstLine (slice r)) (Just (slice cr))
+      ((x, r):("Context", cr):_) | Just kind <- toKind x -> Just $ Tag iden kind loc (firstLine (slice r)) (Just (slice cr))
-    ((x, r):_) | Just kind <- toKind x
+      ((x, r):_) | Just kind <- toKind x -> Just $ Tag iden kind loc (firstLine (slice r)) (slice <$> docsLiteralRange)
-      -> Just $ Tag iden kind loc (firstLine (slice r)) (slice <$> docsLiteralRange)
+      _ -> Nothing
-    _ -> Nothing
   where
     slice = stripEnd . Source.toText . Source.slice source
     firstLine = T.take 180 . fst . breakOn "\n"