diff --git a/.hlint.yaml b/.hlint.yaml index e8e2be0e8..4111be9a7 100644 --- a/.hlint.yaml +++ b/.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: {name: Use newtype instead of data, within: [Semantic.Api.V1.CodeAnalysisPB]} +- ignore: + 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 diff --git a/.travis.yml b/.travis.yml index 190f87e38..12ea1e630 100644 --- a/.travis.yml +++ b/.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 diff --git a/semantic-python/test/Directive.hs b/semantic-python/test/Directive.hs index db95ff4dc..cd81413e4 100644 --- a/semantic-python/test/Directive.hs +++ b/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.Pretty as Core.Pretty +import qualified Core.Parser +import qualified Core.Pretty import Core.Name (Name) import Data.ByteString.Char8 (ByteString) import qualified Data.ByteString.Char8 as ByteString diff --git a/semantic-python/test/Instances.hs b/semantic-python/test/Instances.hs index 8e038b6e2..857f0f7b8 100644 --- a/semantic-python/test/Instances.hs +++ b/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 diff --git a/src/Control/Abstract/Value.hs b/src/Control/Abstract/Value.hs index a5bc48e1f..ca7165132 100644 --- a/src/Control/Abstract/Value.hs +++ b/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 -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 +newtype Numeric2Function = Numeric2Function { runNumeric2Function :: forall a b. Number a -> Number b -> SomeNumber } 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 -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 +newtype Bitwise2Function = Bitwise2Function { runBitwise2Function :: forall a . (Integral a, Bits a) => a -> a -> a } data Bitwise value (m :: * -> *) k = CastToInteger value (value -> m k) diff --git a/src/Control/Carrier/Parse/Simple.hs b/src/Control/Carrier/Parse/Simple.hs index 4dc1d6243..12dc5dcbe 100644 --- a/src/Control/Carrier/Parse/Simple.hs +++ b/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 diff --git a/src/Data/Diff.hs b/src/Data/Diff.hs index a1bb48be6..2e89e98fb 100644 --- a/src/Data/Diff.hs +++ b/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 diff --git a/src/Data/ImportPath.hs b/src/Data/ImportPath.hs index 22f9201a2..a85cd16ba 100644 --- a/src/Data/ImportPath.hs +++ b/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 - | otherwise = NonRelative + pathType xs | startsWithDot xs = Relative -- head call here is safe + | otherwise = NonRelative + startsWithDot t = fmap fst (T.uncons t) == Just '.' defaultAlias :: ImportPath -> Name defaultAlias = name . T.pack . takeFileName . unPath diff --git a/src/Data/Syntax/Declaration.hs b/src/Data/Syntax/Declaration.hs index 0c166d8f9..6eff484f5 100644 --- a/src/Data/Syntax/Declaration.hs +++ b/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 - Just name -> pure name - Nothing -> gensym + name <- maybeM gensym (declaredName superclass) scope <- associatedScope (Declaration name) slot <- lookupSlot (Declaration name) superclassFrame <- scopedEnvironment =<< deref slot diff --git a/src/Diffing/Algorithm/SES.hs b/src/Diffing/Algorithm/SES.hs index ae83362d6..067120436 100644 --- a/src/Diffing/Algorithm/SES.hs +++ b/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 diff --git a/src/Rendering/TOC.hs b/src/Rendering/TOC.hs index 169d7a63e..6033afc03 100644 --- a/src/Rendering/TOC.hs +++ b/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) diff --git a/src/Semantic/Analysis.hs b/src/Semantic/Analysis.hs index 3b7d702b3..e66361d6d 100644 --- a/src/Semantic/Analysis.hs +++ b/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 diff --git a/src/Semantic/Api/Bridge.hs b/src/Semantic/Api/Bridge.hs index 3047e2556..1c3c66c19 100644 --- a/src/Semantic/Api/Bridge.hs +++ b/src/Semantic/Api/Bridge.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE FunctionalDependencies, LambdaCase #-} +{-# LANGUAGE FunctionalDependencies #-} module Semantic.Api.Bridge ( APIBridge (..) , APIConvert (..) diff --git a/src/Semantic/Task.hs b/src/Semantic/Task.hs index 351296fbc..5ee650b0a 100644 --- a/src/Semantic/Task.hs +++ b/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(..) diff --git a/src/Semantic/Task/Files.hs b/src/Semantic/Task/Files.hs index c3f2e0cb7..092c07011 100644 --- a/src/Semantic/Task/Files.hs +++ b/src/Semantic/Task/Files.hs @@ -14,7 +14,6 @@ module Semantic.Task.Files , Handle (..) , FilesC(..) , FilesArg(..) - , PathFilter(..) ) where import Control.Effect.Carrier @@ -42,12 +41,6 @@ data Source blob where data Destination = ToPath Path.AbsRelFile | ToHandle (Handle 'IO.WriteMode) -data PathFilter - = ExcludePaths [FilePath] - | ExcludeFromHandle (Handle 'IO.ReadMode) - | IncludePaths [FilePath] - | IncludePathsFromHandle (Handle 'IO.ReadMode) - -- | An effect to read/write 'Blob's from 'Handle's or 'FilePath's. data Files (m :: * -> *) k = forall a . Read (Source a) (a -> m k) diff --git a/src/Serializing/SExpression/Precise.hs b/src/Serializing/SExpression/Precise.hs index ae2cf6b21..70238e405 100644 --- a/src/Serializing/SExpression/Precise.hs +++ b/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(..) diff --git a/src/Tags/Taggable.hs b/src/Tags/Taggable.hs index c5d8eb516..b90174df2 100644 --- a/src/Tags/Taggable.hs +++ b/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(..) diff --git a/src/Tags/Tagging.hs b/src/Tags/Tagging.hs index ae2d22e2c..4b06f0855 100644 --- a/src/Tags/Tagging.hs +++ b/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 - ((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 - -> Just $ Tag iden kind loc (firstLine (slice r)) (slice <$> docsLiteralRange) - _ -> Nothing + Iden iden loc docsLiteralRange -> fmap go (get @[ContextToken]) where + go = \case + ((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 -> Just $ Tag iden kind loc (firstLine (slice r)) (slice <$> docsLiteralRange) + _ -> Nothing where slice = stripEnd . Source.toText . Source.slice source firstLine = T.take 180 . fst . breakOn "\n"