Play nice with ghcide

.hlint.yaml

@@ -1,7 +1,7 @@
 # HLint configuration file
 # https://github.com/ndmitchell/hlint
 
-- arguments: [--color=auto, -XDataKinds, -XDeriveFoldable, -XDeriveFunctor, -XDeriveGeneric, -XDeriveTraversable, -XFlexibleContexts, -XFlexibleInstances, -XMultiParamTypeClasses, -XOverloadedStrings, -XRecordWildCards, -XStandaloneDeriving, -XStrictData, -XTypeApplications, -XDerivingVia]
+- arguments: [--color=auto, -XStrictData]
 
 # Blacklist some functions by default.
 - functions:
@@ -23,7 +23,7 @@
 - warn: {group: {name: default}}
 
 # Ignore the highly noisy module export list hint
-- ignore: {name: Use module export list}
+- ignore: {name: Use explicit module export list}
 
 # Ignore some builtin hints
 - ignore: {name: Use mappend}

bench/Evaluation.hs

@@ -2,31 +2,22 @@
 
 module Evaluation (benchmarks) where
 
-import           Algebra.Graph
-import           Control.Monad
 import           Control.Carrier.Parse.Simple
 import qualified Data.Duration as Duration
 import           Data.Abstract.Evaluatable
-import           Data.Abstract.FreeVariables
 import           Data.Blob
 import           Data.Blob.IO (readBlobFromFile')
 import           Data.Bifunctor
-import           Data.Functor.Classes
-import           Data.Functor.Foldable (Base, Recursive)
-import           "semantic" Data.Graph (Graph (..), topologicalSort)
-import           Data.Graph.ControlFlowVertex
+import           "semantic" Data.Graph (topologicalSort)
 import qualified Data.Language as Language
 import           Data.Project
 import           Data.Proxy
-import           Data.Term
 import           Gauge.Main
 import           Parsing.Parser
 import           Semantic.Config (defaultOptions)
 import           Semantic.Graph
-import           Semantic.Task (SomeException, TaskSession (..), runTask, withOptions)
+import           Semantic.Task (TaskSession (..), runTask, withOptions)
 import           Semantic.Util
-import           Source.Loc
-import           Source.Span (HasSpan)
 import qualified System.Path as Path
 import           System.Path ((</>))
 
@@ -40,20 +31,22 @@ callGraphProject' :: ( Language.SLanguage lang
                   -> Path.RelFile
                   -> IO (Either String ())
 callGraphProject' session proxy path
-  | let lang = Language.reflect proxy
-  , Just (SomeParser parser) <- parserForLanguage analysisParsers lang = fmap (bimap show (const ())) . runTask session $ do
+  | Just (SomeParser parser) <- parserForLanguage analysisParsers lang = fmap (bimap show (const ())) . runTask session $ do
   blob <- readBlobFromFile' (fileForTypedPath path)
   package <- fmap snd <$> runParse (Duration.fromSeconds 10) (parsePackage parser (Project (Path.toString (Path.takeDirectory path)) [blob] lang []))
   modules <- topologicalSort <$> runImportGraphToModules proxy package
   runCallGraph proxy False modules package
+  | otherwise = error $ "Analysis not supported for: " <> show lang
+  where lang = Language.reflect proxy
 
 callGraphProject proxy paths = withOptions defaultOptions $ \ config logger statter ->
   callGraphProject' (TaskSession config "" False logger statter) proxy paths
 
 evaluateProject proxy path
-  | let lang = Language.reflect proxy
-  , Just (SomeParser parser) <- parserForLanguage analysisParsers lang = withOptions defaultOptions $ \ config logger statter ->
+  | Just (SomeParser parser) <- parserForLanguage analysisParsers lang = withOptions defaultOptions $ \ config logger statter ->
   fmap (const ()) . justEvaluating =<< evaluateProject' (TaskSession config "" False logger statter) proxy parser [Path.toString path]
+  | otherwise = error $ "Analysis not supported for: " <> show lang
+  where lang = Language.reflect proxy
 
 pyEval :: Path.RelFile -> Benchmarkable
 pyEval p = nfIO $ evaluateProject  (Proxy @'Language.Python) (Path.relDir "bench/bench-fixtures/python" </> p)

bench/Main.hs

@@ -1,4 +1,4 @@
-module Main where
+module Main (main) where
 
 import Gauge
 import qualified Evaluation

semantic.cabal

@@ -25,20 +25,22 @@ flag release
 -- GHC extensions shared between targets
 common haskell
   default-language:    Haskell2010
-  default-extensions:  DataKinds
-                     , DeriveFoldable
-                     , DeriveFunctor
-                     , DeriveGeneric
-                     , DeriveTraversable
-                     , FlexibleContexts
-                     , FlexibleInstances
-                     , MonadFailDesugaring
-                     , MultiParamTypeClasses
-                     , OverloadedStrings
-                     , RecordWildCards
-                     , StandaloneDeriving
-                     , StrictData
-                     , TypeApplications
+  default-extensions:  StrictData
+  ghc-options:
+    -Weverything
+    -Wno-missing-local-signatures
+    -Wno-missing-import-lists
+    -Wno-implicit-prelude
+    -Wno-safe
+    -Wno-unsafe
+    -Wno-name-shadowing
+    -Wno-monomorphism-restriction
+    -Wno-missed-specialisations
+    -Wno-all-missed-specialisations
+    -Wno-star-is-type
+  if (impl(ghc >= 8.8))
+    ghc-options: -Wno-missing-deriving-strategies
+
 
 -- Except in case of vendored dependencies, these deps should be expressed
 -- as caret-operator bounds relative to a version in Stackage.
@@ -74,11 +76,8 @@ common dependencies
 common executable-flags
   ghc-options:         -threaded -rtsopts "-with-rtsopts=-N -A4m -n2m"
 
-common ghc-warnings
-  ghc-options:         -Wall -Wmissing-export-lists -Wcompat -Wincomplete-record-updates -Wincomplete-uni-patterns -Wredundant-constraints -Wno-name-shadowing
-
 library
-  import:              haskell, dependencies, ghc-warnings
+  import:              haskell, dependencies
   hs-source-dirs:      src
   exposed-modules:
                      -- Analyses & term annotations
@@ -317,7 +316,7 @@ executable semantic
                      , semantic
 
 test-suite test
-  import:              haskell, dependencies, executable-flags, ghc-warnings
+  import:              haskell, dependencies, executable-flags
   type:                exitcode-stdio-1.0
   hs-source-dirs:      test
   main-is:             Spec.hs
@@ -371,8 +370,6 @@ test-suite test
                      , HUnit ^>= 1.6.0.0
                      , leancheck >= 0.8 && <1
                      , temporary ^>= 1.3
-  if flag(release)
-    ghc-options:       -dynamic
 
 test-suite parse-examples
   import:              haskell, dependencies, executable-flags

src/Analysis/Abstract/Caching/FlowInsensitive.hs

@@ -1,4 +1,4 @@
-{-# LANGUAGE GeneralizedNewtypeDeriving, TypeOperators #-}
+{-# LANGUAGE DeriveFunctor, FlexibleContexts, GeneralizedNewtypeDeriving, TypeApplications, TypeOperators #-}
 module Analysis.Abstract.Caching.FlowInsensitive
 ( cachingTerms
 , convergingModules

src/Analysis/Abstract/Caching/FlowSensitive.hs

@@ -1,4 +1,4 @@
-{-# LANGUAGE ConstraintKinds, GADTs, GeneralizedNewtypeDeriving, TypeOperators #-}
+{-# LANGUAGE ConstraintKinds, FlexibleContexts, GADTs, GeneralizedNewtypeDeriving, TypeApplications, TypeOperators #-}
 module Analysis.Abstract.Caching.FlowSensitive
 ( Cache
 , cachingTerms

src/Analysis/Abstract/Dead.hs

@@ -1,4 +1,4 @@
-{-# LANGUAGE GeneralizedNewtypeDeriving, TypeOperators #-}
+{-# LANGUAGE FlexibleContexts, FlexibleInstances, GeneralizedNewtypeDeriving, MultiParamTypeClasses, StandaloneDeriving #-}
 module Analysis.Abstract.Dead
 ( Dead(..)
 , revivingTerms

src/Analysis/Abstract/Graph.hs

@@ -1,4 +1,4 @@
-{-# LANGUAGE DerivingVia, LambdaCase, RankNTypes, ScopedTypeVariables, TypeFamilies, TypeOperators, UndecidableInstances #-}
+{-# LANGUAGE DerivingVia, FlexibleContexts, FlexibleInstances, LambdaCase, MultiParamTypeClasses, OverloadedStrings, RankNTypes, ScopedTypeVariables, TypeFamilies, UndecidableInstances #-}
 module Analysis.Abstract.Graph
 ( Graph(..)
 , ControlFlowVertex(..)
@@ -35,12 +35,12 @@ style = (defaultStyle (T.encodeUtf8Builder . vertexIdentifier))
   { vertexAttributes = vertexAttributes
   , edgeAttributes   = edgeAttributes
   }
-  where vertexAttributes Package{}       = [ "style" := "dashed", "shape" := "box" ]
-        vertexAttributes Module{}        = [ "style" := "dotted, rounded", "shape" := "box" ]
-        vertexAttributes UnknownModule{} = [ "style" := "dotted, rounded", "shape" := "box", "color" := "red", "fontcolor" := "red" ]
-        vertexAttributes Variable{..} = [ "label" := T.encodeUtf8Builder (vertexName <> " (Variable)"), "tooltip" := T.encodeUtf8Builder (showSpan vertexSpan), "style" := "rounded", "shape" := "box" ]
-        vertexAttributes Method{..}   = [ "label" := T.encodeUtf8Builder (vertexName <> " (Method)"),   "tooltip" := T.encodeUtf8Builder (showSpan vertexSpan)  , "style" := "rounded", "shape" := "box" ]
-        vertexAttributes Function{..} = [ "label" := T.encodeUtf8Builder (vertexName <> " (Function)"), "tooltip" := T.encodeUtf8Builder (showSpan vertexSpan), "style" := "rounded", "shape" := "box" ]
+  where vertexAttributes Package{}        = [ "style" := "dashed", "shape" := "box" ]
+        vertexAttributes Module{}         = [ "style" := "dotted, rounded", "shape" := "box" ]
+        vertexAttributes UnknownModule{}  = [ "style" := "dotted, rounded", "shape" := "box", "color" := "red", "fontcolor" := "red" ]
+        vertexAttributes (Variable n _ s) = [ "label" := T.encodeUtf8Builder (n <> " (Variable)"), "tooltip" := T.encodeUtf8Builder (showSpan s), "style" := "rounded", "shape" := "box" ]
+        vertexAttributes (Method   n _ s) = [ "label" := T.encodeUtf8Builder (n <> " (Method)"),   "tooltip" := T.encodeUtf8Builder (showSpan s)  , "style" := "rounded", "shape" := "box" ]
+        vertexAttributes (Function n _ s) = [ "label" := T.encodeUtf8Builder (n <> " (Function)"), "tooltip" := T.encodeUtf8Builder (showSpan s), "style" := "rounded", "shape" := "box" ]
         edgeAttributes Module{}   Module{}          = [ "len" := "5.0", "label" := "imports" ]
         edgeAttributes Module{}   UnknownModule{}   = [ "len" := "5.0", "label" := "imports" ]
         edgeAttributes Package{}  Module{}   = [ "len" := "5.0", "style" := "dashed" ]
@@ -78,7 +78,7 @@ graphingTerms recur term = do
   case toVertex definedInModule term of
     Just (v@Function{}, name) -> recurWithContext v name
     Just (v@Method{}, name) -> recurWithContext v name
-    Just (v@Variable{..}, name) -> do
+    Just (v@Variable{}, name) -> do
       variableDefinition v
       slot <- lookupSlot (Declaration name)
       defined <- gets (Map.lookup slot)

src/Analysis/Abstract/Tracing.hs

@@ -1,4 +1,4 @@
-{-# LANGUAGE TypeOperators #-}
+{-# LANGUAGE FlexibleContexts #-}
 module Analysis.Abstract.Tracing
 ( tracingTerms
 , tracing

src/Analysis/ConstructorName.hs

@@ -1,4 +1,4 @@
-{-# LANGUAGE ScopedTypeVariables, TypeFamilies, TypeOperators, UndecidableInstances #-}
+{-# LANGUAGE DataKinds, FlexibleInstances, MultiParamTypeClasses, ScopedTypeVariables, TypeApplications, TypeFamilies, TypeOperators, UndecidableInstances #-}
 module Analysis.ConstructorName
 ( ConstructorName(..)
 ) where
@@ -32,7 +32,7 @@ type family ConstructorNameStrategy syntax where
   ConstructorNameStrategy (Sum _)     = 'Custom
   ConstructorNameStrategy []          = 'Custom
   ConstructorNameStrategy (TermF _ _) = 'Custom
-  ConstructorNameStrategy syntax      = 'Default
+  ConstructorNameStrategy _           = 'Default
 
 class ConstructorNameWithStrategy (strategy :: Strategy) syntax where
   constructorNameWithStrategy :: proxy strategy -> syntax a -> String

src/Analysis/CyclomaticComplexity.hs

@@ -1,4 +1,4 @@
-{-# LANGUAGE DataKinds, DefaultSignatures, GeneralizedNewtypeDeriving, MultiParamTypeClasses, ScopedTypeVariables, TypeFamilies, UndecidableInstances #-}
+{-# LANGUAGE DataKinds, DefaultSignatures, FlexibleInstances, GeneralizedNewtypeDeriving, MultiParamTypeClasses, ScopedTypeVariables, TypeApplications, TypeFamilies, UndecidableInstances #-}
 module Analysis.CyclomaticComplexity
 ( CyclomaticComplexity(..)
 , HasCyclomaticComplexity
@@ -103,8 +103,8 @@ type family CyclomaticComplexityStrategy syntax where
   CyclomaticComplexityStrategy Statement.If = 'Custom
   CyclomaticComplexityStrategy Statement.Pattern = 'Custom
   CyclomaticComplexityStrategy Statement.While = 'Custom
-  CyclomaticComplexityStrategy (Sum fs) = 'Custom
-  CyclomaticComplexityStrategy a = 'Default
+  CyclomaticComplexityStrategy (Sum _) = 'Custom
+  CyclomaticComplexityStrategy _ = 'Default
 
 
 -- | The 'Default' strategy takes the sum without incrementing.

src/Analysis/Decorator.hs

@@ -1,4 +1,4 @@
-{-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE FlexibleContexts, TypeFamilies #-}
 module Analysis.Decorator
 ( decoratorWithAlgebra
 ) where

src/Analysis/HasTextElement.hs

@@ -1,4 +1,4 @@
-{-# LANGUAGE ScopedTypeVariables, TypeFamilies, TypeOperators, UndecidableInstances #-}
+{-# LANGUAGE DataKinds, FlexibleInstances, MultiParamTypeClasses, ScopedTypeVariables, TypeApplications, TypeFamilies, TypeOperators, UndecidableInstances #-}
 module Analysis.HasTextElement
 ( HasTextElement(..)
 ) where
@@ -29,8 +29,8 @@ class HasTextElementWithStrategy (strategy :: Strategy) syntax where
 
 type family TextElementStrategy syntax where
   TextElementStrategy Literal.TextElement = 'Custom
-  TextElementStrategy (Sum fs) = 'Custom
-  TextElementStrategy a = 'Default
+  TextElementStrategy (Sum _) = 'Custom
+  TextElementStrategy _ = 'Default
 
 instance HasTextElementWithStrategy 'Default syntax where
   isTextElementWithStrategy _ _ = False

src/Analysis/PackageDef.hs

@@ -1,4 +1,4 @@
-{-# LANGUAGE ScopedTypeVariables, TypeFamilies, UndecidableInstances #-}
+{-# LANGUAGE DataKinds, FlexibleInstances, MultiParamTypeClasses, RecordWildCards, ScopedTypeVariables, TypeApplications, TypeFamilies, UndecidableInstances #-}
 module Analysis.PackageDef
 ( PackageDef(..)
 , HasPackageDef
@@ -15,7 +15,7 @@ import Prologue
 import Source.Loc
 
 newtype PackageDef = PackageDef { moduleDefIdentifier :: T.Text }
-  deriving (Eq, Generic, Show)
+  deriving (Eq, Show)
 
 -- | An r-algebra producing 'Just' a 'PackageDef' for syntax nodes corresponding to high-level declarations, or 'Nothing' otherwise.
 --
@@ -80,8 +80,8 @@ class HasPackageDefWithStrategy (strategy :: Strategy) syntax where
 --   If you’re seeing errors about missing a 'CustomHasPackageDef' instance for a given type, you’ve probably listed it in here but not defined a 'CustomHasPackageDef' instance for it, or else you’ve listed the wrong type in here. Conversely, if your 'customHasPackageDef' method is never being called, you may have forgotten to list the type in here.
 type family PackageDefStrategy syntax where
   PackageDefStrategy Language.Go.Syntax.Package = 'Custom
-  PackageDefStrategy (Sum fs) = 'Custom
-  PackageDefStrategy a = 'Default
+  PackageDefStrategy (Sum _) = 'Custom
+  PackageDefStrategy _ = 'Default
 
 
 -- | The 'Default' strategy produces 'Nothing'.

src/Analysis/TOCSummary.hs

@@ -1,4 +1,4 @@
-{-# LANGUAGE AllowAmbiguousTypes, LambdaCase, RankNTypes, ScopedTypeVariables, TypeFamilies, TypeOperators, UndecidableInstances, ViewPatterns #-}
+{-# LANGUAGE AllowAmbiguousTypes, DataKinds, FlexibleContexts, FlexibleInstances, LambdaCase, MultiParamTypeClasses, OverloadedStrings, RankNTypes, RecordWildCards, ScopedTypeVariables, TypeApplications, TypeFamilies, TypeOperators, UndecidableInstances, ViewPatterns #-}
 module Analysis.TOCSummary
 ( Declaration(..)
 , formatIdentifier
@@ -151,5 +151,5 @@ type family DeclarationStrategy syntax where
   DeclarationStrategy Declaration.Method   = 'Custom
   DeclarationStrategy Markdown.Heading     = 'Custom
   DeclarationStrategy Syntax.Error         = 'Custom
-  DeclarationStrategy (Sum fs)             = 'Custom
-  DeclarationStrategy a                    = 'Default
+  DeclarationStrategy (Sum _)              = 'Custom
+  DeclarationStrategy _                    = 'Default