diff --git a/.hlint.yaml b/.hlint.yaml index 4111be9a70..e6616797c5 100644 --- a/.hlint.yaml +++ b/.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} diff --git a/bench/Evaluation.hs b/bench/Evaluation.hs index bd9ec4fc66..1092d8cbf4 100644 --- a/bench/Evaluation.hs +++ b/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) diff --git a/bench/Main.hs b/bench/Main.hs index c0537e2439..c005439a0b 100644 --- a/bench/Main.hs +++ b/bench/Main.hs @@ -1,4 +1,4 @@ -module Main where +module Main (main) where import Gauge import qualified Evaluation diff --git a/semantic.cabal b/semantic.cabal index 57a6efdc08..0a843d0204 100644 --- a/semantic.cabal +++ b/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 diff --git a/src/Analysis/Abstract/Caching/FlowInsensitive.hs b/src/Analysis/Abstract/Caching/FlowInsensitive.hs index 0c10a265ac..b54500ca10 100644 --- a/src/Analysis/Abstract/Caching/FlowInsensitive.hs +++ b/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 diff --git a/src/Analysis/Abstract/Caching/FlowSensitive.hs b/src/Analysis/Abstract/Caching/FlowSensitive.hs index 226aef748a..f77b47b118 100644 --- a/src/Analysis/Abstract/Caching/FlowSensitive.hs +++ b/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 diff --git a/src/Analysis/Abstract/Dead.hs b/src/Analysis/Abstract/Dead.hs index 984c910d38..10d8cfd657 100644 --- a/src/Analysis/Abstract/Dead.hs +++ b/src/Analysis/Abstract/Dead.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE GeneralizedNewtypeDeriving, TypeOperators #-} +{-# LANGUAGE FlexibleContexts, FlexibleInstances, GeneralizedNewtypeDeriving, MultiParamTypeClasses, StandaloneDeriving #-} module Analysis.Abstract.Dead ( Dead(..) , revivingTerms diff --git a/src/Analysis/Abstract/Graph.hs b/src/Analysis/Abstract/Graph.hs index e173347de7..f62359bb45 100644 --- a/src/Analysis/Abstract/Graph.hs +++ b/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) diff --git a/src/Analysis/Abstract/Tracing.hs b/src/Analysis/Abstract/Tracing.hs index e2643164a5..598cbc7b44 100644 --- a/src/Analysis/Abstract/Tracing.hs +++ b/src/Analysis/Abstract/Tracing.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE TypeOperators #-} +{-# LANGUAGE FlexibleContexts #-} module Analysis.Abstract.Tracing ( tracingTerms , tracing diff --git a/src/Analysis/ConstructorName.hs b/src/Analysis/ConstructorName.hs index 4834cc3bac..2c41b9760b 100644 --- a/src/Analysis/ConstructorName.hs +++ b/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 diff --git a/src/Analysis/CyclomaticComplexity.hs b/src/Analysis/CyclomaticComplexity.hs index 46ef4beab7..94738caf12 100644 --- a/src/Analysis/CyclomaticComplexity.hs +++ b/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. diff --git a/src/Analysis/Decorator.hs b/src/Analysis/Decorator.hs index 7596d26cbc..8bb1d677e6 100644 --- a/src/Analysis/Decorator.hs +++ b/src/Analysis/Decorator.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE FlexibleContexts, TypeFamilies #-} module Analysis.Decorator ( decoratorWithAlgebra ) where diff --git a/src/Analysis/HasTextElement.hs b/src/Analysis/HasTextElement.hs index 56a2498ed1..78f6be8ba3 100644 --- a/src/Analysis/HasTextElement.hs +++ b/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 diff --git a/src/Analysis/PackageDef.hs b/src/Analysis/PackageDef.hs index 8d914b277b..8000ed14e7 100644 --- a/src/Analysis/PackageDef.hs +++ b/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'. diff --git a/src/Analysis/TOCSummary.hs b/src/Analysis/TOCSummary.hs index 45b4d1391f..29419c95e6 100644 --- a/src/Analysis/TOCSummary.hs +++ b/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 diff --git a/src/Assigning/Assignment.hs b/src/Assigning/Assignment.hs index 2690cb69ff..bc0b957712 100644 --- a/src/Assigning/Assignment.hs +++ b/src/Assigning/Assignment.hs @@ -1,5 +1,4 @@ -{-# LANGUAGE DataKinds, GADTs, InstanceSigs, MultiParamTypeClasses, RankNTypes, ScopedTypeVariables, StandaloneDeriving, TypeFamilies, TypeOperators #-} -{-# OPTIONS_GHC -Wno-redundant-constraints #-} -- For HasCallStack +{-# LANGUAGE DataKinds, FlexibleContexts, FlexibleInstances, GADTs, InstanceSigs, MultiParamTypeClasses, RankNTypes, RecordWildCards, ScopedTypeVariables, StandaloneDeriving, TypeFamilies, TypeOperators #-} -- | Assignment of AST onto some other structure (typically terms). -- -- Parsing yields an AST represented as a Rose tree labelled with symbols in the language’s grammar and source locations (byte Range and Span). An Assignment represents a (partial) map from AST nodes onto some other structure; in essence, it’s a parser that operates over trees. (For our purposes, this structure is typically Terms annotated with source locations.) Assignments are able to match based on symbol, sequence, and hierarchy; thus, in @x = y@, both @x@ and @y@ might have the same symbol, @Identifier@, the left can be assigned to a variable declaration, while the right can be assigned to a variable reference. @@ -63,9 +62,6 @@ module Assigning.Assignment ( Assignment , L.Loc(..) -- Combinators -, branchNode -, leafNode -, toTerm , Alternative(..) , MonadError(..) , MonadFail(..) @@ -110,21 +106,6 @@ import Source.Span as Span import Text.Parser.Combinators as Parsers hiding (choice) import TreeSitter.Language --- | Match a branch node, matching its children with the supplied 'Assignment' & returning the result. -branchNode :: (Enum grammar, Ix grammar) => grammar -> Assignment ast grammar a -> Assignment ast grammar a -branchNode sym child = symbol sym *> children child - --- | Match a leaf node, returning the corresponding 'Text'. -leafNode :: (Enum grammar, Ix grammar) => grammar -> Assignment ast grammar Text -leafNode sym = symbol sym *> source - --- | Wrap an 'Assignment' producing @syntax@ up into an 'Assignment' producing 'Term's. -toTerm :: Element syntax syntaxes - => Assignment ast grammar (syntax (Term (Sum syntaxes) L.Loc)) - -> Assignment ast grammar (Term (Sum syntaxes) L.Loc) -toTerm syntax = termIn <$> location <*> (inject <$> syntax) - - -- | Assignment from an AST with some set of 'symbol's onto some other value. -- -- This is essentially a parser. @@ -174,7 +155,7 @@ currentNode :: HasCallStack => Assignment ast grammar (TermF ast (Node grammar) currentNode = tracing CurrentNode `Then` pure -- | Zero-width match of a node with the given symbol, producing the current node’s location. -symbol :: (Enum grammar, Ix grammar, HasCallStack) => grammar -> Assignment ast grammar L.Loc +symbol :: (Enum grammar, HasCallStack) => grammar -> Assignment ast grammar L.Loc symbol s = tracing (Choose (Table.singleton s location) Nothing Nothing) `Then` pure -- | A rule to produce a node’s source as a ByteString. @@ -213,12 +194,12 @@ choice alternatives mergeHandlers hs = Just (\ err -> asum (hs <*> [err])) -- | Match and advance past a node with the given symbol. -token :: (Enum grammar, Ix grammar, HasCallStack) => grammar -> Assignment ast grammar L.Loc +token :: (Enum grammar, HasCallStack) => grammar -> Assignment ast grammar L.Loc token s = symbol s <* advance -- | Match the first operand until the second operand matches, returning both results. Like 'manyTill', but returning the terminal value. -manyThrough :: (Alternative m, HasCallStack) => m a -> m b -> m ([a], b) +manyThrough :: Alternative m => m a -> m b -> m ([a], b) manyThrough step stop = go where go = (,) [] <$> stop <|> first . (:) <$> step <*> go @@ -235,7 +216,7 @@ firstSet = iterFreer (\ _ (Tracing _ assignment) -> case assignment of -- | Run an assignment over an AST exhaustively. -assign :: (Enum grammar, Ix grammar, Symbol grammar, Show grammar, Eq1 ast, Foldable ast, Functor ast) +assign :: (Symbol grammar, Eq1 ast, Foldable ast, Functor ast) => Source.Source -- ^ The source for the parse tree. -> Assignment ast grammar a -- ^ The 'Assignment to run. -> AST ast grammar -- ^ The root of the ast. @@ -244,7 +225,7 @@ assign source assignment ast = bimap (fmap (either id show)) fst (runAssignment {-# INLINE assign #-} -- | Run an assignment of nodes in a grammar onto terms in a syntax over an AST exhaustively. -runAssignment :: forall grammar a ast. (Enum grammar, Ix grammar, Symbol grammar, Eq1 ast, Foldable ast, Functor ast) +runAssignment :: forall grammar a ast. (Symbol grammar, Eq1 ast, Foldable ast, Functor ast) => Source.Source -- ^ The source for the parse tree. -> Assignment ast grammar a -- ^ The 'Assignment' to run. -> State ast grammar -- ^ The current state. @@ -330,7 +311,7 @@ instance (Enum grammar, Eq1 ast, Ix grammar) => Alternative (Assignment ast gram empty :: HasCallStack => Assignment ast grammar a empty = tracing (Alt []) `Then` pure - (<|>) :: forall a. HasCallStack => Assignment ast grammar a -> Assignment ast grammar a -> Assignment ast grammar a + (<|>) :: forall a. Assignment ast grammar a -> Assignment ast grammar a -> Assignment ast grammar a Return a <|> _ = Return a l@(Tracing cs _ `Then` _) <|> r@Return{} = Tracing cs (Alt [l, r]) `Then` id l@(Tracing callSiteL la `Then` continueL) <|> r@(Tracing callSiteR ra `Then` continueR) = go callSiteL la continueL callSiteR ra continueR @@ -361,20 +342,18 @@ instance (Enum grammar, Eq1 ast, Ix grammar, Show grammar) => Parsing (Assignmen () :: HasCallStack => Assignment ast grammar a -> String -> Assignment ast grammar a a s = tracing (Label a s) `Then` pure - unexpected :: HasCallStack => String -> Assignment ast grammar a + unexpected :: String -> Assignment ast grammar a unexpected = fail eof :: HasCallStack => Assignment ast grammar () eof = tracing End `Then` pure - notFollowedBy :: (HasCallStack, Show a) => Assignment ast grammar a -> Assignment ast grammar () + notFollowedBy :: Show a => Assignment ast grammar a -> Assignment ast grammar () notFollowedBy a = (a >>= unexpected . show) <|> pure () instance (Enum grammar, Eq1 ast, Ix grammar, Show grammar) => MonadError (Error (Either String grammar)) (Assignment ast grammar) where - throwError :: HasCallStack => Error (Either String grammar) -> Assignment ast grammar a throwError err = fail (show err) - catchError :: HasCallStack => Assignment ast grammar a -> (Error (Either String grammar) -> Assignment ast grammar a) -> Assignment ast grammar a catchError rule handler = iterFreer (\ continue (Tracing cs assignment) -> case assignment of Choose choices atEnd Nothing -> Tracing cs (Choose (fmap (>>= continue) choices) (fmap (>>= continue) atEnd) (Just handler)) `Then` pure Choose choices atEnd (Just onError) -> Tracing cs (Choose (fmap (>>= continue) choices) (fmap (>>= continue) atEnd) (Just (\ err -> (onError err >>= continue) <|> handler err))) `Then` pure diff --git a/src/Assigning/Assignment/Table.hs b/src/Assigning/Assignment/Table.hs index 5cb8ca9275..11719ee426 100644 --- a/src/Assigning/Assignment/Table.hs +++ b/src/Assigning/Assignment/Table.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE DerivingVia #-} +{-# LANGUAGE DeriveGeneric, DeriveTraversable, DerivingVia, RecordWildCards #-} module Assigning.Assignment.Table ( Table(tableAddresses) , singleton diff --git a/src/Control/Abstract/Context.hs b/src/Control/Abstract/Context.hs index 528b2602a9..3b129fd469 100644 --- a/src/Control/Abstract/Context.hs +++ b/src/Control/Abstract/Context.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE FlexibleContexts #-} module Control.Abstract.Context ( ModuleInfo , currentModule diff --git a/src/Control/Abstract/Evaluator.hs b/src/Control/Abstract/Evaluator.hs index dafb2d7ee0..8835852f82 100644 --- a/src/Control/Abstract/Evaluator.hs +++ b/src/Control/Abstract/Evaluator.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE GeneralizedNewtypeDeriving, ScopedTypeVariables, TypeOperators, UndecidableInstances #-} +{-# LANGUAGE FlexibleContexts, FlexibleInstances, GeneralizedNewtypeDeriving, LambdaCase, MultiParamTypeClasses, ScopedTypeVariables, TypeApplications, TypeOperators, UndecidableInstances #-} module Control.Abstract.Evaluator ( Evaluator(..) , raiseHandler @@ -76,11 +76,17 @@ runReturn = raiseHandler $ fmap (either unReturn id) . runError -- | Effects for control flow around loops (breaking and continuing). data LoopControl value - = Break { unLoopControl :: value } - | Continue { unLoopControl :: value } + = Break value + | Continue value | Abort deriving (Eq, Ord, Show) +unLoopControl :: LoopControl value -> value +unLoopControl = \case + Break v -> v + Continue v -> v + Abort -> error "unLoopControl: Abort" + throwBreak :: (Member (Error (LoopControl value)) sig, Carrier sig m) => value -> Evaluator term address value m value diff --git a/src/Control/Abstract/Heap.hs b/src/Control/Abstract/Heap.hs index 86d2a038ba..8e706efdef 100644 --- a/src/Control/Abstract/Heap.hs +++ b/src/Control/Abstract/Heap.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE DeriveAnyClass, DerivingStrategies, GADTs, GeneralizedNewtypeDeriving, KindSignatures, RankNTypes, ScopedTypeVariables, TypeOperators, UndecidableInstances #-} +{-# LANGUAGE DeriveFunctor, DeriveGeneric, FlexibleContexts, GADTs, GeneralizedNewtypeDeriving, KindSignatures, RankNTypes, RecordWildCards, ScopedTypeVariables, StandaloneDeriving, TypeOperators, UndecidableInstances #-} module Control.Abstract.Heap ( Heap , HeapError(..) @@ -420,15 +420,17 @@ reachable roots heap = go mempty roots data Deref value (m :: * -> *) k = DerefCell (Set value) (Maybe value -> m k) | AssignCell value (Set value) (Set value -> m k) - deriving stock (Functor, Generic1) - deriving anyclass (HFunctor, Effect) + deriving (Functor, Generic1) + +instance HFunctor (Deref value) +instance Effect (Deref value) runDeref :: Evaluator term address value (DerefC address value m) a -> Evaluator term address value m a runDeref = raiseHandler runDerefC newtype DerefC address value m a = DerefC { runDerefC :: m a } - deriving newtype (Alternative, Applicative, Functor, Monad) + deriving (Alternative, Applicative, Functor, Monad) diff --git a/src/Control/Abstract/Modules.hs b/src/Control/Abstract/Modules.hs index 9ea8828e4a..de2ab3a15a 100644 --- a/src/Control/Abstract/Modules.hs +++ b/src/Control/Abstract/Modules.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE DeriveAnyClass, DerivingStrategies, GADTs, GeneralizedNewtypeDeriving, KindSignatures, RankNTypes, ScopedTypeVariables, TypeOperators, UndecidableInstances #-} +{-# LANGUAGE DeriveFunctor, DeriveGeneric, FlexibleContexts, FlexibleInstances, GADTs, GeneralizedNewtypeDeriving, KindSignatures, MultiParamTypeClasses, RankNTypes, ScopedTypeVariables, StandaloneDeriving, TypeOperators, UndecidableInstances #-} module Control.Abstract.Modules ( ModuleResult , lookupModule @@ -65,8 +65,10 @@ data Modules address value (m :: * -> *) k | Lookup ModulePath (Maybe (ModuleResult address value) -> m k) | Resolve [FilePath] (Maybe ModulePath -> m k) | List FilePath ([ModulePath] -> m k) - deriving stock (Functor, Generic1) - deriving anyclass (HFunctor, Effect) + deriving (Functor, Generic1) + +instance HFunctor (Modules address value) +instance Effect (Modules address value) sendModules :: ( Member (Modules address value) sig @@ -81,7 +83,7 @@ runModules :: Set ModulePath runModules paths = raiseHandler (runReader paths . runModulesC) newtype ModulesC address value m a = ModulesC { runModulesC :: ReaderC (Set ModulePath) m a } - deriving newtype (Alternative, Applicative, Functor, Monad, MonadIO) + deriving (Alternative, Applicative, Functor, Monad, MonadIO) instance ( Member (Reader (ModuleTable (Module (ModuleResult address value)))) sig , Member (Resumable (BaseError (LoadError address value))) sig diff --git a/src/Control/Abstract/Primitive.hs b/src/Control/Abstract/Primitive.hs index 89747d5243..bb69ddfe45 100644 --- a/src/Control/Abstract/Primitive.hs +++ b/src/Control/Abstract/Primitive.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE TupleSections #-} +{-# LANGUAGE FlexibleContexts, RecordWildCards, TupleSections #-} module Control.Abstract.Primitive ( defineClass , defineNamespace diff --git a/src/Control/Abstract/PythonPackage.hs b/src/Control/Abstract/PythonPackage.hs index c87952cc64..165ea0c8f6 100644 --- a/src/Control/Abstract/PythonPackage.hs +++ b/src/Control/Abstract/PythonPackage.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE GeneralizedNewtypeDeriving, UndecidableInstances #-} +{-# LANGUAGE FlexibleInstances, GeneralizedNewtypeDeriving, MultiParamTypeClasses, OverloadedStrings, UndecidableInstances #-} module Control.Abstract.PythonPackage ( runPythonPackaging, Strategy(..) ) where diff --git a/src/Control/Abstract/Roots.hs b/src/Control/Abstract/Roots.hs index 20ea02ed15..6835f8c28a 100644 --- a/src/Control/Abstract/Roots.hs +++ b/src/Control/Abstract/Roots.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE FlexibleContexts, MultiParamTypeClasses #-} module Control.Abstract.Roots ( ValueRoots(..) , Live diff --git a/src/Control/Abstract/ScopeGraph.hs b/src/Control/Abstract/ScopeGraph.hs index 7ee7d7906b..b9174e0987 100644 --- a/src/Control/Abstract/ScopeGraph.hs +++ b/src/Control/Abstract/ScopeGraph.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE DeriveAnyClass, DerivingStrategies, GADTs, GeneralizedNewtypeDeriving, KindSignatures, RankNTypes, ScopedTypeVariables, TypeOperators, UndecidableInstances #-} +{-# LANGUAGE DeriveFunctor, DeriveGeneric, FlexibleContexts, GADTs, GeneralizedNewtypeDeriving, KindSignatures, RankNTypes, RecordWildCards, ScopedTypeVariables, StandaloneDeriving, TypeApplications, TypeOperators, UndecidableInstances #-} module Control.Abstract.ScopeGraph ( lookup , declare @@ -367,15 +367,17 @@ alloc = send . flip Alloc pure data Allocator address (m :: * -> *) k = Alloc Name (address -> m k) - deriving stock (Functor, Generic1) - deriving anyclass (HFunctor, Effect) + deriving (Functor, Generic1) + +instance HFunctor (Allocator address) +instance Effect (Allocator address) runAllocator :: Evaluator term address value (AllocatorC address m) a -> Evaluator term address value m a runAllocator = raiseHandler runAllocatorC newtype AllocatorC address m a = AllocatorC { runAllocatorC :: m a } - deriving newtype (Alternative, Applicative, Functor, Monad) + deriving (Alternative, Applicative, Functor, Monad) runScopeErrorWith :: (forall resume . BaseError (ScopeError address) resume -> Evaluator term address value m resume) -> Evaluator term address value (ResumableWithC (BaseError (ScopeError address)) m) a diff --git a/src/Control/Abstract/Value.hs b/src/Control/Abstract/Value.hs index 04b66ec654..34e5fb7ecf 100644 --- a/src/Control/Abstract/Value.hs +++ b/src/Control/Abstract/Value.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE DeriveAnyClass, DerivingStrategies, GADTs, GeneralizedNewtypeDeriving, KindSignatures, Rank2Types, ScopedTypeVariables, TypeOperators #-} +{-# LANGUAGE DeriveFunctor, DeriveGeneric, FlexibleContexts, GADTs, GeneralizedNewtypeDeriving, KindSignatures, MultiParamTypeClasses, RankNTypes, ScopedTypeVariables, TypeOperators #-} module Control.Abstract.Value ( AbstractValue(..) , AbstractIntro(..) @@ -133,9 +133,10 @@ data Function term address value (m :: * -> *) k | BuiltIn address BuiltIn (value -> m k) -- ^ A built-in is parameterized by its parent scope, BuiltIn type, and returns a value. | Call value [value] (value -> m k) -- ^ A Call takes a set of values as parameters and returns a ValueRef. | Bind value value (value -> m k) - deriving stock (Functor, Generic1) - deriving anyclass (HFunctor, Effect) + deriving (Functor, Generic1) +instance HFunctor (Function term address value) +instance Effect (Function term address value) runFunction :: (term -> Evaluator term address value (FunctionC term address value m) value) -> Evaluator term address value (FunctionC term address value m) a @@ -143,7 +144,7 @@ runFunction :: (term -> Evaluator term address value (FunctionC term address val runFunction eval = raiseHandler (runReader (runEvaluator . eval) . runFunctionC) newtype FunctionC term address value m a = FunctionC { runFunctionC :: ReaderC (term -> FunctionC term address value m value) m a } - deriving newtype (Alternative, Applicative, Functor, Monad) + deriving (Alternative, Applicative, Functor, Monad) -- | Construct a boolean value in the abstract domain. boolean :: (Member (Boolean value) sig, Carrier sig m) => Bool -> m value @@ -160,16 +161,17 @@ ifthenelse v t e = asBool v >>= \ c -> if c then t else e data Boolean value (m :: * -> *) k = Boolean Bool (value -> m k) | AsBool value (Bool -> m k) - deriving stock (Functor, Generic1) - deriving anyclass (HFunctor, Effect) + deriving (Functor, Generic1) + +instance HFunctor (Boolean value) +instance Effect (Boolean value) runBoolean :: Evaluator term address value (BooleanC value m) a -> Evaluator term address value m a runBoolean = raiseHandler runBooleanC newtype BooleanC value m a = BooleanC { runBooleanC :: m a } - deriving stock Functor - deriving newtype (Alternative, Applicative, Monad) + deriving (Alternative, Applicative, Functor, Monad) -- | The fundamental looping primitive, built on top of 'ifthenelse'. @@ -209,7 +211,7 @@ forLoop initial cond step body = initial *> while cond (withLexicalScopeAndFrame data While value m k = While (m value) (m value) (value -> m k) - deriving stock (Functor, Generic1) + deriving (Functor, Generic1) instance HFunctor (While value) where hmap f (While cond body k) = While (f cond) (f body) (f . k) @@ -219,8 +221,7 @@ runWhile :: Evaluator term address value (WhileC value m) a runWhile = raiseHandler runWhileC newtype WhileC value m a = WhileC { runWhileC :: m a } - deriving stock Functor - deriving newtype (Alternative, Applicative, Monad) + deriving (Alternative, Applicative, Functor, Monad) -- | Construct an abstract unit value. unit :: (Carrier sig m, Member (Unit value) sig) => Evaluator term address value m value @@ -228,16 +229,17 @@ unit = send (Unit pure) newtype Unit value (m :: * -> *) k = Unit (value -> m k) - deriving stock (Functor, Generic1) - deriving anyclass (HFunctor, Effect) + deriving (Functor, Generic1) + +instance HFunctor (Unit value) +instance Effect (Unit value) runUnit :: Evaluator term address value (UnitC value m) a -> Evaluator term address value m a runUnit = raiseHandler runUnitC newtype UnitC value m a = UnitC { runUnitC :: m a } - deriving stock Functor - deriving newtype (Alternative, Applicative, Monad) + deriving (Alternative, Applicative, Functor, Monad) -- | Construct a String value in the abstract domain. string :: (Member (String value) sig, Carrier sig m) => Text -> m value @@ -250,12 +252,13 @@ asString v = send (AsString v pure) data String value (m :: * -> *) k = String Text (value -> m k) | AsString value (Text -> m k) - deriving stock (Functor, Generic1) - deriving anyclass (HFunctor, Effect) + deriving (Functor, Generic1) + +instance HFunctor (String value) +instance Effect (String value) newtype StringC value m a = StringC { runStringC :: m a } - deriving stock Functor - deriving newtype (Alternative, Applicative, Monad) + deriving (Alternative, Applicative, Functor, Monad) runString :: Evaluator term address value (StringC value m) a -> Evaluator term address value m a @@ -302,12 +305,13 @@ data Numeric value (m :: * -> *) k | Rational Rational (value -> m k) | LiftNumeric NumericFunction value (value -> m k) | LiftNumeric2 Numeric2Function value value (value -> m k) - deriving stock (Functor, Generic1) - deriving anyclass (HFunctor, Effect) + deriving (Functor, Generic1) + +instance HFunctor (Numeric value) +instance Effect (Numeric value) newtype NumericC value m a = NumericC { runNumericC :: m a } - deriving stock Functor - deriving newtype (Alternative, Applicative, Monad) + deriving (Alternative, Applicative, Functor, Monad) runNumeric :: Evaluator term address value (NumericC value m) a -> Evaluator term address value m a @@ -350,16 +354,17 @@ data Bitwise value (m :: * -> *) k | LiftBitwise BitwiseFunction value (value -> m k) | LiftBitwise2 Bitwise2Function value value (value -> m k) | UnsignedRShift value value (value -> m k) - deriving stock (Functor, Generic1) - deriving anyclass (HFunctor, Effect) + deriving (Functor, Generic1) + +instance HFunctor (Bitwise value) +instance Effect (Bitwise value) runBitwise :: Evaluator term address value (BitwiseC value m) a -> Evaluator term address value m a runBitwise = raiseHandler runBitwiseC newtype BitwiseC value m a = BitwiseC { runBitwiseC :: m a } - deriving stock Functor - deriving newtype (Alternative, Applicative, Monad) + deriving (Alternative, Applicative, Functor, Monad) object :: (Member (Object address value) sig, Carrier sig m) => address -> m value object address = send (Object address pure) @@ -378,12 +383,13 @@ data Object address value m k = Object address (value -> m k) | ScopedEnvironment value (Maybe address -> m k) | Klass Declaration address (value -> m k) - deriving stock (Functor, Generic1) - deriving anyclass (HFunctor, Effect) + deriving (Functor, Generic1) + +instance HFunctor (Object address value) +instance Effect (Object address value) newtype ObjectC address value m a = ObjectC { runObjectC :: m a } - deriving stock Functor - deriving newtype (Alternative, Applicative, Monad) + deriving (Alternative, Applicative, Functor, Monad) runObject :: Evaluator term address value (ObjectC address value m) a -> Evaluator term address value m a @@ -399,12 +405,13 @@ asArray v = send (AsArray v pure) data Array value (m :: * -> *) k = Array [value] (value -> m k) | AsArray value ([value] -> m k) - deriving stock (Functor, Generic1) - deriving anyclass (HFunctor, Effect) + deriving (Functor, Generic1) + +instance HFunctor (Array value) +instance Effect (Array value) newtype ArrayC value m a = ArrayC { runArrayC :: m a } - deriving stock Functor - deriving newtype (Alternative, Applicative, Monad) + deriving (Alternative, Applicative, Functor, Monad) runArray :: Evaluator term address value (ArrayC value m) a -> Evaluator term address value m a @@ -421,12 +428,13 @@ kvPair v1 v2 = send (KvPair v1 v2 pure) data Hash value (m :: * -> *) k = Hash [(value, value)] (value -> m k) | KvPair value value (value -> m k) - deriving stock (Functor, Generic1) - deriving anyclass (HFunctor, Effect) + deriving (Functor, Generic1) + +instance HFunctor (Hash value) +instance Effect (Hash value) newtype HashC value m a = HashC { runHashC :: m a } - deriving stock Functor - deriving newtype (Alternative, Applicative, Monad) + deriving (Alternative, Applicative, Functor, Monad) runHash :: Evaluator term address value (HashC value m) a -> Evaluator term address value m a diff --git a/src/Control/Carrier/Parse/Measured.hs b/src/Control/Carrier/Parse/Measured.hs index 59f788c33b..54a6381f63 100644 --- a/src/Control/Carrier/Parse/Measured.hs +++ b/src/Control/Carrier/Parse/Measured.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE GADTs, GeneralizedNewtypeDeriving, TypeOperators, UndecidableInstances #-} +{-# LANGUAGE FlexibleContexts, FlexibleInstances, GADTs, GeneralizedNewtypeDeriving, MultiParamTypeClasses, RecordWildCards, TypeOperators, UndecidableInstances #-} -- | A carrier for 'Parse' effects suitable for use in production. module Control.Carrier.Parse.Measured ( -- * Parse effect @@ -21,7 +21,6 @@ import Data.Blob import qualified Data.Error as Error import qualified Data.Flag as Flag import qualified Data.Syntax as Syntax -import Data.Typeable import Parsing.CMark import Parsing.Parser import Parsing.TreeSitter @@ -74,7 +73,7 @@ runParser blob@Blob{..} parser = case parser of where languageTag = [("language" :: String, show (blobLanguage blob))] data ParserCancelled = ParserTimedOut | AssignmentTimedOut - deriving (Show, Typeable) + deriving (Show) instance Exception ParserCancelled diff --git a/src/Control/Carrier/Parse/Simple.hs b/src/Control/Carrier/Parse/Simple.hs index 12dc5dcbee..f9a2c55c0e 100644 --- a/src/Control/Carrier/Parse/Simple.hs +++ b/src/Control/Carrier/Parse/Simple.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE GADTs, GeneralizedNewtypeDeriving, TypeOperators, UndecidableInstances #-} +{-# LANGUAGE FlexibleContexts, FlexibleInstances, GADTs, GeneralizedNewtypeDeriving, MultiParamTypeClasses, RecordWildCards, TypeOperators, UndecidableInstances #-} -- | A carrier for 'Parse' effects suitable for use in the repl, tests, etc. module Control.Carrier.Parse.Simple ( -- * Parse effect @@ -18,7 +18,6 @@ import Control.Effect.Reader import Control.Exception import Control.Monad.IO.Class import Data.Blob -import Data.Typeable import Parsing.CMark import Parsing.Parser import Parsing.TreeSitter @@ -64,6 +63,6 @@ runParser timeout blob@Blob{..} parser = case parser of in length term `seq` pure term newtype ParseFailure = ParseFailure String - deriving (Show, Typeable) + deriving (Show) instance Exception ParseFailure diff --git a/src/Control/Effect/Interpose.hs b/src/Control/Effect/Interpose.hs index 9be06cddd4..3086cf293d 100644 --- a/src/Control/Effect/Interpose.hs +++ b/src/Control/Effect/Interpose.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE ExistentialQuantification, GeneralizedNewtypeDeriving, KindSignatures, RankNTypes, StandaloneDeriving, TypeOperators, UndecidableInstances #-} +{-# LANGUAGE DeriveFunctor, ExistentialQuantification, FlexibleContexts, FlexibleInstances, GeneralizedNewtypeDeriving, KindSignatures, MultiParamTypeClasses, RankNTypes, StandaloneDeriving, TypeOperators, UndecidableInstances #-} module Control.Effect.Interpose ( Interpose(..) , interpose diff --git a/src/Control/Effect/Parse.hs b/src/Control/Effect/Parse.hs index a71ed9b847..603a211c8a 100644 --- a/src/Control/Effect/Parse.hs +++ b/src/Control/Effect/Parse.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE ConstraintKinds, ExistentialQuantification, GADTs, RankNTypes #-} +{-# LANGUAGE ConstraintKinds, DeriveFunctor, ExistentialQuantification, FlexibleContexts, GADTs, RankNTypes, StandaloneDeriving #-} module Control.Effect.Parse ( -- * Parse effect Parse(..) diff --git a/src/Control/Effect/REPL.hs b/src/Control/Effect/REPL.hs index 68a47a0eea..0f4b2f1be5 100644 --- a/src/Control/Effect/REPL.hs +++ b/src/Control/Effect/REPL.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE DeriveAnyClass, DerivingStrategies, GeneralizedNewtypeDeriving, KindSignatures, TypeOperators, UndecidableInstances #-} +{-# LANGUAGE DeriveFunctor, DeriveGeneric, FlexibleContexts, FlexibleInstances, GeneralizedNewtypeDeriving, KindSignatures, MultiParamTypeClasses, TypeOperators, UndecidableInstances #-} module Control.Effect.REPL ( REPL (..) @@ -18,8 +18,10 @@ import qualified Data.Text as T data REPL (m :: * -> *) k = Prompt Text (Maybe Text -> m k) | Output Text (m k) - deriving stock (Functor, Generic1) - deriving anyclass (HFunctor, Effect) + deriving (Functor, Generic1) + +instance HFunctor REPL +instance Effect REPL prompt :: (Member REPL sig, Carrier sig m) => Text -> m (Maybe Text) prompt p = send (Prompt p pure) @@ -31,7 +33,7 @@ runREPL :: Prefs -> Settings IO -> REPLC m a -> m a runREPL prefs settings = runReader (prefs, settings) . runREPLC newtype REPLC m a = REPLC { runREPLC :: ReaderC (Prefs, Settings IO) m a } - deriving newtype (Functor, Applicative, Monad, MonadIO) + deriving (Functor, Applicative, Monad, MonadIO) instance (Carrier sig m, MonadIO m) => Carrier (REPL :+: sig) (REPLC m) where eff (L op) = do diff --git a/src/Control/Rewriting.hs b/src/Control/Rewriting.hs index 730228c846..fcb177eb36 100644 --- a/src/Control/Rewriting.hs +++ b/src/Control/Rewriting.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE GADTs, TypeOperators #-} +{-# LANGUAGE FlexibleContexts, GADTs, TypeOperators #-} -- | This module provides 'Rewrite', a monadic DSL that abstracts the -- details of rewriting a given datum into another type, supporting diff --git a/src/Data/AST.hs b/src/Data/AST.hs index 5da0600b6b..95e6cb6aaa 100644 --- a/src/Data/AST.hs +++ b/src/Data/AST.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE DataKinds #-} +{-# LANGUAGE OverloadedStrings, RecordWildCards #-} module Data.AST ( Node (..) , nodeSpan diff --git a/src/Data/Abstract/AccessControls/Instances.hs b/src/Data/Abstract/AccessControls/Instances.hs index 9c6d63852a..937144cee5 100644 --- a/src/Data/Abstract/AccessControls/Instances.hs +++ b/src/Data/Abstract/AccessControls/Instances.hs @@ -1,6 +1,6 @@ -{-# LANGUAGE GeneralizedNewtypeDeriving, UndecidableInstances #-} -{-# OPTIONS_GHC -Wno-orphans -Wno-missing-export-lists #-} -module Data.Abstract.AccessControls.Instances where +{-# LANGUAGE GeneralizedNewtypeDeriving, StandaloneDeriving, TypeApplications, UndecidableInstances #-} +{-# OPTIONS_GHC -Wno-orphans #-} +module Data.Abstract.AccessControls.Instances () where import Data.Sum import Data.Term diff --git a/src/Data/Abstract/Address/Hole.hs b/src/Data/Abstract/Address/Hole.hs index 3ba7280e42..a313921e4b 100644 --- a/src/Data/Abstract/Address/Hole.hs +++ b/src/Data/Abstract/Address/Hole.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE TypeOperators, UndecidableInstances #-} +{-# LANGUAGE DeriveTraversable, FlexibleInstances, MultiParamTypeClasses, TypeOperators, UndecidableInstances #-} module Data.Abstract.Address.Hole ( Hole(..) , toMaybe diff --git a/src/Data/Abstract/Address/Monovariant.hs b/src/Data/Abstract/Address/Monovariant.hs index e40986e8ce..c3f7e0f4ec 100644 --- a/src/Data/Abstract/Address/Monovariant.hs +++ b/src/Data/Abstract/Address/Monovariant.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE TypeOperators, UndecidableInstances #-} +{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses, TypeOperators, UndecidableInstances #-} module Data.Abstract.Address.Monovariant ( Monovariant(..) ) where diff --git a/src/Data/Abstract/Address/Precise.hs b/src/Data/Abstract/Address/Precise.hs index 423c1b08cd..c60331b19b 100644 --- a/src/Data/Abstract/Address/Precise.hs +++ b/src/Data/Abstract/Address/Precise.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE TypeOperators, UndecidableInstances #-} +{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses, TypeOperators, UndecidableInstances #-} module Data.Abstract.Address.Precise ( Precise(..) ) where diff --git a/src/Data/Abstract/BaseError.hs b/src/Data/Abstract/BaseError.hs index b8e4febc51..fc5af47fdc 100644 --- a/src/Data/Abstract/BaseError.hs +++ b/src/Data/Abstract/BaseError.hs @@ -1,5 +1,4 @@ -{-# LANGUAGE KindSignatures #-} - +{-# LANGUAGE FlexibleContexts, KindSignatures, RecordWildCards #-} module Data.Abstract.BaseError ( BaseError(..) , throwBaseError diff --git a/src/Data/Abstract/Declarations.hs b/src/Data/Abstract/Declarations.hs index 9c23e0eda0..1e335c6b8d 100644 --- a/src/Data/Abstract/Declarations.hs +++ b/src/Data/Abstract/Declarations.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE GeneralizedNewtypeDeriving, UndecidableInstances #-} +{-# LANGUAGE GeneralizedNewtypeDeriving, StandaloneDeriving, TypeApplications, UndecidableInstances #-} module Data.Abstract.Declarations ( Declarations (..) , Declarations1 (..) diff --git a/src/Data/Abstract/Evaluatable.hs b/src/Data/Abstract/Evaluatable.hs index 1f9f15c2d9..2b01af6f9a 100644 --- a/src/Data/Abstract/Evaluatable.hs +++ b/src/Data/Abstract/Evaluatable.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE GADTs, KindSignatures, RankNTypes, TypeOperators, UndecidableInstances, InstanceSigs #-} +{-# LANGUAGE DataKinds, FlexibleContexts, GADTs, KindSignatures, OverloadedStrings, RankNTypes, StandaloneDeriving, TypeApplications, TypeOperators, UndecidableInstances #-} module Data.Abstract.Evaluatable ( module X , Evaluatable(..) diff --git a/src/Data/Abstract/FreeVariables.hs b/src/Data/Abstract/FreeVariables.hs index 637936c26e..07926b9226 100644 --- a/src/Data/Abstract/FreeVariables.hs +++ b/src/Data/Abstract/FreeVariables.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE DefaultSignatures, GeneralizedNewtypeDeriving, UndecidableInstances #-} +{-# LANGUAGE DefaultSignatures, GeneralizedNewtypeDeriving, StandaloneDeriving, TypeApplications, UndecidableInstances #-} module Data.Abstract.FreeVariables ( FreeVariables (..) , FreeVariables1 (..) diff --git a/src/Data/Abstract/Heap.hs b/src/Data/Abstract/Heap.hs index 516f9bce38..79b82bf43f 100644 --- a/src/Data/Abstract/Heap.hs +++ b/src/Data/Abstract/Heap.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE GeneralizedNewtypeDeriving #-} +{-# LANGUAGE FlexibleInstances, GeneralizedNewtypeDeriving, RecordWildCards #-} module Data.Abstract.Heap ( Heap(..) , Frame(..) @@ -52,11 +52,11 @@ data Frame scopeAddress frameAddress value = Frame , slots :: IntMap (Set value) -- ^ An IntMap of values that are declared in the frame. } - deriving (Eq, Ord, Show, Generic) + deriving (Eq, Ord, Show) -- | A Heap is a Map from frame addresses to frames. newtype Heap scopeAddress frameAddress value = Heap { unHeap :: Map frameAddress (Frame scopeAddress frameAddress value) } - deriving (Eq, Generic, Lower, Ord) + deriving (Eq, Lower, Ord) -- | Look up the frame for an 'address' in a 'Heap', if any. diff --git a/src/Data/Abstract/Module.hs b/src/Data/Abstract/Module.hs index 26c05a17c1..525db9f04e 100644 --- a/src/Data/Abstract/Module.hs +++ b/src/Data/Abstract/Module.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE DeriveTraversable, RecordWildCards #-} module Data.Abstract.Module ( Module(..) , moduleForBlob @@ -14,7 +15,7 @@ import Prologue import System.FilePath.Posix data Module body = Module { moduleInfo :: ModuleInfo, moduleBody :: body } - deriving (Eq, Foldable, Functor, Ord, Traversable, Generic) + deriving (Eq, Foldable, Functor, Ord, Traversable) instance Show body => Show (Module body) where showsPrec d Module{..} = showsBinaryWith showsPrec showsPrec "Module" d (modulePath moduleInfo) moduleBody @@ -33,7 +34,7 @@ moduleForBlob rootDir b = Module info type ModulePath = FilePath data ModuleInfo = ModuleInfo { modulePath :: ModulePath, moduleLanguage :: Language, moduleOid :: Text } - deriving (Eq, Ord, Generic) + deriving (Eq, Ord) instance Lower ModuleInfo where lowerBound = ModuleInfo mempty Unknown mempty diff --git a/src/Data/Abstract/ModuleTable.hs b/src/Data/Abstract/ModuleTable.hs index 5d786c5c91..65c7d26e82 100644 --- a/src/Data/Abstract/ModuleTable.hs +++ b/src/Data/Abstract/ModuleTable.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE GeneralizedNewtypeDeriving #-} +{-# LANGUAGE DeriveTraversable, GeneralizedNewtypeDeriving #-} module Data.Abstract.ModuleTable ( ModulePath , ModuleTable (..) @@ -15,13 +15,12 @@ module Data.Abstract.ModuleTable import Data.Abstract.Module import qualified Data.Map as Map -import GHC.Generics (Generic1) import Prelude hiding (lookup) import Prologue import System.FilePath.Posix newtype ModuleTable a = ModuleTable { unModuleTable :: Map.Map ModulePath a } - deriving (Eq, Foldable, Functor, Generic1, Generic, Lower, Monoid, Ord, Semigroup, Traversable) + deriving (Eq, Foldable, Functor, Lower, Monoid, Ord, Semigroup, Traversable) singleton :: ModulePath -> a -> ModuleTable a singleton name = ModuleTable . Map.singleton name diff --git a/src/Data/Abstract/Name.hs b/src/Data/Abstract/Name.hs index cc39fa30f8..7af31fe903 100644 --- a/src/Data/Abstract/Name.hs +++ b/src/Data/Abstract/Name.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE FlexibleContexts, OverloadedStrings #-} module Data.Abstract.Name ( Name -- * Constructors @@ -19,7 +20,7 @@ import Prologue data Name = Name Text | I Int - deriving (Eq, Ord, Generic) + deriving (Eq, Ord) -- | Generate a fresh (unused) name for use in synthesized variables/closures/etc. gensym :: (Member Fresh sig, Carrier sig m) => m Name diff --git a/src/Data/Abstract/Number.hs b/src/Data/Abstract/Number.hs index f03dcf8f7f..73baf1675c 100644 --- a/src/Data/Abstract/Number.hs +++ b/src/Data/Abstract/Number.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE GADTs, StandaloneDeriving, Rank2Types #-} +{-# LANGUAGE GADTs, StandaloneDeriving, RankNTypes, TypeApplications #-} module Data.Abstract.Number ( Number (..) diff --git a/src/Data/Abstract/Package.hs b/src/Data/Abstract/Package.hs index c3198c0e46..e66f89d0a9 100644 --- a/src/Data/Abstract/Package.hs +++ b/src/Data/Abstract/Package.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE DeriveFunctor #-} module Data.Abstract.Package ( Package (..) , PackageInfo (..) diff --git a/src/Data/Abstract/ScopeGraph.hs b/src/Data/Abstract/ScopeGraph.hs index c10704f9eb..ec30544633 100644 --- a/src/Data/Abstract/ScopeGraph.hs +++ b/src/Data/Abstract/ScopeGraph.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE DeriveAnyClass, DuplicateRecordFields, LambdaCase, TupleSections #-} +{-# LANGUAGE DeriveAnyClass, DeriveFunctor, DeriveGeneric, DuplicateRecordFields, LambdaCase, OverloadedStrings, RecordWildCards, TupleSections #-} module Data.Abstract.ScopeGraph ( Slot(..) , Info(..) diff --git a/src/Data/Abstract/Value/Abstract.hs b/src/Data/Abstract/Value/Abstract.hs index cf49a826fa..d45b81a791 100644 --- a/src/Data/Abstract/Value/Abstract.hs +++ b/src/Data/Abstract/Value/Abstract.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE TypeOperators, UndecidableInstances #-} +{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses, OverloadedStrings, TypeOperators, UndecidableInstances #-} module Data.Abstract.Value.Abstract ( Abstract (..) , runFunction diff --git a/src/Data/Abstract/Value/Concrete.hs b/src/Data/Abstract/Value/Concrete.hs index 503e56d92a..9dc1e02c50 100644 --- a/src/Data/Abstract/Value/Concrete.hs +++ b/src/Data/Abstract/Value/Concrete.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE GADTs, LambdaCase, RankNTypes, ScopedTypeVariables, TypeOperators, UndecidableInstances #-} +{-# LANGUAGE FlexibleContexts, FlexibleInstances, GADTs, LambdaCase, MultiParamTypeClasses, RankNTypes, ScopedTypeVariables, StandaloneDeriving, TypeApplications, TypeOperators, UndecidableInstances #-} module Data.Abstract.Value.Concrete ( Value (..) , ValueError (..) @@ -44,7 +44,7 @@ data Value term address | Hash [Value term address] | Null | Hole - deriving (Eq, Ord, Show, Generic) + deriving (Eq, Ord, Show) instance ValueRoots address (Value term address) where diff --git a/src/Data/Abstract/Value/Type.hs b/src/Data/Abstract/Value/Type.hs index 5d887a06d9..c1eb2a49f7 100644 --- a/src/Data/Abstract/Value/Type.hs +++ b/src/Data/Abstract/Value/Type.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE GADTs, LambdaCase, RankNTypes, ScopedTypeVariables, TypeFamilies, TypeOperators, UndecidableInstances #-} +{-# LANGUAGE FlexibleContexts, FlexibleInstances, GADTs, LambdaCase, MultiParamTypeClasses, OverloadedStrings, RankNTypes, ScopedTypeVariables, StandaloneDeriving, TypeFamilies, TypeOperators, UndecidableInstances #-} module Data.Abstract.Value.Type ( Type (..) , TypeError (..) diff --git a/src/Data/Algebra.hs b/src/Data/Algebra.hs index 738a4d61c4..ebcf660cc1 100644 --- a/src/Data/Algebra.hs +++ b/src/Data/Algebra.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE RankNTypes #-} +{-# LANGUAGE DeriveGeneric, DeriveTraversable, RankNTypes #-} module Data.Algebra ( FAlgebra , RAlgebra diff --git a/src/Data/Blob.hs b/src/Data/Blob.hs index 80ae3c8253..852f6ae762 100644 --- a/src/Data/Blob.hs +++ b/src/Data/Blob.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE DeriveAnyClass, ExplicitNamespaces, PatternSynonyms #-} +{-# LANGUAGE DeriveAnyClass, DeriveGeneric, ExplicitNamespaces, FlexibleContexts, FlexibleInstances, OverloadedStrings, RecordWildCards #-} module Data.Blob ( File(..) , fileForPath @@ -41,7 +41,7 @@ import qualified System.Path.PartClass as Path.PartClass data File = File { filePath :: FilePath , fileLanguage :: Language - } deriving (Show, Eq, Generic) + } deriving (Show, Eq) -- | Prefer 'fileForTypedPath' if at all possible. fileForPath :: FilePath -> File @@ -55,7 +55,7 @@ data Blob = Blob { blobSource :: Source -- ^ The UTF-8 encoded source text of the blob. , blobFile :: File -- ^ Path/language information for this blob. , blobOid :: Text -- ^ Git OID for this blob, mempty if blob is not from a git db. - } deriving (Show, Eq, Generic) + } deriving (Show, Eq) blobLanguage :: Blob -> Language blobLanguage = fileLanguage . blobFile @@ -92,7 +92,7 @@ decodeBlobs = fmap blobs <$> eitherDecode -- | An exception indicating that we’ve tried to diff or parse a blob of unknown language. newtype NoLanguageForBlob = NoLanguageForBlob FilePath - deriving (Eq, Exception, Ord, Show, Typeable) + deriving (Eq, Exception, Ord, Show) noLanguageForBlob :: (Member (Error SomeException) sig, Carrier sig m) => FilePath -> m a noLanguageForBlob blobPath = throwError (SomeException (NoLanguageForBlob blobPath)) diff --git a/src/Data/Blob/IO.hs b/src/Data/Blob/IO.hs index ae19501ff5..1bd9388e6d 100644 --- a/src/Data/Blob/IO.hs +++ b/src/Data/Blob/IO.hs @@ -1,5 +1,3 @@ -{-# LANGUAGE RankNTypes #-} - -- | These are primitive file IO methods for use in ghci and as internal functions. -- Instead of using these, consider if you can use the Files DSL instead. module Data.Blob.IO @@ -20,7 +18,7 @@ import qualified Source.Source as Source import qualified System.Path as Path -- | Read a utf8-encoded file to a 'Blob'. -readBlobFromFile :: forall m. MonadIO m => File -> m (Maybe Blob) +readBlobFromFile :: MonadIO m => File -> m (Maybe Blob) readBlobFromFile (File "/dev/null" _) = pure Nothing readBlobFromFile (File path language) = do raw <- liftIO $ B.readFile path diff --git a/src/Data/Diff.hs b/src/Data/Diff.hs index 2e89e98fbe..924dd33d61 100644 --- a/src/Data/Diff.hs +++ b/src/Data/Diff.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE DataKinds, LambdaCase, RankNTypes, TypeFamilies, TypeOperators, ScopedTypeVariables, UndecidableInstances #-} +{-# LANGUAGE DataKinds, LambdaCase, OverloadedStrings, RankNTypes, TypeFamilies, TypeOperators, ScopedTypeVariables, UndecidableInstances #-} module Data.Diff ( Diff(..) , DiffF(..) diff --git a/src/Data/Edit.hs b/src/Data/Edit.hs index a98fde90ba..4f17bb588e 100644 --- a/src/Data/Edit.hs +++ b/src/Data/Edit.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE DeriveGeneric, DeriveTraversable, LambdaCase #-} module Data.Edit ( Edit(..) , edit diff --git a/src/Data/Error.hs b/src/Data/Error.hs index 688ac32c77..6995676f01 100644 --- a/src/Data/Error.hs +++ b/src/Data/Error.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE GADTs, RankNTypes #-} +{-# LANGUAGE DeriveFunctor, FlexibleInstances, GADTs, RankNTypes, RecordWildCards #-} module Data.Error ( Error (..) , formatError @@ -34,7 +34,7 @@ data Error grammar = Error , errorExpected :: [grammar] , errorActual :: Maybe grammar , errorCallStack :: CallStack - } deriving (Show, Functor, Typeable) + } deriving (Show, Functor) -- | This instance does not take into account the call stack. instance Eq grammar => Eq (Error grammar) where diff --git a/src/Data/Functor/Classes/Generic.hs b/src/Data/Functor/Classes/Generic.hs index 5e80991136..cfd536d63f 100644 --- a/src/Data/Functor/Classes/Generic.hs +++ b/src/Data/Functor/Classes/Generic.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE TypeOperators, RankNTypes, UndecidableInstances #-} +{-# LANGUAGE FlexibleContexts, FlexibleInstances, MultiParamTypeClasses, TypeOperators, RankNTypes, UndecidableInstances #-} module Data.Functor.Classes.Generic ( Eq1(..) , genericLiftEq diff --git a/src/Data/Graph.hs b/src/Data/Graph.hs index b53f180e78..9366a784d3 100644 --- a/src/Data/Graph.hs +++ b/src/Data/Graph.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE GeneralizedNewtypeDeriving, ScopedTypeVariables, TypeFamilies, UndecidableInstances #-} +{-# LANGUAGE FlexibleContexts, GeneralizedNewtypeDeriving, OverloadedStrings, ScopedTypeVariables, TypeFamilies, UndecidableInstances #-} module Data.Graph ( Graph(..) , overlay diff --git a/src/Data/Graph/ControlFlowVertex.hs b/src/Data/Graph/ControlFlowVertex.hs index 7f792ce1d3..bdb6b6094d 100644 --- a/src/Data/Graph/ControlFlowVertex.hs +++ b/src/Data/Graph/ControlFlowVertex.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE DeriveAnyClass, EmptyCase, ScopedTypeVariables, TypeFamilies, TypeOperators, UndecidableInstances #-} +{-# LANGUAGE DataKinds, EmptyCase, FlexibleInstances, MultiParamTypeClasses, OverloadedStrings, RecordWildCards, ScopedTypeVariables, TypeApplications, TypeFamilies, TypeOperators, UndecidableInstances #-} module Data.Graph.ControlFlowVertex ( ControlFlowVertex (..) , packageVertex @@ -28,19 +28,20 @@ import qualified Data.Syntax.Expression as Expression import Data.Term import qualified Data.Text as T import GHC.Generics (V1) +import Prelude hiding (span) import Prologue -import Source.Loc as Loc +import qualified Source.Loc as Loc import Source.Span -- | A vertex of representing some node in a control flow graph. data ControlFlowVertex - = Package { vertexName :: Text } - | Module { vertexName :: Text } - | UnknownModule { vertexName :: Text } - | Variable { vertexName :: Text, vertexModuleName :: Text, vertexSpan :: Span } - | Method { vertexName :: Text, vertexModuleName :: Text, vertexSpan :: Span } - | Function { vertexName :: Text, vertexModuleName :: Text, vertexSpan :: Span } - deriving (Eq, Ord, Show, Generic, Hashable) + = Package Text + | Module Text + | UnknownModule Text + | Variable Text Text Span + | Method Text Text Span + | Function Text Text Span + deriving (Eq, Ord, Show) packageVertex :: PackageInfo -> ControlFlowVertex packageVertex (PackageInfo name _) = Package (formatName name) @@ -61,10 +62,13 @@ functionVertex :: Text -> ModuleInfo -> Span -> ControlFlowVertex functionVertex name ModuleInfo{..} = Function name (T.pack modulePath) vertexIdentifier :: ControlFlowVertex -> Text -vertexIdentifier v@Package{..} = vertexName <> " (" <> vertexToType v <> ")" -vertexIdentifier v@Module{..} = vertexName <> " (" <> vertexToType v <> ")" -vertexIdentifier v@UnknownModule{..} = vertexName <> " (" <> vertexToType v <> ")" -vertexIdentifier v = vertexModuleName v <> "::" <> vertexName v <> " (" <> vertexToType v <> " " <> showSpan (vertexSpan v) <> ")" +vertexIdentifier v = case v of + Package n -> n <> " (" <> vertexToType v <> ")" + Module n -> n <> " (" <> vertexToType v <> ")" + UnknownModule n -> n <> " (" <> vertexToType v <> ")" + Variable n m s -> m <> "::" <> n <> " (" <> vertexToType v <> " " <> showSpan s <> ")" + Method n m s -> m <> "::" <> n <> " (" <> vertexToType v <> " " <> showSpan s <> ")" + Function n m s -> m <> "::" <> n <> " (" <> vertexToType v <> " " <> showSpan s <> ")" showSpan :: Span -> Text showSpan (Span (Pos a b) (Pos c d)) = T.pack $ @@ -103,7 +107,7 @@ instance ToJSON ControlFlowVertex where class VertexDeclaration term where toVertex :: ModuleInfo - -> term Loc + -> term Loc.Loc -> Maybe (ControlFlowVertex, Name) instance (VertexDeclaration1 f, Declarations1 f) => VertexDeclaration (Term f) where @@ -112,15 +116,15 @@ instance (VertexDeclaration1 f, Declarations1 f) => VertexDeclaration (Term f) w instance (VertexDeclaration1 f, Declarations1 f) => VertexDeclaration (Quieterm f) where toVertex info (Quieterm (In a f)) = liftToVertex toVertex a info f -toVertex1 :: (VertexDeclaration1 f, VertexDeclaration t, Declarations (t Loc)) => Loc -> ModuleInfo -> f (t Loc) -> Maybe (ControlFlowVertex, Name) +toVertex1 :: (VertexDeclaration1 f, VertexDeclaration t, Declarations (t Loc.Loc)) => Loc.Loc -> ModuleInfo -> f (t Loc.Loc) -> Maybe (ControlFlowVertex, Name) toVertex1 = liftToVertex toVertex class VertexDeclaration1 syntax where - liftToVertex :: Declarations (term Loc) - => (ModuleInfo -> term Loc -> Maybe (ControlFlowVertex, Name)) - -> Loc + liftToVertex :: Declarations (term Loc.Loc) + => (ModuleInfo -> term Loc.Loc -> Maybe (ControlFlowVertex, Name)) + -> Loc.Loc -> ModuleInfo - -> syntax (term Loc) + -> syntax (term Loc.Loc) -> Maybe (ControlFlowVertex, Name) instance (VertexDeclarationStrategy1 syntax ~ strategy, VertexDeclarationWithStrategy1 strategy syntax) => VertexDeclaration1 syntax where @@ -138,15 +142,15 @@ type family VertexDeclarationStrategy1 syntax where VertexDeclarationStrategy1 Declaration.Method = 'Custom VertexDeclarationStrategy1 Expression.MemberAccess = 'Custom VertexDeclarationStrategy1 (Sum _) = 'Custom - VertexDeclarationStrategy1 syntax = 'Default + VertexDeclarationStrategy1 _ = 'Default class VertexDeclarationWithStrategy1 (strategy :: Strategy) syntax where - liftToVertexWithStrategy :: Declarations (term Loc) + liftToVertexWithStrategy :: Declarations (term Loc.Loc) => proxy strategy - -> (ModuleInfo -> term Loc -> Maybe (ControlFlowVertex, Name)) - -> Loc + -> (ModuleInfo -> term Loc.Loc -> Maybe (ControlFlowVertex, Name)) + -> Loc.Loc -> ModuleInfo - -> syntax (term Loc) + -> syntax (term Loc.Loc) -> Maybe (ControlFlowVertex, Name) -- | The 'Default' strategy produces 'Nothing'. diff --git a/src/Data/Handle.hs b/src/Data/Handle.hs index 04e1c4c0aa..fbad909aea 100644 --- a/src/Data/Handle.hs +++ b/src/Data/Handle.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE DeriveAnyClass, GADTs #-} +{-# LANGUAGE DataKinds, DeriveAnyClass, GADTs, StandaloneDeriving #-} module Data.Handle ( Handle (..) diff --git a/src/Data/ImportPath.hs b/src/Data/ImportPath.hs index b0e6e41cd4..1adcccd4d5 100644 --- a/src/Data/ImportPath.hs +++ b/src/Data/ImportPath.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE DeriveAnyClass #-} +{-# LANGUAGE DeriveAnyClass, DeriveGeneric #-} module Data.ImportPath (IsRelative(..), ImportPath(..), importPath, toName, defaultAlias) where import Prologue diff --git a/src/Data/JSON/Fields.hs b/src/Data/JSON/Fields.hs index ff63aefc7d..46f7c6b338 100644 --- a/src/Data/JSON/Fields.hs +++ b/src/Data/JSON/Fields.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE DefaultSignatures, MultiParamTypeClasses, TypeOperators, UndecidableInstances, GADTs #-} +{-# LANGUAGE DefaultSignatures, FlexibleContexts, FlexibleInstances, GADTs, MultiParamTypeClasses, OverloadedStrings, RecordWildCards, TypeApplications, TypeOperators, UndecidableInstances #-} module Data.JSON.Fields ( JSONFields (..) , JSONFields1 (..) diff --git a/src/Data/Language.hs b/src/Data/Language.hs index aba94225ee..eafe0c5c2d 100644 --- a/src/Data/Language.hs +++ b/src/Data/Language.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE DeriveAnyClass, DeriveGeneric, KindSignatures, LambdaCase #-} +{-# LANGUAGE DataKinds, DeriveAnyClass, DeriveGeneric, KindSignatures, LambdaCase, OverloadedStrings #-} module Data.Language ( Language (..) , SLanguage (..) diff --git a/src/Data/Map/Monoidal.hs b/src/Data/Map/Monoidal.hs index 6f7d3336d1..a922e28b17 100644 --- a/src/Data/Map/Monoidal.hs +++ b/src/Data/Map/Monoidal.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE GeneralizedNewtypeDeriving #-} +{-# LANGUAGE DeriveTraversable, GeneralizedNewtypeDeriving, MultiParamTypeClasses #-} -- | This module defines a 'Map' type whose 'Monoid' and 'Reducer' instances merge values using the 'Semigroup' instance for the underlying type. module Data.Map.Monoidal ( Map diff --git a/src/Data/Project.hs b/src/Data/Project.hs index 9940495213..815ddbc624 100644 --- a/src/Data/Project.hs +++ b/src/Data/Project.hs @@ -24,7 +24,7 @@ data Project = Project , projectBlobs :: [Blob] , projectLanguage :: Language , projectExcludeDirs :: [FilePath] - } deriving (Eq, Show, Generic) + } deriving (Eq, Show) projectName :: Project -> Text projectName = T.pack . dropExtensions . takeFileName . projectRootDir diff --git a/src/Data/Scientific/Exts.hs b/src/Data/Scientific/Exts.hs index ee67e1b9ea..93a2429ccd 100644 --- a/src/Data/Scientific/Exts.hs +++ b/src/Data/Scientific/Exts.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE OverloadedStrings #-} module Data.Scientific.Exts ( module Data.Scientific , attemptUnsafeArithmetic diff --git a/src/Data/Semigroup/App.hs b/src/Data/Semigroup/App.hs index 54455a9861..330aebc135 100644 --- a/src/Data/Semigroup/App.hs +++ b/src/Data/Semigroup/App.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE GeneralizedNewtypeDeriving #-} +{-# LANGUAGE DeriveTraversable, GeneralizedNewtypeDeriving #-} module Data.Semigroup.App ( App(..) , AppMerge(..) diff --git a/src/Data/Syntax.hs b/src/Data/Syntax.hs index eac08a1d3a..57065ee195 100644 --- a/src/Data/Syntax.hs +++ b/src/Data/Syntax.hs @@ -1,6 +1,5 @@ -{-# LANGUAGE AllowAmbiguousTypes, ConstraintKinds, DeriveAnyClass, RankNTypes, ScopedTypeVariables, TypeFamilies, TypeOperators, UndecidableInstances #-} -{-# OPTIONS_GHC -Wno-missing-export-lists -Wno-redundant-constraints #-} -- For HasCallStack -module Data.Syntax where +{-# LANGUAGE AllowAmbiguousTypes, ConstraintKinds, DataKinds, DeriveAnyClass, DeriveGeneric, DeriveTraversable, FlexibleContexts, FlexibleInstances, MultiParamTypeClasses, OverloadedStrings, RankNTypes, RecordWildCards, ScopedTypeVariables, TypeApplications, TypeFamilies, TypeOperators, UndecidableInstances #-} +module Data.Syntax (module Data.Syntax) where import Data.Abstract.Evaluatable hiding (Empty, Error) import Data.Aeson as Aeson (ToJSON(..), object) @@ -25,15 +24,15 @@ import qualified Data.Abstract.ScopeGraph as ScopeGraph -- Combinators -- | Lift syntax and an annotation into a term, injecting the syntax into a union & ensuring the annotation encompasses all children. -makeTerm :: (HasCallStack, Element syntax syntaxes, Sum syntaxes ~ Syntax term, Semigroup ann, Apply Foldable syntaxes, IsTerm term) => ann -> syntax (term ann) -> term ann +makeTerm :: (Element syntax syntaxes, Sum syntaxes ~ Syntax term, Semigroup ann, Apply Foldable syntaxes, IsTerm term) => ann -> syntax (term ann) -> term ann makeTerm ann = makeTerm' ann . inject -- | Lift a union and an annotation into a term, ensuring the annotation encompasses all children. -makeTerm' :: (HasCallStack, Semigroup ann, Foldable (Syntax term), IsTerm term) => ann -> Syntax term (term ann) -> term ann +makeTerm' :: (Semigroup ann, Foldable (Syntax term), IsTerm term) => ann -> Syntax term (term ann) -> term ann makeTerm' ann syntax = termIn (sconcat (ann :| (termAnnotation <$> toList syntax))) syntax -- | Lift syntax and an annotation into a term, injecting the syntax into a union & ensuring the annotation encompasses all children. Removes extra structure if term is a list of a single item. -makeTerm'' :: (HasCallStack, Element syntax syntaxes, Sum syntaxes ~ Syntax term, Semigroup ann, Apply Foldable syntaxes, Foldable syntax, IsTerm term) => ann -> syntax (term ann) -> term ann +makeTerm'' :: (Element syntax syntaxes, Sum syntaxes ~ Syntax term, Semigroup ann, Apply Foldable syntaxes, Foldable syntax, IsTerm term) => ann -> syntax (term ann) -> term ann makeTerm'' ann children = case toList children of [x] -> x _ -> makeTerm' ann (inject children) @@ -49,7 +48,7 @@ makeTerm1' syntax = case toList syntax of _ -> error "makeTerm1': empty structure" -- | Construct an empty term at the current position. -emptyTerm :: (HasCallStack, Empty :< syntaxes, Sum syntaxes ~ Syntax term, Apply Foldable syntaxes, IsTerm term) => Assignment.Assignment ast grammar (term Loc) +emptyTerm :: (Empty :< syntaxes, Sum syntaxes ~ Syntax term, Apply Foldable syntaxes, IsTerm term) => Assignment.Assignment ast grammar (term Loc) emptyTerm = makeTerm . startLocation <$> Assignment.location <*> pure Empty where startLocation Loc{..} = Loc (Range.point (Range.start byteRange)) (Span.point (Span.start span)) @@ -58,7 +57,7 @@ handleError :: (HasCallStack, Error :< syntaxes, Sum syntaxes ~ Syntax term, Enu handleError = flip Assignment.catchError (\ err -> makeTerm <$> Assignment.location <*> pure (errorSyntax (either id show <$> err) []) <* Assignment.source) -- | Catch parse errors into an error term. -parseError :: (HasCallStack, Error :< syntaxes, Sum syntaxes ~ Syntax term, Bounded grammar, Enum grammar, Ix grammar, Apply Foldable syntaxes, IsTerm term) => Assignment.Assignment ast grammar (term Loc) +parseError :: (Error :< syntaxes, Sum syntaxes ~ Syntax term, Bounded grammar, Enum grammar, Apply Foldable syntaxes, IsTerm term) => Assignment.Assignment ast grammar (term Loc) parseError = makeTerm <$> Assignment.token maxBound <*> pure (Error (ErrorStack $ errorSite <$> getCallStack (freezeCallStack callStack)) [] (Just "ParseError") []) -- | Match context terms before a subject term, wrapping both up in a Context term if any context terms matched, or otherwise returning the subject term. diff --git a/src/Data/Syntax/Comment.hs b/src/Data/Syntax/Comment.hs index 99f18db5d7..bd86028f70 100644 --- a/src/Data/Syntax/Comment.hs +++ b/src/Data/Syntax/Comment.hs @@ -1,6 +1,5 @@ -{-# LANGUAGE DeriveAnyClass, DerivingVia, MultiParamTypeClasses #-} -{-# OPTIONS_GHC -Wno-missing-export-lists #-} -module Data.Syntax.Comment where +{-# LANGUAGE DeriveAnyClass, DeriveGeneric, DeriveTraversable, DerivingVia, MultiParamTypeClasses #-} +module Data.Syntax.Comment (module Data.Syntax.Comment) where import Prologue diff --git a/src/Data/Syntax/Declaration.hs b/src/Data/Syntax/Declaration.hs index 92af9dbe32..e2f55f24c6 100644 --- a/src/Data/Syntax/Declaration.hs +++ b/src/Data/Syntax/Declaration.hs @@ -1,6 +1,5 @@ -{-# LANGUAGE DeriveAnyClass, DerivingVia, MultiParamTypeClasses, ScopedTypeVariables, TupleSections, UndecidableInstances #-} -{-# OPTIONS_GHC -Wno-missing-export-lists #-} -module Data.Syntax.Declaration where +{-# LANGUAGE DeriveAnyClass, DeriveGeneric, DeriveTraversable, FlexibleContexts, MultiParamTypeClasses, RecordWildCards, ScopedTypeVariables, TypeApplications, TupleSections, UndecidableInstances #-} +module Data.Syntax.Declaration (module Data.Syntax.Declaration) where import Prologue diff --git a/src/Data/Syntax/Directive.hs b/src/Data/Syntax/Directive.hs index 1e943d9ddc..145fc469bd 100644 --- a/src/Data/Syntax/Directive.hs +++ b/src/Data/Syntax/Directive.hs @@ -1,6 +1,5 @@ -{-# LANGUAGE DeriveAnyClass, DerivingVia, MultiParamTypeClasses, ScopedTypeVariables, UndecidableInstances #-} -{-# OPTIONS_GHC -Wno-missing-export-lists #-} -module Data.Syntax.Directive where +{-# LANGUAGE DeriveAnyClass, DeriveGeneric, DeriveTraversable, MultiParamTypeClasses, ScopedTypeVariables, UndecidableInstances #-} +module Data.Syntax.Directive (module Data.Syntax.Directive) where import Prologue diff --git a/src/Data/Syntax/Expression.hs b/src/Data/Syntax/Expression.hs index a62ee68ecf..2dfd332415 100644 --- a/src/Data/Syntax/Expression.hs +++ b/src/Data/Syntax/Expression.hs @@ -1,6 +1,5 @@ -{-# LANGUAGE DeriveAnyClass, DerivingVia, DuplicateRecordFields, MultiParamTypeClasses, ScopedTypeVariables, UndecidableInstances #-} -{-# OPTIONS_GHC -Wno-missing-export-lists #-} -module Data.Syntax.Expression where +{-# LANGUAGE DeriveAnyClass, DeriveGeneric, DeriveTraversable, DuplicateRecordFields, FlexibleContexts, MultiParamTypeClasses, OverloadedStrings, RecordWildCards, ScopedTypeVariables, TypeApplications, UndecidableInstances #-} +module Data.Syntax.Expression (module Data.Syntax.Expression) where import Prelude hiding (null) import Prologue hiding (index, null) diff --git a/src/Data/Syntax/Literal.hs b/src/Data/Syntax/Literal.hs index 70b7a984fe..4d3a8569d6 100644 --- a/src/Data/Syntax/Literal.hs +++ b/src/Data/Syntax/Literal.hs @@ -1,6 +1,5 @@ -{-# LANGUAGE DeriveAnyClass, DerivingVia, DuplicateRecordFields, ScopedTypeVariables #-} -{-# OPTIONS_GHC -Wno-missing-export-lists #-} -module Data.Syntax.Literal where +{-# LANGUAGE DeriveAnyClass, DeriveGeneric, DeriveTraversable, DuplicateRecordFields, OverloadedStrings, RecordWildCards, ScopedTypeVariables, TypeApplications #-} +module Data.Syntax.Literal (module Data.Syntax.Literal) where import Prelude hiding (Float, null) import Prologue hiding (Set, hash, null) @@ -16,8 +15,7 @@ import Text.Read (readMaybe) -- Boolean newtype Boolean a = Boolean { booleanContent :: Bool } - deriving stock (Foldable, Traversable, Functor, Generic1) - deriving anyclass (Hashable1, Diffable, FreeVariables1, Declarations1, ToJSONFields1) + deriving (Declarations1, Diffable, Foldable, FreeVariables1, Functor, Generic1, Hashable1, ToJSONFields1, Traversable) instance Eq1 Boolean where liftEq = genericLiftEq instance Ord1 Boolean where liftCompare = genericLiftCompare diff --git a/src/Data/Syntax/Statement.hs b/src/Data/Syntax/Statement.hs index a15d7e5fc6..e63f2ad1eb 100644 --- a/src/Data/Syntax/Statement.hs +++ b/src/Data/Syntax/Statement.hs @@ -1,6 +1,5 @@ -{-# LANGUAGE DeriveAnyClass, DerivingVia, ScopedTypeVariables, UndecidableInstances, ViewPatterns, DuplicateRecordFields #-} -{-# OPTIONS_GHC -Wno-missing-export-lists #-} -module Data.Syntax.Statement where +{-# LANGUAGE DeriveAnyClass, DeriveGeneric, DeriveTraversable, DuplicateRecordFields, RecordWildCards, ScopedTypeVariables, TypeApplications, UndecidableInstances, ViewPatterns #-} +module Data.Syntax.Statement (module Data.Syntax.Statement) where import Prologue diff --git a/src/Data/Syntax/Type.hs b/src/Data/Syntax/Type.hs index d63a268280..0108792286 100644 --- a/src/Data/Syntax/Type.hs +++ b/src/Data/Syntax/Type.hs @@ -1,6 +1,5 @@ -{-# LANGUAGE DataKinds, DeriveAnyClass, DerivingVia, DuplicateRecordFields, DeriveGeneric, MultiParamTypeClasses, UndecidableInstances #-} -{-# OPTIONS_GHC -Wno-missing-export-lists #-} -module Data.Syntax.Type where +{-# LANGUAGE DataKinds, DeriveAnyClass, DeriveGeneric, DeriveTraversable, DuplicateRecordFields, MultiParamTypeClasses, RecordWildCards, UndecidableInstances #-} +module Data.Syntax.Type (module Data.Syntax.Type) where import Data.Abstract.Evaluatable import Data.JSON.Fields diff --git a/src/Data/Term.hs b/src/Data/Term.hs index 718fa3280c..c9a9277e10 100644 --- a/src/Data/Term.hs +++ b/src/Data/Term.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE FunctionalDependencies, RankNTypes, ScopedTypeVariables, TypeFamilies, TypeOperators #-} +{-# LANGUAGE DeriveGeneric, DeriveTraversable, FlexibleContexts, FlexibleInstances, FunctionalDependencies, RankNTypes, ScopedTypeVariables, TypeFamilies, TypeOperators #-} module Data.Term ( Term(..) , TermF(..) diff --git a/src/Diffing/Algorithm.hs b/src/Diffing/Algorithm.hs index 391daade98..8d2b986073 100644 --- a/src/Diffing/Algorithm.hs +++ b/src/Diffing/Algorithm.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE DeriveAnyClass, DefaultSignatures, DerivingStrategies, GeneralizedNewtypeDeriving, KindSignatures, TypeOperators, UndecidableInstances #-} +{-# LANGUAGE DefaultSignatures, DeriveFunctor, DeriveGeneric, FlexibleContexts, FlexibleInstances, GeneralizedNewtypeDeriving, KindSignatures, MultiParamTypeClasses, TypeApplications, TypeOperators, UndecidableInstances #-} module Diffing.Algorithm ( Diff (..) , Algorithm(..) @@ -37,12 +37,13 @@ data Diff term1 term2 diff (m :: * -> *) k | Insert term2 (diff -> m k) -- | Replace one term with another. | Replace term1 term2 (diff -> m k) - deriving stock (Functor, Generic1) - deriving anyclass (HFunctor, Effect) + deriving (Functor, Generic1) +instance HFunctor (Diff term1 term2 diff) +instance Effect (Diff term1 term2 diff) newtype Algorithm term1 term2 diff m a = Algorithm { runAlgorithm :: m a } - deriving newtype (Applicative, Alternative, Functor, Monad) + deriving (Applicative, Alternative, Functor, Monad) instance Carrier sig m => Carrier sig (Algorithm term1 term2 diff m) where eff = Algorithm . eff . handleCoercible diff --git a/src/Diffing/Algorithm/RWS.hs b/src/Diffing/Algorithm/RWS.hs index c705353b59..b57aad0ba4 100644 --- a/src/Diffing/Algorithm/RWS.hs +++ b/src/Diffing/Algorithm/RWS.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE GADTs, DataKinds, DeriveAnyClass, RankNTypes, TypeOperators #-} +{-# LANGUAGE DataKinds, DeriveAnyClass, DeriveGeneric, GADTs, RankNTypes, RecordWildCards, TypeOperators #-} {-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-} -- FIXME module Diffing.Algorithm.RWS ( rws diff --git a/src/Diffing/Interpreter.hs b/src/Diffing/Interpreter.hs index 4791d5128d..49a2c019b1 100644 --- a/src/Diffing/Interpreter.hs +++ b/src/Diffing/Interpreter.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE GeneralizedNewtypeDeriving, TypeOperators, UndecidableInstances #-} +{-# LANGUAGE FlexibleInstances, GeneralizedNewtypeDeriving, MultiParamTypeClasses, TypeOperators, UndecidableInstances #-} module Diffing.Interpreter ( diffTerms , DiffTerms(..) diff --git a/src/Language/Go/Assignment.hs b/src/Language/Go/Assignment.hs index 8e2acadef0..effb4a39a3 100644 --- a/src/Language/Go/Assignment.hs +++ b/src/Language/Go/Assignment.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE DataKinds, RankNTypes, TypeFamilies, TypeOperators #-} +{-# LANGUAGE DataKinds, FlexibleContexts, RankNTypes, TypeFamilies, TypeOperators #-} module Language.Go.Assignment ( assignment , Go.Syntax diff --git a/src/Language/Go/Syntax.hs b/src/Language/Go/Syntax.hs index fbe0053889..c34ed9458c 100644 --- a/src/Language/Go/Syntax.hs +++ b/src/Language/Go/Syntax.hs @@ -1,6 +1,5 @@ -{-# LANGUAGE DeriveAnyClass, DerivingVia #-} -{-# OPTIONS_GHC -Wno-missing-export-lists #-} -module Language.Go.Syntax where +{-# LANGUAGE DeriveAnyClass, DeriveGeneric, DeriveTraversable, FlexibleContexts, RecordWildCards, TypeApplications #-} +module Language.Go.Syntax (module Language.Go.Syntax) where import Prologue diff --git a/src/Language/Go/Term.hs b/src/Language/Go/Term.hs index 7cc08ec46a..c2292f1811 100644 --- a/src/Language/Go/Term.hs +++ b/src/Language/Go/Term.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE DataKinds, GeneralizedNewtypeDeriving, TypeFamilies #-} +{-# LANGUAGE DataKinds, GeneralizedNewtypeDeriving, RecordWildCards, TypeFamilies #-} module Language.Go.Term ( Syntax , Term(..) diff --git a/src/Language/Go/Type.hs b/src/Language/Go/Type.hs index b4b09c5383..1548779e51 100644 --- a/src/Language/Go/Type.hs +++ b/src/Language/Go/Type.hs @@ -1,6 +1,5 @@ -{-# LANGUAGE DeriveAnyClass, DerivingVia, DuplicateRecordFields #-} -{-# OPTIONS_GHC -Wno-missing-export-lists #-} -module Language.Go.Type where +{-# LANGUAGE DeriveAnyClass, DeriveGeneric, DeriveTraversable, DuplicateRecordFields #-} +module Language.Go.Type (module Language.Go.Type) where import Prologue diff --git a/src/Language/Markdown/Assignment.hs b/src/Language/Markdown/Assignment.hs index d27165420e..d1124bc3bf 100644 --- a/src/Language/Markdown/Assignment.hs +++ b/src/Language/Markdown/Assignment.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE DataKinds, RankNTypes, TypeFamilies, TypeOperators #-} +{-# LANGUAGE DataKinds, FlexibleContexts, RankNTypes, RecordWildCards, TypeFamilies, TypeOperators #-} module Language.Markdown.Assignment ( assignment , Markdown.Syntax diff --git a/src/Language/Markdown/Syntax.hs b/src/Language/Markdown/Syntax.hs index 859040856f..1889074265 100644 --- a/src/Language/Markdown/Syntax.hs +++ b/src/Language/Markdown/Syntax.hs @@ -1,6 +1,5 @@ -{-# LANGUAGE DeriveAnyClass, DerivingVia, DuplicateRecordFields #-} -{-# OPTIONS_GHC -Wno-missing-export-lists #-} -module Language.Markdown.Syntax where +{-# LANGUAGE DeriveAnyClass, DeriveGeneric, DeriveTraversable, DuplicateRecordFields #-} +module Language.Markdown.Syntax (module Language.Markdown.Syntax) where import Data.Abstract.Declarations import Data.JSON.Fields diff --git a/src/Language/Markdown/Term.hs b/src/Language/Markdown/Term.hs index acb3bf79c6..39f29daa16 100644 --- a/src/Language/Markdown/Term.hs +++ b/src/Language/Markdown/Term.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE DataKinds, GeneralizedNewtypeDeriving, TypeFamilies #-} +{-# LANGUAGE DataKinds, GeneralizedNewtypeDeriving, RecordWildCards, TypeFamilies #-} module Language.Markdown.Term ( Syntax , Term(..) diff --git a/src/Language/PHP/Assignment.hs b/src/Language/PHP/Assignment.hs index 8d7e629276..54aab1283d 100644 --- a/src/Language/PHP/Assignment.hs +++ b/src/Language/PHP/Assignment.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE DataKinds, RankNTypes, TypeFamilies, TypeOperators #-} +{-# LANGUAGE DataKinds, FlexibleContexts, RankNTypes, TypeFamilies, TypeOperators #-} module Language.PHP.Assignment ( assignment , PHP.Syntax diff --git a/src/Language/PHP/Syntax.hs b/src/Language/PHP/Syntax.hs index 5f01b99bd0..875ff99fa4 100644 --- a/src/Language/PHP/Syntax.hs +++ b/src/Language/PHP/Syntax.hs @@ -1,6 +1,5 @@ -{-# LANGUAGE DeriveAnyClass, DerivingVia, DuplicateRecordFields #-} -{-# OPTIONS_GHC -Wno-missing-export-lists #-} -module Language.PHP.Syntax where +{-# LANGUAGE DeriveAnyClass, DeriveGeneric, DeriveTraversable, DuplicateRecordFields, FlexibleContexts #-} +module Language.PHP.Syntax (module Language.PHP.Syntax) where import Prologue hiding (Text) diff --git a/src/Language/PHP/Term.hs b/src/Language/PHP/Term.hs index 4a0f8c114c..0f2d68d08f 100644 --- a/src/Language/PHP/Term.hs +++ b/src/Language/PHP/Term.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE DataKinds, GeneralizedNewtypeDeriving, TypeFamilies #-} +{-# LANGUAGE DataKinds, GeneralizedNewtypeDeriving, RecordWildCards, TypeFamilies #-} module Language.PHP.Term ( Syntax , Term(..) diff --git a/src/Language/Python/Assignment.hs b/src/Language/Python/Assignment.hs index 724166759d..c63dfbc7ca 100644 --- a/src/Language/Python/Assignment.hs +++ b/src/Language/Python/Assignment.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE DataKinds, RankNTypes, TypeFamilies, TypeOperators #-} +{-# LANGUAGE DataKinds, FlexibleContexts, RankNTypes, TypeFamilies, TypeOperators #-} module Language.Python.Assignment ( assignment , Python.Syntax diff --git a/src/Language/Python/Syntax.hs b/src/Language/Python/Syntax.hs index ba11abe8fd..dc56eaa3b7 100644 --- a/src/Language/Python/Syntax.hs +++ b/src/Language/Python/Syntax.hs @@ -1,6 +1,5 @@ -{-# LANGUAGE DeriveAnyClass, DerivingVia #-} -{-# OPTIONS_GHC -Wno-missing-export-lists #-} -module Language.Python.Syntax where +{-# LANGUAGE DeriveAnyClass, DeriveGeneric, DeriveTraversable, FlexibleContexts, RecordWildCards, TypeApplications #-} +module Language.Python.Syntax (module Language.Python.Syntax) where import Prologue @@ -24,8 +23,8 @@ import Diffing.Algorithm import Source.Span data QualifiedName - = QualifiedName { paths :: NonEmpty FilePath } - | RelativeQualifiedName { path :: FilePath, maybeQualifiedName :: Maybe QualifiedName } + = QualifiedName (NonEmpty FilePath) + | RelativeQualifiedName FilePath (Maybe QualifiedName) deriving (Eq, Generic, Hashable, Ord, Show, ToJSON) qualifiedName :: NonEmpty Text -> QualifiedName diff --git a/src/Language/Python/Term.hs b/src/Language/Python/Term.hs index 12e996eb99..b5e1873fd8 100644 --- a/src/Language/Python/Term.hs +++ b/src/Language/Python/Term.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE DataKinds, GeneralizedNewtypeDeriving, TypeFamilies #-} +{-# LANGUAGE DataKinds, GeneralizedNewtypeDeriving, RecordWildCards, TypeFamilies #-} module Language.Python.Term ( Syntax , Term(..) diff --git a/src/Language/Ruby/Assignment.hs b/src/Language/Ruby/Assignment.hs index a3a791d2a3..241ea61173 100644 --- a/src/Language/Ruby/Assignment.hs +++ b/src/Language/Ruby/Assignment.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE DataKinds, RankNTypes, TypeFamilies, TypeOperators #-} +{-# LANGUAGE DataKinds, FlexibleContexts, OverloadedStrings, RankNTypes, TypeFamilies, TypeOperators #-} module Language.Ruby.Assignment ( assignment , Ruby.Syntax diff --git a/src/Language/Ruby/Syntax.hs b/src/Language/Ruby/Syntax.hs index 9ea8ea2b81..ca1f577609 100644 --- a/src/Language/Ruby/Syntax.hs +++ b/src/Language/Ruby/Syntax.hs @@ -1,6 +1,5 @@ -{-# LANGUAGE DeriveAnyClass, DerivingVia, DuplicateRecordFields, TupleSections #-} -{-# OPTIONS_GHC -Wno-missing-export-lists #-} -module Language.Ruby.Syntax where +{-# LANGUAGE DeriveAnyClass, DeriveGeneric, DeriveTraversable, DuplicateRecordFields, FlexibleContexts, OverloadedStrings, RecordWildCards, TupleSections, TypeApplications #-} +module Language.Ruby.Syntax (module Language.Ruby.Syntax) where import Prologue diff --git a/src/Language/Ruby/Term.hs b/src/Language/Ruby/Term.hs index 21dc713cb1..69b6cbf8d1 100644 --- a/src/Language/Ruby/Term.hs +++ b/src/Language/Ruby/Term.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE DataKinds, GeneralizedNewtypeDeriving, TypeFamilies #-} +{-# LANGUAGE DataKinds, GeneralizedNewtypeDeriving, RecordWildCards, TypeFamilies #-} module Language.Ruby.Term ( Syntax , Term(..) diff --git a/src/Language/TSX/Assignment.hs b/src/Language/TSX/Assignment.hs index 8a2ad7f7d4..5f4d977781 100644 --- a/src/Language/TSX/Assignment.hs +++ b/src/Language/TSX/Assignment.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE DataKinds, RankNTypes, TypeFamilies, TypeOperators #-} +{-# LANGUAGE DataKinds, FlexibleContexts, OverloadedStrings, RankNTypes, TypeFamilies, TypeOperators #-} module Language.TSX.Assignment ( assignment , TSX.Syntax diff --git a/src/Language/TSX/Syntax/JSX.hs b/src/Language/TSX/Syntax/JSX.hs index 23fa8e5717..73123621ff 100644 --- a/src/Language/TSX/Syntax/JSX.hs +++ b/src/Language/TSX/Syntax/JSX.hs @@ -1,6 +1,5 @@ -{-# LANGUAGE DeriveAnyClass, DerivingVia, DuplicateRecordFields #-} -{-# OPTIONS_GHC -Wno-missing-export-lists #-} -module Language.TSX.Syntax.JSX where +{-# LANGUAGE DeriveAnyClass, DeriveGeneric, DeriveTraversable, DuplicateRecordFields #-} +module Language.TSX.Syntax.JSX (module Language.TSX.Syntax.JSX) where import Prologue diff --git a/src/Language/TSX/Term.hs b/src/Language/TSX/Term.hs index 9f51ed1147..f5a79a59be 100644 --- a/src/Language/TSX/Term.hs +++ b/src/Language/TSX/Term.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE DataKinds, GeneralizedNewtypeDeriving, TypeFamilies #-} +{-# LANGUAGE DataKinds, GeneralizedNewtypeDeriving, RecordWildCards, TypeFamilies #-} module Language.TSX.Term ( Syntax , Term(..) diff --git a/src/Language/TypeScript/Assignment.hs b/src/Language/TypeScript/Assignment.hs index b0bb5c1263..6e501252f4 100644 --- a/src/Language/TypeScript/Assignment.hs +++ b/src/Language/TypeScript/Assignment.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE DataKinds, RankNTypes, TypeFamilies, TypeOperators #-} +{-# LANGUAGE DataKinds, FlexibleContexts, OverloadedStrings, RankNTypes, TypeFamilies, TypeOperators #-} module Language.TypeScript.Assignment ( assignment , TypeScript.Syntax diff --git a/src/Language/TypeScript/Resolution.hs b/src/Language/TypeScript/Resolution.hs index 6fd40cfea4..d37103a59e 100644 --- a/src/Language/TypeScript/Resolution.hs +++ b/src/Language/TypeScript/Resolution.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE FlexibleContexts, RecordWildCards #-} module Language.TypeScript.Resolution ( ImportPath (..) , IsRelative (..) diff --git a/src/Language/TypeScript/Syntax/Import.hs b/src/Language/TypeScript/Syntax/Import.hs index 104d94acd1..7475965831 100644 --- a/src/Language/TypeScript/Syntax/Import.hs +++ b/src/Language/TypeScript/Syntax/Import.hs @@ -1,6 +1,5 @@ -{-# LANGUAGE DeriveAnyClass, DerivingVia, DuplicateRecordFields #-} -{-# OPTIONS_GHC -Wno-missing-export-lists #-} -module Language.TypeScript.Syntax.Import where +{-# LANGUAGE DeriveAnyClass, DeriveGeneric, DeriveTraversable, DuplicateRecordFields, OverloadedStrings, RecordWildCards, TypeApplications #-} +module Language.TypeScript.Syntax.Import (module Language.TypeScript.Syntax.Import) where import Prologue diff --git a/src/Language/TypeScript/Syntax/JavaScript.hs b/src/Language/TypeScript/Syntax/JavaScript.hs index e275904528..d5918b3b61 100644 --- a/src/Language/TypeScript/Syntax/JavaScript.hs +++ b/src/Language/TypeScript/Syntax/JavaScript.hs @@ -1,6 +1,5 @@ -{-# LANGUAGE DeriveAnyClass, DerivingVia, DuplicateRecordFields #-} -{-# OPTIONS_GHC -Wno-missing-export-lists #-} -module Language.TypeScript.Syntax.JavaScript where +{-# LANGUAGE DeriveAnyClass, DeriveGeneric, DeriveTraversable, DuplicateRecordFields, RecordWildCards, TypeApplications #-} +module Language.TypeScript.Syntax.JavaScript (module Language.TypeScript.Syntax.JavaScript) where import Prologue diff --git a/src/Language/TypeScript/Syntax/TypeScript.hs b/src/Language/TypeScript/Syntax/TypeScript.hs index 15be9afcff..b7102b11ad 100644 --- a/src/Language/TypeScript/Syntax/TypeScript.hs +++ b/src/Language/TypeScript/Syntax/TypeScript.hs @@ -1,6 +1,5 @@ -{-# LANGUAGE DeriveAnyClass, DerivingVia, DuplicateRecordFields, TupleSections #-} -{-# OPTIONS_GHC -Wno-missing-export-lists #-} -module Language.TypeScript.Syntax.TypeScript where +{-# LANGUAGE DeriveAnyClass, DeriveGeneric, DeriveTraversable, DuplicateRecordFields, FlexibleContexts, RecordWildCards, TupleSections, TypeApplications #-} +module Language.TypeScript.Syntax.TypeScript (module Language.TypeScript.Syntax.TypeScript) where import Prologue diff --git a/src/Language/TypeScript/Syntax/Types.hs b/src/Language/TypeScript/Syntax/Types.hs index 7c419ccaf6..47acf759d7 100644 --- a/src/Language/TypeScript/Syntax/Types.hs +++ b/src/Language/TypeScript/Syntax/Types.hs @@ -1,6 +1,5 @@ -{-# LANGUAGE DeriveAnyClass, DerivingVia, DuplicateRecordFields #-} -{-# OPTIONS_GHC -Wno-missing-export-lists #-} -module Language.TypeScript.Syntax.Types where +{-# LANGUAGE DeriveAnyClass, DeriveGeneric, DeriveTraversable, DuplicateRecordFields, RecordWildCards, TypeApplications #-} +module Language.TypeScript.Syntax.Types (module Language.TypeScript.Syntax.Types) where import Prologue diff --git a/src/Language/TypeScript/Term.hs b/src/Language/TypeScript/Term.hs index 096c37451a..52154caae3 100644 --- a/src/Language/TypeScript/Term.hs +++ b/src/Language/TypeScript/Term.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE DataKinds, GeneralizedNewtypeDeriving, TypeFamilies #-} +{-# LANGUAGE DataKinds, GeneralizedNewtypeDeriving, RecordWildCards, TypeFamilies #-} module Language.TypeScript.Term ( Syntax , Term(..) diff --git a/src/Numeric/Exts.hs b/src/Numeric/Exts.hs index 990710c97c..9a18498c12 100644 --- a/src/Numeric/Exts.hs +++ b/src/Numeric/Exts.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE OverloadedStrings, TypeApplications #-} module Numeric.Exts ( parseInteger , hex diff --git a/src/Parsing/CMark.hs b/src/Parsing/CMark.hs index e02754ec02..4703d54777 100644 --- a/src/Parsing/CMark.hs +++ b/src/Parsing/CMark.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE DataKinds, TypeOperators #-} +{-# LANGUAGE DataKinds, RecordWildCards, TypeOperators #-} module Parsing.CMark ( Grammar(..) , cmarkParser diff --git a/src/Parsing/Parser.hs b/src/Parsing/Parser.hs index 9572e6216c..c48988b325 100644 --- a/src/Parsing/Parser.hs +++ b/src/Parsing/Parser.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE ConstraintKinds, DataKinds, GADTs, TypeFamilies #-} +{-# LANGUAGE ConstraintKinds, DataKinds, GADTs, TypeApplications, TypeFamilies #-} module Parsing.Parser ( Parser(..) -- * Parsers diff --git a/src/Parsing/TreeSitter.hs b/src/Parsing/TreeSitter.hs index c3f707ea53..16321ee4d6 100644 --- a/src/Parsing/TreeSitter.hs +++ b/src/Parsing/TreeSitter.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE DataKinds, GADTs, LambdaCase, ScopedTypeVariables, TypeOperators #-} +{-# LANGUAGE DataKinds, DeriveGeneric, FlexibleContexts, GADTs, LambdaCase, RecordWildCards, ScopedTypeVariables, TypeOperators #-} module Parsing.TreeSitter ( TSParseException (..) , Duration(..) diff --git a/src/Proto/Semantic_JSON.hs b/src/Proto/Semantic_JSON.hs index dbad1fe80a..c71613ff61 100644 --- a/src/Proto/Semantic_JSON.hs +++ b/src/Proto/Semantic_JSON.hs @@ -1,4 +1,5 @@ -- Code generated by protoc-gen-jsonpb_haskell 0.1.0, DO NOT EDIT. +{-# LANGUAGE OverloadedStrings #-} {-# OPTIONS_GHC -Wno-orphans -Wno-unused-imports -Wno-missing-export-lists #-} module Proto.Semantic_JSON where diff --git a/src/Rendering/Graph.hs b/src/Rendering/Graph.hs index 5994c724fb..02b496949a 100644 --- a/src/Rendering/Graph.hs +++ b/src/Rendering/Graph.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE FunctionalDependencies, MonoLocalBinds #-} +{-# LANGUAGE FlexibleContexts, FlexibleInstances, FunctionalDependencies, MonoLocalBinds, OverloadedStrings #-} module Rendering.Graph ( renderTreeGraph , termStyle diff --git a/src/Rendering/JSON.hs b/src/Rendering/JSON.hs index e2486c8803..6ca790978b 100644 --- a/src/Rendering/JSON.hs +++ b/src/Rendering/JSON.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE DataKinds, GADTs, GeneralizedNewtypeDeriving, KindSignatures, ScopedTypeVariables #-} +{-# LANGUAGE DataKinds, GADTs, GeneralizedNewtypeDeriving, KindSignatures, OverloadedStrings, RecordWildCards, ScopedTypeVariables, TypeApplications #-} module Rendering.JSON ( JSON(..) , renderJSONDiff diff --git a/src/Rendering/TOC.hs b/src/Rendering/TOC.hs index 6033afc037..a0090fa4df 100644 --- a/src/Rendering/TOC.hs +++ b/src/Rendering/TOC.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE DerivingVia, DuplicateRecordFields, LambdaCase, RankNTypes, ScopedTypeVariables, TupleSections #-} +{-# LANGUAGE DeriveGeneric, DerivingVia, DuplicateRecordFields, LambdaCase, OverloadedStrings, RankNTypes, RecordWildCards, ScopedTypeVariables, TupleSections #-} module Rendering.TOC ( diffTOC , Summaries(..) diff --git a/src/Semantic/Analysis.hs b/src/Semantic/Analysis.hs index e66361d6d3..3a70f9a444 100644 --- a/src/Semantic/Analysis.hs +++ b/src/Semantic/Analysis.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE TypeFamilies, TypeOperators #-} +{-# LANGUAGE DataKinds, FlexibleContexts, TypeFamilies, TypeOperators #-} module Semantic.Analysis ( evaluate , runDomainEffects diff --git a/src/Semantic/Api/Bridge.hs b/src/Semantic/Api/Bridge.hs index 1c3c66c190..b87065fa75 100644 --- a/src/Semantic/Api/Bridge.hs +++ b/src/Semantic/Api/Bridge.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE FunctionalDependencies #-} +{-# LANGUAGE FlexibleContexts, FlexibleInstances, FunctionalDependencies, RecordWildCards #-} module Semantic.Api.Bridge ( APIBridge (..) , APIConvert (..) diff --git a/src/Semantic/Api/Diffs.hs b/src/Semantic/Api/Diffs.hs index ae18a36ab0..0f624ea532 100644 --- a/src/Semantic/Api/Diffs.hs +++ b/src/Semantic/Api/Diffs.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE AllowAmbiguousTypes, MonoLocalBinds, RankNTypes, UndecidableInstances #-} +{-# LANGUAGE AllowAmbiguousTypes, DataKinds, FlexibleContexts, FlexibleInstances, MonoLocalBinds, RankNTypes, UndecidableInstances #-} module Semantic.Api.Diffs ( parseDiffBuilder , DiffOutputFormat(..) diff --git a/src/Semantic/Api/LegacyTypes.hs b/src/Semantic/Api/LegacyTypes.hs index 51aa8ff7bd..02d0542b63 100644 --- a/src/Semantic/Api/LegacyTypes.hs +++ b/src/Semantic/Api/LegacyTypes.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE DerivingVia, DeriveAnyClass, DuplicateRecordFields #-} +{-# LANGUAGE DeriveGeneric, DerivingVia, DeriveAnyClass, DuplicateRecordFields, OverloadedStrings, RecordWildCards #-} module Semantic.Api.LegacyTypes ( DiffTreeRequest(..) , ParseTreeRequest(..) @@ -14,27 +14,24 @@ import Data.Blob hiding (File(..)) import Prologue newtype DiffTreeRequest = DiffTreeRequest { blobs :: [BlobPair] } - deriving stock (Eq, Show, Generic) - deriving anyclass (FromJSON) + deriving (Eq, Show, Generic, FromJSON) -- -- Legacy Symbols API -- newtype ParseTreeRequest = ParseTreeRequest { blobs :: [Blob] } - deriving stock (Eq, Show, Generic) - deriving anyclass (FromJSON) + deriving (Eq, Show, Generic, FromJSON) newtype ParseTreeSymbolResponse = ParseTreeSymbolResponse { files :: [File] } - deriving stock (Eq, Show, Generic) - deriving anyclass (ToJSON) + deriving (Eq, Show, Generic, ToJSON) data File = File { filePath :: Text , fileLanguage :: Text , fileSymbols :: [Symbol] } - deriving stock (Generic, Eq, Show) + deriving (Eq, Show, Generic) instance ToJSON File where toJSON File{..} @@ -49,7 +46,7 @@ data Symbol = Symbol , symbolLine :: Text , symbolSpan :: Maybe Span } - deriving stock (Generic, Eq, Show) + deriving (Generic, Eq, Show) instance ToJSON Symbol where toJSON Symbol{..} @@ -60,11 +57,10 @@ instance ToJSON Symbol where ] data Position = Position { line :: Int, column :: Int } - deriving stock (Eq, Ord, Show, Generic) + deriving (Eq, Ord, Show, Generic) instance ToJSON Position where toJSON Position{..} = toJSON [line, column] data Span = Span { start :: Maybe Position, end :: Maybe Position } - deriving stock (Eq, Ord, Show, Generic) - deriving anyclass (ToJSON) + deriving (Eq, Ord, Show, Generic, ToJSON) diff --git a/src/Semantic/Api/Symbols.hs b/src/Semantic/Api/Symbols.hs index 8e6810c1f3..63116a676f 100644 --- a/src/Semantic/Api/Symbols.hs +++ b/src/Semantic/Api/Symbols.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE AllowAmbiguousTypes, ScopedTypeVariables, TypeFamilies, UndecidableInstances #-} +{-# LANGUAGE AllowAmbiguousTypes, DataKinds, FlexibleContexts, FlexibleInstances, MultiParamTypeClasses, OverloadedStrings, RecordWildCards, ScopedTypeVariables, TypeApplications, TypeFamilies, UndecidableInstances #-} module Semantic.Api.Symbols ( legacyParseSymbols , parseSymbols diff --git a/src/Semantic/Api/TOCSummaries.hs b/src/Semantic/Api/TOCSummaries.hs index f9523eb5d1..56f8b3bd07 100644 --- a/src/Semantic/Api/TOCSummaries.hs +++ b/src/Semantic/Api/TOCSummaries.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE AllowAmbiguousTypes, DataKinds, LambdaCase, ScopedTypeVariables, TupleSections, TypeFamilies, UndecidableInstances #-} +{-# LANGUAGE AllowAmbiguousTypes, DataKinds, FlexibleContexts, FlexibleInstances, LambdaCase, MultiParamTypeClasses, RecordWildCards, ScopedTypeVariables, TupleSections, TypeApplications, TypeFamilies, UndecidableInstances #-} module Semantic.Api.TOCSummaries ( diffSummary , legacyDiffSummary diff --git a/src/Semantic/Api/Terms.hs b/src/Semantic/Api/Terms.hs index 1ffad1003d..1b35c2ad61 100644 --- a/src/Semantic/Api/Terms.hs +++ b/src/Semantic/Api/Terms.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE AllowAmbiguousTypes, ConstraintKinds, RankNTypes, ScopedTypeVariables, TypeFamilies, UndecidableInstances #-} +{-# LANGUAGE AllowAmbiguousTypes, DataKinds, FlexibleContexts, FlexibleInstances, MultiParamTypeClasses, RankNTypes, RecordWildCards, ScopedTypeVariables, TypeApplications, TypeFamilies, UndecidableInstances #-} module Semantic.Api.Terms ( termGraph , parseTermBuilder diff --git a/src/Semantic/CLI.hs b/src/Semantic/CLI.hs index ba2bab1668..4e4525363c 100644 --- a/src/Semantic/CLI.hs +++ b/src/Semantic/CLI.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE ApplicativeDo #-} +{-# LANGUAGE ApplicativeDo, FlexibleContexts #-} module Semantic.CLI (main) where import qualified Control.Carrier.Parse.Measured as Parse @@ -29,13 +29,12 @@ import qualified System.Path.PartClass as Path.PartClass import Control.Concurrent (mkWeakThreadId, myThreadId) import Control.Exception (Exception(..), throwTo) -import Data.Typeable (Typeable) import System.Posix.Signals import System.Mem.Weak (deRefWeak) import Proto.Semantic_JSON() newtype SignalException = SignalException Signal - deriving (Show, Typeable) + deriving (Show) instance Exception SignalException installSignalHandlers :: IO () diff --git a/src/Semantic/Config.hs b/src/Semantic/Config.hs index 03f3eeb6ff..07a0fed5cb 100644 --- a/src/Semantic/Config.hs +++ b/src/Semantic/Config.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE RecordWildCards #-} module Semantic.Config ( Config (..) , defaultConfig diff --git a/src/Semantic/Distribute.hs b/src/Semantic/Distribute.hs index af2c920983..b4e198e4b5 100644 --- a/src/Semantic/Distribute.hs +++ b/src/Semantic/Distribute.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE ExistentialQuantification, GeneralizedNewtypeDeriving, TypeOperators, UndecidableInstances #-} +{-# LANGUAGE DeriveFunctor, ExistentialQuantification, FlexibleContexts, FlexibleInstances, GeneralizedNewtypeDeriving, MultiParamTypeClasses, StandaloneDeriving, TypeOperators, UndecidableInstances #-} module Semantic.Distribute ( distribute , distributeFor diff --git a/src/Semantic/Graph.hs b/src/Semantic/Graph.hs index 7def5735a5..4ce3562eb6 100644 --- a/src/Semantic/Graph.hs +++ b/src/Semantic/Graph.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE GADTs, LambdaCase, ScopedTypeVariables, TypeOperators, UndecidableInstances #-} +{-# LANGUAGE DataKinds, FlexibleContexts, FlexibleInstances, GADTs, LambdaCase, OverloadedStrings, ScopedTypeVariables, TypeApplications, TypeOperators, UndecidableInstances #-} module Semantic.Graph ( analysisParsers , AnalyzeTerm diff --git a/src/Semantic/Resolution.hs b/src/Semantic/Resolution.hs index 4b71aff3cb..3d9c17ee01 100644 --- a/src/Semantic/Resolution.hs +++ b/src/Semantic/Resolution.hs @@ -1,5 +1,4 @@ -{-# LANGUAGE ConstraintKinds, DeriveAnyClass, DerivingStrategies, GADTs, GeneralizedNewtypeDeriving, KindSignatures, - ScopedTypeVariables, TypeOperators, UndecidableInstances #-} +{-# LANGUAGE DeriveFunctor, DeriveGeneric, FlexibleContexts, FlexibleInstances, GADTs, GeneralizedNewtypeDeriving, KindSignatures, MultiParamTypeClasses, OverloadedStrings, RecordWildCards, ScopedTypeVariables, TypeOperators, UndecidableInstances #-} module Semantic.Resolution ( Resolution (..) , nodeJSResolutionMap @@ -47,14 +46,16 @@ resolutionMap Project{..} = case projectLanguage of data Resolution (m :: * -> *) k = NodeJSResolution FilePath Text [FilePath] (Map FilePath FilePath -> m k) | NoResolution (Map FilePath FilePath -> m k) - deriving stock (Functor, Generic1) - deriving anyclass (HFunctor, Effect) + deriving (Functor, Generic1) + +instance HFunctor Resolution +instance Effect Resolution runResolution :: ResolutionC m a -> m a runResolution = runResolutionC newtype ResolutionC m a = ResolutionC { runResolutionC :: m a } - deriving newtype (Applicative, Functor, Monad, MonadIO) + deriving (Applicative, Functor, Monad, MonadIO) instance (Member Files sig, Carrier sig m, MonadIO m) => Carrier (Resolution :+: sig) (ResolutionC m) where eff (R other) = ResolutionC . eff . handleCoercible $ other diff --git a/src/Semantic/Task.hs b/src/Semantic/Task.hs index 5ee650b0a9..12ac48dd11 100644 --- a/src/Semantic/Task.hs +++ b/src/Semantic/Task.hs @@ -1,5 +1,4 @@ -{-# LANGUAGE ConstraintKinds, ExistentialQuantification, GADTs, GeneralizedNewtypeDeriving, KindSignatures, - ScopedTypeVariables, TypeOperators, UndecidableInstances #-} +{-# LANGUAGE FlexibleContexts, FlexibleInstances, GADTs, GeneralizedNewtypeDeriving, KindSignatures, MultiParamTypeClasses, RecordWildCards, ScopedTypeVariables, TypeOperators, UndecidableInstances #-} module Semantic.Task ( TaskC , Level(..) diff --git a/src/Semantic/Task/Files.hs b/src/Semantic/Task/Files.hs index 092c07011b..0e6c19a521 100644 --- a/src/Semantic/Task/Files.hs +++ b/src/Semantic/Task/Files.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE ExistentialQuantification, GADTs, GeneralizedNewtypeDeriving, KindSignatures, TypeOperators, UndecidableInstances #-} +{-# LANGUAGE DataKinds, DeriveFunctor, ExistentialQuantification, FlexibleContexts, FlexibleInstances, GADTs, GeneralizedNewtypeDeriving, KindSignatures, MultiParamTypeClasses, StandaloneDeriving, TypeApplications, TypeOperators, UndecidableInstances #-} module Semantic.Task.Files ( Files diff --git a/src/Semantic/Telemetry.hs b/src/Semantic/Telemetry.hs index ee341289bf..251e1350db 100644 --- a/src/Semantic/Telemetry.hs +++ b/src/Semantic/Telemetry.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE DeriveAnyClass, DerivingStrategies, GADTs, GeneralizedNewtypeDeriving, KindSignatures, RankNTypes, TypeOperators, UndecidableInstances #-} +{-# LANGUAGE DeriveFunctor, DeriveGeneric, FlexibleContexts, FlexibleInstances, GADTs, GeneralizedNewtypeDeriving, KindSignatures, MultiParamTypeClasses, RankNTypes, RecordWildCards, TypeOperators, UndecidableInstances #-} module Semantic.Telemetry ( -- Async telemetry interface @@ -138,15 +138,17 @@ time' = withTiming' data Telemetry (m :: * -> *) k = WriteStat Stat (m k) | WriteLog Level String [(String, String)] (m k) - deriving stock (Functor, Generic1) - deriving anyclass (HFunctor, Effect) + deriving (Functor, Generic1) + +instance HFunctor Telemetry +instance Effect Telemetry -- | Run a 'Telemetry' effect by expecting a 'Reader' of 'Queue's to write stats and logs to. runTelemetry :: LogQueue -> StatQueue -> TelemetryC m a -> m a runTelemetry logger statter = runReader (logger, statter) . runTelemetryC newtype TelemetryC m a = TelemetryC { runTelemetryC :: ReaderC (LogQueue, StatQueue) m a } - deriving newtype (Applicative, Functor, Monad, MonadIO) + deriving (Applicative, Functor, Monad, MonadIO) instance (Carrier sig m, MonadIO m) => Carrier (Telemetry :+: sig) (TelemetryC m) where eff (L op) = do @@ -161,7 +163,7 @@ ignoreTelemetry :: IgnoreTelemetryC m a -> m a ignoreTelemetry = runIgnoreTelemetryC newtype IgnoreTelemetryC m a = IgnoreTelemetryC { runIgnoreTelemetryC :: m a } - deriving newtype (Applicative, Functor, Monad) + deriving (Applicative, Functor, Monad) instance Carrier sig m => Carrier (Telemetry :+: sig) (IgnoreTelemetryC m) where eff (R other) = IgnoreTelemetryC . eff . handleCoercible $ other diff --git a/src/Semantic/Telemetry/AsyncQueue.hs b/src/Semantic/Telemetry/AsyncQueue.hs index f484665cba..7292ef6536 100644 --- a/src/Semantic/Telemetry/AsyncQueue.hs +++ b/src/Semantic/Telemetry/AsyncQueue.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE RecordWildCards #-} module Semantic.Telemetry.AsyncQueue ( AsyncQueue(..) diff --git a/src/Semantic/Telemetry/Error.hs b/src/Semantic/Telemetry/Error.hs index 2b546180a9..5adc2e6e28 100644 --- a/src/Semantic/Telemetry/Error.hs +++ b/src/Semantic/Telemetry/Error.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE RecordWildCards #-} module Semantic.Telemetry.Error ( ErrorLogger , ErrorReport (..) diff --git a/src/Semantic/Telemetry/Log.hs b/src/Semantic/Telemetry/Log.hs index 2510017daa..81986dc959 100644 --- a/src/Semantic/Telemetry/Log.hs +++ b/src/Semantic/Telemetry/Log.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE RecordWildCards #-} module Semantic.Telemetry.Log ( Level (..) , LogOptions (..) diff --git a/src/Semantic/Telemetry/Stat.hs b/src/Semantic/Telemetry/Stat.hs index d969e83028..1619486469 100644 --- a/src/Semantic/Telemetry/Stat.hs +++ b/src/Semantic/Telemetry/Stat.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE FlexibleInstances, RecordWildCards #-} module Semantic.Telemetry.Stat ( -- Primary API for creating stats. diff --git a/src/Semantic/Timeout.hs b/src/Semantic/Timeout.hs index 773ccd4ed8..8b4184ae76 100644 --- a/src/Semantic/Timeout.hs +++ b/src/Semantic/Timeout.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE ExistentialQuantification, GeneralizedNewtypeDeriving, TypeOperators, RankNTypes, UndecidableInstances #-} +{-# LANGUAGE DeriveFunctor, ExistentialQuantification, FlexibleContexts, FlexibleInstances, GeneralizedNewtypeDeriving, MultiParamTypeClasses, StandaloneDeriving, TypeOperators, RankNTypes, UndecidableInstances #-} module Semantic.Timeout ( timeout , Timeout diff --git a/src/Semantic/Util.hs b/src/Semantic/Util.hs index dc1f637937..f91bbc821c 100644 --- a/src/Semantic/Util.hs +++ b/src/Semantic/Util.hs @@ -1,5 +1,5 @@ -{-# LANGUAGE PartialTypeSignatures, TypeOperators #-} -{-# OPTIONS_GHC -Wno-missing-signatures -Wno-partial-type-signatures -O0 #-} +{-# LANGUAGE DataKinds, FlexibleContexts, PartialTypeSignatures, TypeApplications, TypeOperators #-} +{-# OPTIONS_GHC -Wno-missing-signatures -Wno-missing-exported-signatures -Wno-partial-type-signatures -O0 #-} module Semantic.Util ( evaluateProject' , justEvaluating diff --git a/src/Serializing/Format.hs b/src/Serializing/Format.hs index d13a8b4e07..295be24532 100644 --- a/src/Serializing/Format.hs +++ b/src/Serializing/Format.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE GADTs #-} +{-# LANGUAGE FlexibleContexts, GADTs, OverloadedStrings #-} module Serializing.Format ( Format(..) , FormatStyle(..) diff --git a/src/Serializing/SExpression.hs b/src/Serializing/SExpression.hs index 7681fabe5a..54993f9ecd 100644 --- a/src/Serializing/SExpression.hs +++ b/src/Serializing/SExpression.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE GADTs, RankNTypes, ScopedTypeVariables #-} +{-# LANGUAGE FlexibleContexts, GADTs, OverloadedStrings, RankNTypes, ScopedTypeVariables #-} module Serializing.SExpression ( serializeSExpression , ToSExpression(..) diff --git a/src/Tags/Taggable.hs b/src/Tags/Taggable.hs index 833184583e..b3089b9773 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, ScopedTypeVariables, TypeFamilies, UndecidableInstances #-} +{-# LANGUAGE AllowAmbiguousTypes, ConstraintKinds, DataKinds, FlexibleContexts, FlexibleInstances, MultiParamTypeClasses, RecordWildCards, ScopedTypeVariables, TypeApplications, TypeFamilies, UndecidableInstances #-} module Tags.Taggable ( Tagger , Token(..) @@ -47,9 +47,9 @@ import qualified Language.TypeScript.Syntax as TypeScript -- TODO: Move to src/Data data Token - = Enter { tokenName :: Text, tokenSnippetRange :: Range } - | Exit { tokenName :: Text, tokenSnippetRange :: Range} - | Iden { identifierName :: Text, tokenLoc :: Loc, docsLiteralRange :: Maybe Range } + = Enter Text Range + | Exit Text Range + | Iden Text Loc (Maybe Range) deriving (Eq, Show) type Tagger = Stream (Of Token) diff --git a/src/Tags/Tagging.hs b/src/Tags/Tagging.hs index f9cf04f0a1..04ce85a71e 100644 --- a/src/Tags/Tagging.hs +++ b/src/Tags/Tagging.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE GADTs, LambdaCase, RankNTypes, ScopedTypeVariables, TypeOperators, UndecidableInstances #-} +{-# LANGUAGE FlexibleContexts, GADTs, LambdaCase, OverloadedStrings, RankNTypes, ScopedTypeVariables, TypeApplications, TypeOperators, UndecidableInstances #-} module Tags.Tagging ( runTagging , Tag(..) diff --git a/test/Analysis/Go/Spec.hs b/test/Analysis/Go/Spec.hs index 99c5df9de3..17342bc987 100644 --- a/test/Analysis/Go/Spec.hs +++ b/test/Analysis/Go/Spec.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE ImplicitParams #-} +{-# LANGUAGE DataKinds, ImplicitParams, OverloadedStrings, TypeApplications #-} {-# OPTIONS_GHC -O0 #-} module Analysis.Go.Spec (spec) where diff --git a/test/Analysis/PHP/Spec.hs b/test/Analysis/PHP/Spec.hs index 181b152259..1b00a34bb8 100644 --- a/test/Analysis/PHP/Spec.hs +++ b/test/Analysis/PHP/Spec.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE ImplicitParams #-} +{-# LANGUAGE DataKinds, ImplicitParams, OverloadedStrings, TypeApplications #-} {-# OPTIONS_GHC -O0 #-} module Analysis.PHP.Spec (spec) where diff --git a/test/Analysis/Python/Spec.hs b/test/Analysis/Python/Spec.hs index 536c43cc5d..a6662112af 100644 --- a/test/Analysis/Python/Spec.hs +++ b/test/Analysis/Python/Spec.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE ImplicitParams #-} +{-# LANGUAGE DataKinds, ImplicitParams, OverloadedStrings, TypeApplications #-} {-# OPTIONS_GHC -O0 #-} module Analysis.Python.Spec (spec) where diff --git a/test/Analysis/Ruby/Spec.hs b/test/Analysis/Ruby/Spec.hs index 5d6481a098..8b919f66e4 100644 --- a/test/Analysis/Ruby/Spec.hs +++ b/test/Analysis/Ruby/Spec.hs @@ -1,5 +1,5 @@ +{-# LANGUAGE DataKinds, ImplicitParams, OverloadedStrings, TypeApplications #-} {-# OPTIONS_GHC -O0 #-} -{-# LANGUAGE ImplicitParams #-} module Analysis.Ruby.Spec (spec) where import Control.Abstract (Declaration (..), ScopeError (..)) diff --git a/test/Analysis/TypeScript/Spec.hs b/test/Analysis/TypeScript/Spec.hs index 0e5fd679b0..a47b375cb0 100644 --- a/test/Analysis/TypeScript/Spec.hs +++ b/test/Analysis/TypeScript/Spec.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE ImplicitParams #-} +{-# LANGUAGE DataKinds, ImplicitParams, OverloadedStrings, TypeApplications #-} {-# OPTIONS_GHC -O0 #-} module Analysis.TypeScript.Spec (spec) where diff --git a/test/Assigning/Assignment/Spec.hs b/test/Assigning/Assignment/Spec.hs index 7cd1f3d106..195d4f8f5c 100644 --- a/test/Assigning/Assignment/Spec.hs +++ b/test/Assigning/Assignment/Spec.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE DataKinds, OverloadedLists #-} +{-# LANGUAGE OverloadedLists, OverloadedStrings #-} module Assigning.Assignment.Spec (spec) where import Assigning.Assignment diff --git a/test/Control/Abstract/Evaluator/Spec.hs b/test/Control/Abstract/Evaluator/Spec.hs index e339f3c4b6..bc56e10237 100644 --- a/test/Control/Abstract/Evaluator/Spec.hs +++ b/test/Control/Abstract/Evaluator/Spec.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE TypeOperators #-} +{-# LANGUAGE DataKinds, OverloadedStrings, TypeApplications, TypeOperators #-} {-# OPTIONS_GHC -fno-warn-missing-signatures #-} module Control.Abstract.Evaluator.Spec ( spec diff --git a/test/Data/Functor/Classes/Generic/Spec.hs b/test/Data/Functor/Classes/Generic/Spec.hs index 8afba0c42e..70834e6ffd 100644 --- a/test/Data/Functor/Classes/Generic/Spec.hs +++ b/test/Data/Functor/Classes/Generic/Spec.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE DeriveGeneric #-} module Data.Functor.Classes.Generic.Spec (spec) where import Data.Functor.Classes.Generic diff --git a/test/Data/Functor/Listable.hs b/test/Data/Functor/Listable.hs index ebc943c26b..8cb49f4dc5 100644 --- a/test/Data/Functor/Listable.hs +++ b/test/Data/Functor/Listable.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE DataKinds, ScopedTypeVariables, TypeOperators #-} +{-# LANGUAGE DataKinds, FlexibleContexts, FlexibleInstances, ScopedTypeVariables, TypeOperators #-} {-# OPTIONS_GHC -fno-warn-orphans #-} module Data.Functor.Listable ( Listable(..) diff --git a/test/Data/Mergeable.hs b/test/Data/Mergeable.hs index 64d58bc885..ec5ed39eba 100644 --- a/test/Data/Mergeable.hs +++ b/test/Data/Mergeable.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE DefaultSignatures, TypeOperators, UndecidableInstances #-} +{-# LANGUAGE DefaultSignatures, FlexibleContexts, TypeApplications, TypeOperators, UndecidableInstances #-} module Data.Mergeable ( Mergeable (..) ) where import Control.Applicative diff --git a/test/Data/Scientific/Spec.hs b/test/Data/Scientific/Spec.hs index f0f13722db..7cd86c8903 100644 --- a/test/Data/Scientific/Spec.hs +++ b/test/Data/Scientific/Spec.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE OverloadedStrings #-} module Data.Scientific.Spec (testTree) where import Data.Either diff --git a/test/Diffing/Algorithm/RWS/Spec.hs b/test/Diffing/Algorithm/RWS/Spec.hs index 0569b2998d..a1dff81dae 100644 --- a/test/Diffing/Algorithm/RWS/Spec.hs +++ b/test/Diffing/Algorithm/RWS/Spec.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE DataKinds, TypeOperators #-} +{-# LANGUAGE DataKinds, OverloadedStrings, TypeOperators #-} module Diffing.Algorithm.RWS.Spec (spec) where import Data.Bifunctor diff --git a/test/Diffing/Interpreter/Spec.hs b/test/Diffing/Interpreter/Spec.hs index 56d59145e0..652186af5f 100644 --- a/test/Diffing/Interpreter/Spec.hs +++ b/test/Diffing/Interpreter/Spec.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE DataKinds #-} +{-# LANGUAGE DataKinds, OverloadedStrings, TypeApplications #-} module Diffing.Interpreter.Spec (spec, afterTerm, beforeTerm) where import Control.Applicative ((<|>)) diff --git a/test/Examples.hs b/test/Examples.hs index 7775be6980..8488801c3a 100644 --- a/test/Examples.hs +++ b/test/Examples.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE TypeApplications #-} +{-# LANGUAGE FlexibleContexts, RecordWildCards, TypeApplications #-} {-# OPTIONS_GHC -O1 #-} module Main (main) where @@ -13,15 +13,11 @@ import Control.Monad import Control.Monad.IO.Class import Control.Monad.Trans.Resource (ResIO, runResourceT) import Data.Blob -import qualified Data.ByteString as B -import Data.ByteString.Builder -import qualified Data.ByteString.Char8 as BC import qualified Data.ByteString.Lazy.Char8 as BLC import qualified Data.ByteString.Streaming.Char8 as ByteStream import Data.Either import Data.Language (defaultLanguageModes) import Data.Set (Set) -import Data.Traversable import Data.Typeable import qualified Streaming.Prelude as Stream import System.FilePath.Glob diff --git a/test/Generators.hs b/test/Generators.hs index f71842e869..1625609602 100644 --- a/test/Generators.hs +++ b/test/Generators.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE OverloadedStrings #-} module Generators ( source , integerScientific diff --git a/test/Graphing/Calls/Spec.hs b/test/Graphing/Calls/Spec.hs index 2712a0170a..708e933fa9 100644 --- a/test/Graphing/Calls/Spec.hs +++ b/test/Graphing/Calls/Spec.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE GADTs, PackageImports #-} +{-# LANGUAGE DataKinds, GADTs, OverloadedStrings, PackageImports, TypeApplications #-} module Graphing.Calls.Spec ( spec ) where diff --git a/test/Integration/Spec.hs b/test/Integration/Spec.hs index 29c317ef16..9c95088842 100644 --- a/test/Integration/Spec.hs +++ b/test/Integration/Spec.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE ImplicitParams, LambdaCase, NamedFieldPuns #-} +{-# LANGUAGE ImplicitParams, LambdaCase #-} module Integration.Spec (testTree) where import Control.Exception (throw) @@ -28,19 +28,19 @@ testsForLanguage language = do localOption (mkTimeout 3000000) $ testGroup (Path.toString language) $ fmap testForExample items {-# NOINLINE testsForLanguage #-} -data Example = DiffExample { fileA :: Path.RelFile, fileB :: Path.RelFile, diffOutput :: Path.RelFile } - | ParseExample { file :: Path.RelFile, parseOutput :: Path.RelFile } +data Example = DiffExample Path.RelFile Path.RelFile Path.RelFile + | ParseExample Path.RelFile Path.RelFile deriving (Eq, Show) testForExample :: (?session :: TaskSession) => Example -> TestTree testForExample = \case - DiffExample{fileA, fileB, diffOutput} -> + DiffExample fileA fileB diffOutput -> goldenVsStringDiff ("diffs " <> Path.toString diffOutput) (\ref new -> ["git", "diff", ref, new]) (Path.toString diffOutput) (BL.fromStrict <$> diffFilePaths ?session fileA fileB) - ParseExample{file, parseOutput} -> + ParseExample file parseOutput -> goldenVsStringDiff ("parses " <> Path.toString parseOutput) (\ref new -> ["git", "diff", ref, new]) diff --git a/test/Rendering/TOC/Spec.hs b/test/Rendering/TOC/Spec.hs index 364786f256..f0bff8c6cc 100644 --- a/test/Rendering/TOC/Spec.hs +++ b/test/Rendering/TOC/Spec.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE DataKinds, MonoLocalBinds, TupleSections, TypeOperators #-} +{-# LANGUAGE DataKinds, FlexibleContexts, MonoLocalBinds, OverloadedStrings, TupleSections, TypeOperators #-} module Rendering.TOC.Spec (spec) where import Analysis.TOCSummary diff --git a/test/Semantic/Spec.hs b/test/Semantic/Spec.hs index c5b42d89f1..d2c0832af2 100644 --- a/test/Semantic/Spec.hs +++ b/test/Semantic/Spec.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE OverloadedStrings #-} module Semantic.Spec (spec) where import Control.Effect.Reader diff --git a/test/Semantic/Stat/Spec.hs b/test/Semantic/Stat/Spec.hs index 63d813790c..84a555fe31 100644 --- a/test/Semantic/Stat/Spec.hs +++ b/test/Semantic/Stat/Spec.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE TemplateHaskell #-} +{-# LANGUAGE OverloadedStrings, RecordWildCards #-} module Semantic.Stat.Spec (testTree) where diff --git a/test/SpecHelpers.hs b/test/SpecHelpers.hs index 2230e8fcf3..77420a8df5 100644 --- a/test/SpecHelpers.hs +++ b/test/SpecHelpers.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE DataKinds, FlexibleContexts #-} {-# OPTIONS_GHC -fno-warn-orphans #-} module SpecHelpers diff --git a/test/Tags/Spec.hs b/test/Tags/Spec.hs index 4556c78d06..48a194744e 100644 --- a/test/Tags/Spec.hs +++ b/test/Tags/Spec.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE OverloadedStrings #-} module Tags.Spec (spec) where import Control.Effect.Reader diff --git a/test/Test/Hspec/LeanCheck.hs b/test/Test/Hspec/LeanCheck.hs index 0540bc0173..f5af6ca97a 100644 --- a/test/Test/Hspec/LeanCheck.hs +++ b/test/Test/Hspec/LeanCheck.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE GADTs, TypeFamilies #-} +{-# LANGUAGE FlexibleInstances, GADTs, TypeFamilies #-} module Test.Hspec.LeanCheck ( prop , forAll @@ -8,7 +8,6 @@ import Control.Exception import Data.Bifunctor (first) import Data.List (intercalate) import Data.Maybe (listToMaybe) -import Data.Typeable import GHC.Show as Show (showsPrec) import Test.Hspec import Test.Hspec.Core.Spec as Hspec @@ -90,6 +89,6 @@ iocounterExample n = fmap listToMaybe . iocounterExamples n data LeanCheckException = LeanCheckException [String] HUnit.HUnitFailure - deriving (Show, Typeable) + deriving (Show) instance Exception LeanCheckException