{-# LANGUAGE ImportQualifiedPost #-}
{-# LANGUAGE LambdaCase, NamedFieldPuns, ScopedTypeVariables #-}

{-
    Suggest removal of unnecessary extensions
    i.e. They have {-# LANGUAGE RecursiveDo #-} but no mdo keywords
<TEST>
{-# LANGUAGE Arrows #-} \
f = id --
{-# LANGUAGE RebindableSyntax #-} \
f = id
{-# LANGUAGE RebindableSyntax, ParallelListComp, ImplicitParams #-} \
f = [(a,c) | a <- b | c <- d] -- {-# LANGUAGE RebindableSyntax, ParallelListComp #-}
{-# LANGUAGE EmptyDataDecls #-} \
data Foo
{-# LANGUAGE TemplateHaskell #-} \
$(deriveNewtypes typeInfo)
{-# LANGUAGE TemplateHaskell #-} \
main = foo ''Bar --
{-# LANGUAGE QuasiQuotes, TemplateHaskell #-} \
f x = x + [e| x + 1 |] + [foo| x + 1 |] -- {-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE PatternGuards #-} \
test = case x of _ | y <- z -> w
{-# LANGUAGE TemplateHaskell,EmptyDataDecls #-} \
$(fmap return $ dataD (return []) (mkName "Void") [] [] [])
{-# LANGUAGE RecursiveDo #-} \
main = mdo x <- y; return y
{-# LANGUAGE RecursiveDo #-} \
main = do {rec {x <- return 1}; print x}
{-# LANGUAGE ImplicitParams, BangPatterns #-} \
sort :: (?cmp :: a -> a -> Bool) => [a] -> [a] \
sort !f = undefined
{-# LANGUAGE KindSignatures #-} \
data Set (cxt :: * -> *) a = Set [a]
{-# LANGUAGE BangPatterns #-} \
foo x = let !y = x in y
{-# LANGUAGE BangPatterns #-} \
data Foo = Foo !Int --
{-# LANGUAGE TypeOperators #-} \
data (<+>) a b = Foo a b
{-# LANGUAGE TypeOperators #-} \
data Foo a b = a :+ b --
{-# LANGUAGE TypeOperators #-} \
type (<+>) a b = Foo a b
{-# LANGUAGE TypeOperators #-} \
type Foo a b = a :+ b
{-# LANGUAGE TypeOperators, TypeFamilies #-} \
type family Foo a b :: Type where Foo a b = a :+ b
{-# LANGUAGE TypeOperators, TypeFamilies #-} \
type family Foo a b :: Type where Foo a b = (<+>) a b -- {-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators, TypeFamilies #-} \
class Foo a where data (<+>) a
{-# LANGUAGE TypeOperators, TypeFamilies #-} \
class Foo a where foo :: a -> Int <+> Bool
{-# LANGUAGE TypeOperators #-} \
class (<+>) a where
{-# LANGUAGE TypeOperators #-} \
foo :: Int -> Double <+> Bool \
foo x = y
{-# LANGUAGE TypeOperators #-} \
foo :: Int -> (<+>) Double Bool \
foo x = y --
{-# LANGUAGE TypeOperators #-} \
(<+>) :: Int -> Int -> Int \
x <+> y = x + y --
{-# LANGUAGE RecordWildCards #-} \
record field = Record{..}
{-# LANGUAGE RecordWildCards #-} \
record = 1 -- @Note may require `{-# LANGUAGE DisambiguateRecordFields #-}` adding to the top of the file
{-# LANGUAGE RecordWildCards #-} \
{-# LANGUAGE DisambiguateRecordFields #-} \
record = 1 -- @NoNote
{-# LANGUAGE UnboxedTuples #-} \
record = 1 --
{-# LANGUAGE TemplateHaskell #-} \
foo
{-# LANGUAGE GeneralizedNewtypeDeriving, DeriveDataTypeable #-} \
record = 1 --
{-# LANGUAGE GeneralizedNewtypeDeriving, DeriveDataTypeable #-} \
newtype Foo = Foo Int deriving Data -- {-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE GeneralizedNewtypeDeriving, DeriveDataTypeable #-} \
data Foo = Foo Int deriving Data -- {-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE GeneralizedNewtypeDeriving, DeriveDataTypeable #-} \
newtype Foo = Foo Int deriving Class -- {-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE GeneralizedNewtypeDeriving, DeriveDataTypeable #-} \
data Foo = Foo Int deriving Class --
{-# LANGUAGE DeriveFunctor #-} \
data Foo = Foo Int deriving Functor
{-# LANGUAGE DeriveFunctor #-} \
newtype Foo = Foo Int deriving Functor
{-# LANGUAGE GeneralizedNewtypeDeriving #-} \
newtype Foo = Foo Int deriving Functor
{-# LANGUAGE GeneralizedNewtypeDeriving #-} \
newtype Foo = Foo Int deriving Data --
{-# LANGUAGE DeriveFunctor, GeneralizedNewtypeDeriving, StandaloneDeriving #-} \
deriving instance Functor Bar
{-# LANGUAGE DeriveFunctor, GeneralizedNewtypeDeriving, StandaloneDeriving #-} \
deriving instance Show Bar -- {-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE DeriveGeneric, GeneralizedNewtypeDeriving #-} \
newtype Micro = Micro Int deriving Generic -- {-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DeriveGeneric, TypeFamilies #-} \
data family Bar a; data instance Bar Foo = Foo deriving Generic
{-# LANGUAGE GeneralizedNewtypeDeriving #-} \
instance Class Int where {newtype MyIO a = MyIO a deriving NewClass}
{-# LANGUAGE UnboxedTuples #-} \
f :: Int -> (# Int, Int #)
{-# LANGUAGE UnboxedTuples #-} \
f :: x -> (x, x); f x = (x, x) --
{-# LANGUAGE UnboxedTuples #-} \
f x = case x of (# a, b #) -> a
{-# LANGUAGE GeneralizedNewtypeDeriving,UnboxedTuples #-} \
newtype T m a = T (m a) deriving (PrimMonad)
{-# LANGUAGE InstanceSigs #-} \
instance Eq a => Eq (T a) where \
  (==) :: T a -> T a -> Bool \
  (==) (T x) (T y) = x==y
{-# LANGUAGE InstanceSigs #-} \
instance Eq a => Eq (T a) where \
  (==) (T x) (T y) = x==y --
{-# LANGUAGE DefaultSignatures #-} \
class Val a where; val :: a --
{-# LANGUAGE DefaultSignatures #-} \
class Val a where; val :: a; default val :: Int
{-# LANGUAGE TypeApplications #-} \
foo = id --
{-# LANGUAGE TypeApplications #-} \
foo = id @Int
{-# LANGUAGE TypeApplications #-} \
x :: Typeable b => TypeRep @Bool b
{-# LANGUAGE LambdaCase #-} \
foo = id --
{-# LANGUAGE LambdaCase #-} \
foo = \case () -> ()
{-# LANGUAGE NumDecimals #-} \
foo = 12.3e2
{-# LANGUAGE NumDecimals #-} \
foo = id --
{-# LANGUAGE NumDecimals #-} \
foo = 12.345e2 --
{-# LANGUAGE TupleSections #-} \
main = map (,1,2) xs
{-# LANGUAGE TupleSections #-} \
main = id --
{-# LANGUAGE OverloadedStrings #-} \
main = "test"
{-# LANGUAGE OverloadedStrings #-} \
main = id --
{-# LANGUAGE OverloadedLists #-} \
main = []
{-# LANGUAGE OverloadedLists #-} \
main = [1]
{-# LANGUAGE OverloadedLists #-} \
main [1] = True
{-# LANGUAGE OverloadedLists #-} \
main = id --
{-# LANGUAGE OverloadedLabels #-} \
main = #foo
{-# LANGUAGE OverloadedLabels #-} \
main = id --
{-# LANGUAGE DeriveAnyClass #-} \
main = id --
{-# LANGUAGE DeriveAnyClass #-} \
data Foo = Foo deriving Bob
{-# LANGUAGE DeriveAnyClass #-} \
data Foo a = Foo a deriving (Eq,Data,Functor) --
{-# LANGUAGE MagicHash #-} \
foo# = id
{-# LANGUAGE MagicHash #-} \
main = "foo"#
{-# LANGUAGE MagicHash #-} \
main = 5#
{-# LANGUAGE MagicHash #-} \
main = 'a'#
{-# LANGUAGE MagicHash #-} \
main = 5.6#
{-# LANGUAGE MagicHash #-} \
foo = id --
{-# LANGUAGE GeneralizedNewtypeDeriving #-} \
newtype X = X Int deriving newtype Show
{-# LANGUAGE EmptyCase #-} \
main = case () of {}
{-# LANGUAGE EmptyCase #-} \
main = case () of x -> x --
{-# LANGUAGE EmptyCase #-} \
main = case () of x -> x --
{-# LANGUAGE PolyKinds, KindSignatures #-} -- {-# LANGUAGE PolyKinds #-}
{-# LANGUAGE PolyKinds, KindSignatures #-} \
data Set (cxt :: * -> *) a = Set [a] -- @Note Extension KindSignatures is implied by PolyKinds
{-# LANGUAGE QuasiQuotes, OverloadedStrings #-} \
main = putStrLn [f|{T.intercalate "blah" []}|]
{-# LANGUAGE NamedFieldPuns #-} \
foo = x{bar}
{-# LANGUAGE PatternSynonyms #-} \
module Foo (pattern Bar) where x = 42
{-# LANGUAGE PatternSynonyms #-} \
import Foo (pattern Bar); x = 42
{-# LANGUAGE PatternSynonyms #-} \
pattern Foo s <- Bar s _ where Foo s = Bar s s
{-# LANGUAGE PatternSynonyms #-} \
x = 42 --
{-# LANGUAGE MultiWayIf #-} \
x = if | b1 -> v1 | b2 -> v2 | otherwise -> v3
{-# LANGUAGE MultiWayIf #-} \
x = if b1 then v1 else if b2 then v2 else v3 --
static = 42
{-# LANGUAGE NamedFieldPuns #-} \
foo Foo{x} = x
{-# LANGUAGE NamedFieldPuns #-} \
foo = Foo{x}
{-# LANGUAGE NamedFieldPuns #-} \
foo = bar{x}
{-# LANGUAGE NamedFieldPuns #-} --
{-# LANGUAGE NumericUnderscores #-} \
lessThanPi = (< 3.141_592_653_589_793)
{-# LANGUAGE NumericUnderscores #-} \
oneMillion = 0xf4__240
{-# LANGUAGE NumericUnderscores #-} \
avogadro = 6.022140857e+23 --
{-# LANGUAGE StaticPointers #-} \
static = 42 --
{-# LANGUAGE Trustworthy #-}
{-# LANGUAGE Trustworthy, NamedFieldPuns #-} -- {-# LANGUAGE Trustworthy #-}
{-# LANGUAGE Haskell2010 #-}
{-# LANGUAGE NoStarIsType, ExplicitNamespaces #-} \
import GHC.TypeLits(KnownNat, type (+), type (*))
{-# LANGUAGE LambdaCase, MultiWayIf, NoRebindableSyntax #-} \
foo = \case True -> 3 -- {-# LANGUAGE LambdaCase, NoRebindableSyntax #-}
{-# LANGUAGE ImportQualifiedPost #-} \
import Control.Monad qualified as CM
{-# LANGUAGE ImportQualifiedPost #-} \
import qualified Control.Monad as CM hiding (mapM) \
import Data.Foldable -- @NoRefactor: refactor only works when using GHC 8.10
{-# LANGUAGE StandaloneKindSignatures #-} \
type T :: (k -> Type) -> k -> Type \
data T m a = MkT (m a) (T Maybe (m a))
{-# LANGUAGE NoMonomorphismRestriction, NamedFieldPuns #-} \
main = 1 -- @Note Extension NamedFieldPuns is not used
{-# LANGUAGE FunctionalDependencies #-} \
class HasField x r a | x r -> a
{-# LANGUAGE OverloadedRecordDot #-} \
f x = x.foo
{-# LANGUAGE OverloadedRecordDot #-} \
f x = x . foo -- @NoRefactor: refactor requires GHC >= 9.2.1
{-# LANGUAGE OverloadedRecordDot #-} \
f = (.foo)
{-# LANGUAGE OverloadedRecordDot #-} \
f = (. foo) -- @NoRefactor: refactor requires GHC >= 9.2.1
{-# LANGUAGE TemplateHaskellQuotes #-} \
foo = [|| x ||]
{-# LANGUAGE TemplateHaskell #-} \
foo = $bar
{-# LANGUAGE TypeData # -} \
type data Nat = Zero | Succ Nat  -- @NoRefactor: refactor requires GHC >= 9.6.1
{-# LANGUAGE TypeData #-} \
data T = MkT -- @NoRefactor: refactor requires GHC >= 9.6.1
</TEST>
-}



module Hint.Extensions(extensionsHint) where

import Hint.Type(ModuHint,rawIdea,Severity(Warning),Note(..),toSSAnc,ghcModule,modComments,firstDeclComments)
import Extension

import Data.Generics.Uniplate.DataOnly
import Control.Monad.Extra
import Data.Maybe
import Data.List.Extra
import Data.Data
import Refact.Types
import Data.Set qualified as Set
import Data.Map qualified as Map

import GHC.Types.SrcLoc
import GHC.Types.SourceText
import GHC.Hs
import GHC.Types.Basic
import GHC.Types.Name.Reader
import GHC.Types.ForeignCall
import GHC.Data.Strict qualified
import GHC.Types.PkgQual

import GHC.Util
import GHC.LanguageExtensions.Type

import Language.Haskell.GhclibParserEx.GHC.Hs.Pat
import Language.Haskell.GhclibParserEx.GHC.Hs.Expr
import Language.Haskell.GhclibParserEx.GHC.Hs.Type
import Language.Haskell.GhclibParserEx.GHC.Hs.Decls
import Language.Haskell.GhclibParserEx.GHC.Hs.Binds
import Language.Haskell.GhclibParserEx.GHC.Hs.ImpExp
import Language.Haskell.GhclibParserEx.GHC.Driver.Session
import Language.Haskell.GhclibParserEx.GHC.Utils.Outputable
import Language.Haskell.GhclibParserEx.GHC.Types.Name.Reader

extensionsHint :: ModuHint
extensionsHint :: ModuHint
extensionsHint Scope
_ ModuleEx
x =
    [
        Severity
-> String
-> SrcSpan
-> String
-> Maybe String
-> [Note]
-> [Refactoring SrcSpan]
-> Idea
rawIdea Severity
Hint.Type.Warning String
"Unused LANGUAGE pragma"
        (RealSrcSpan -> Maybe BufSpan -> SrcSpan
RealSrcSpan (Anchor -> RealSrcSpan
anchor Anchor
sl) forall a. Maybe a
GHC.Data.Strict.Nothing)
        (LEpaComment -> String
comment_ (Anchor -> [String] -> LEpaComment
mkLanguagePragmas Anchor
sl [String]
exts))
        (forall a. a -> Maybe a
Just String
newPragma)
        ( [String -> Note
RequiresExtension (forall a. Show a => a -> String
show Extension
gone) | (String
_, Just Extension
x) <- [(String, Maybe Extension)]
before forall a. Eq a => [a] -> [a] -> [a]
\\ [(String, Maybe Extension)]
after, Extension
gone <- forall k a. Ord k => a -> k -> Map k a -> a
Map.findWithDefault [] Extension
x Map Extension [Extension]
disappear] forall a. [a] -> [a] -> [a]
++
            [ String -> Note
Note forall a b. (a -> b) -> a -> b
$ String
"Extension " forall a. [a] -> [a] -> [a]
++ String
s forall a. [a] -> [a] -> [a]
++ String
" is " forall a. [a] -> [a] -> [a]
++ Extension -> String
reason Extension
x
            | (String
s, Just Extension
x) <- [(String, Maybe Extension)]
explainedRemovals])
        [forall a. a -> String -> Refactoring a
ModifyComment (forall e. GenLocated Anchor e -> SrcSpan
toSSAnc (Anchor -> [String] -> LEpaComment
mkLanguagePragmas Anchor
sl [String]
exts)) String
newPragma]
    | (L Anchor
sl EpaComment
_,  [String]
exts) <-
      -- Comments appearing without an empty line before the first
      -- declaration in a module are now associated with the
      -- declaration not the module so to be safe, look also at
      -- `firstDeclComments x`
      -- (https://gitlab.haskell.org/ghc/ghc/-/merge_requests/9517).
      [(LEpaComment, String)] -> [(LEpaComment, [String])]
languagePragmas forall a b. (a -> b) -> a -> b
$ EpAnnComments -> [(LEpaComment, String)]
pragmas (ModuleEx -> EpAnnComments
modComments ModuleEx
x) forall a. [a] -> [a] -> [a]
++ EpAnnComments -> [(LEpaComment, String)]
pragmas (ModuleEx -> EpAnnComments
firstDeclComments ModuleEx
x)
    , let before :: [(String, Maybe Extension)]
before = [(String
x, String -> Maybe Extension
readExtension String
x) | String
x <- [String]
exts]
    , let after :: [(String, Maybe Extension)]
after = forall a. (a -> Bool) -> [a] -> [a]
filter (forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
True (forall a. Ord a => a -> Set a -> Bool
`Set.member` Set Extension
keep) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd) [(String, Maybe Extension)]
before
    , [(String, Maybe Extension)]
before forall a. Eq a => a -> a -> Bool
/= [(String, Maybe Extension)]
after
    , let explainedRemovals :: [(String, Maybe Extension)]
explainedRemovals
            | forall (t :: * -> *) a. Foldable t => t a -> Bool
null [(String, Maybe Extension)]
after Bool -> Bool -> Bool
&& Bool -> Bool
not (forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (forall k a. Ord k => k -> Map k a -> Bool
`Map.member` Map Extension Extension
implied) forall a b. (a -> b) -> a -> b
$ forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe forall a b. (a, b) -> b
snd [(String, Maybe Extension)]
before) = []
            | Bool
otherwise = [(String, Maybe Extension)]
before forall a. Eq a => [a] -> [a] -> [a]
\\ [(String, Maybe Extension)]
after
    , let newPragma :: String
newPragma =
            if forall (t :: * -> *) a. Foldable t => t a -> Bool
null [(String, Maybe Extension)]
after then String
"" else LEpaComment -> String
comment_ (Anchor -> [String] -> LEpaComment
mkLanguagePragmas Anchor
sl forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> a
fst [(String, Maybe Extension)]
after)
    ]
  where
    usedTH :: Bool
    usedTH :: Bool
usedTH = Extension -> Located (HsModule GhcPs) -> Bool
used Extension
TemplateHaskell (ModuleEx -> Located (HsModule GhcPs)
ghcModule ModuleEx
x)
               Bool -> Bool -> Bool
|| Extension -> Located (HsModule GhcPs) -> Bool
used Extension
TemplateHaskellQuotes (ModuleEx -> Located (HsModule GhcPs)
ghcModule ModuleEx
x)
               Bool -> Bool -> Bool
|| Extension -> Located (HsModule GhcPs) -> Bool
used Extension
QuasiQuotes (ModuleEx -> Located (HsModule GhcPs)
ghcModule ModuleEx
x)
      -- If TH or QuasiQuotes is on, can use all other extensions
      -- programmatically.

    -- All the extensions defined to be used.
    extensions :: Set.Set Extension
    extensions :: Set Extension
extensions = forall a. Ord a => [a] -> Set a
Set.fromList forall a b. (a -> b) -> a -> b
$
      forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap
      (forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe String -> Maybe Extension
readExtension forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd)
      ([(LEpaComment, String)] -> [(LEpaComment, [String])]
languagePragmas
        (EpAnnComments -> [(LEpaComment, String)]
pragmas (ModuleEx -> EpAnnComments
modComments ModuleEx
x) forall a. [a] -> [a] -> [a]
++ EpAnnComments -> [(LEpaComment, String)]
pragmas (ModuleEx -> EpAnnComments
firstDeclComments ModuleEx
x)))
      -- Comments appearing without an empty line before the first
      -- declaration in a module are now associated with the
      -- declaration not the module so to be safe, look also at
      -- `firstDeclComments x`
      -- (https://gitlab.haskell.org/ghc/ghc/-/merge_requests/9517).

    -- Those extensions we detect to be useful.
    useful :: Set.Set Extension
    useful :: Set Extension
useful =
      if Bool
usedTH
        then forall a. (a -> Bool) -> Set a -> Set a
Set.filter (\case Extension
TemplateHaskell -> Extension -> Located (HsModule GhcPs) -> Bool
usedExt Extension
TemplateHaskell (ModuleEx -> Located (HsModule GhcPs)
ghcModule ModuleEx
x); Extension
_ -> Bool
True) Set Extension
extensions
        else forall a. (a -> Bool) -> Set a -> Set a
Set.filter (Extension -> Located (HsModule GhcPs) -> Bool
`usedExt` ModuleEx -> Located (HsModule GhcPs)
ghcModule ModuleEx
x) Set Extension
extensions
    -- Those extensions which are useful, but implied by other useful
    -- extensions.
    implied :: Map.Map Extension Extension
    implied :: Map Extension Extension
implied = forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList
        [ (Extension
e, Extension
a)
        | Extension
e <- forall a. Set a -> [a]
Set.toList Set Extension
useful
        , Extension
a:[Extension]
_ <- [forall a. (a -> Bool) -> [a] -> [a]
filter (forall a. Ord a => a -> Set a -> Bool
`Set.member` Set Extension
useful) forall a b. (a -> b) -> a -> b
$ Extension -> [Extension]
extensionImpliedEnabledBy Extension
e]
        ]
    -- Those we should keep.
    keep :: Set.Set Extension
    keep :: Set Extension
keep =  Set Extension
useful forall a. Ord a => Set a -> Set a -> Set a
`Set.difference` forall k a. Map k a -> Set k
Map.keysSet Map Extension Extension
implied
    -- The meaning of (a,b) is a used to imply b, but has gone, so
    -- suggest enabling b.
    disappear :: Map.Map Extension [Extension]
    disappear :: Map Extension [Extension]
disappear =
        forall k a. Ord k => (a -> a -> a) -> [(k, a)] -> Map k a
Map.fromListWith forall a. [a] -> [a] -> [a]
(++) forall a b. (a -> b) -> a -> b
$
        forall b a. Ord b => (a -> b) -> [a] -> [a]
nubOrdOn forall a b. (a, b) -> b
snd -- Only keep one instance for each of a.
        [ (Extension
e, [Extension
a])
        | Extension
e <- forall a. Set a -> [a]
Set.toList forall a b. (a -> b) -> a -> b
$ Set Extension
extensions forall a. Ord a => Set a -> Set a -> Set a
`Set.difference` Set Extension
keep
        , Extension
a <- forall a b. (a, b) -> a
fst forall a b. (a -> b) -> a -> b
$ Extension -> ([Extension], [Extension])
extensionImplies Extension
e
        , Extension
a forall a. Ord a => a -> Set a -> Bool
`Set.notMember` Set Extension
useful
        , Bool
usedTH Bool -> Bool -> Bool
|| Extension -> Located (HsModule GhcPs) -> Bool
usedExt Extension
a (ModuleEx -> Located (HsModule GhcPs)
ghcModule ModuleEx
x)
        ]
    reason :: Extension -> String
    reason :: Extension -> String
reason Extension
x =
      case forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Extension
x Map Extension Extension
implied of
        Just Extension
a -> String
"implied by " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Extension
a
        Maybe Extension
Nothing -> String
"not used"

deriveHaskell :: [String]
deriveHaskell = [String
"Eq",String
"Ord",String
"Enum",String
"Ix",String
"Bounded",String
"Read",String
"Show"]
deriveGenerics :: [String]
deriveGenerics = [String
"Data",String
"Typeable",String
"Generic",String
"Generic1",String
"Lift"]
deriveCategory :: [String]
deriveCategory = [String
"Functor",String
"Foldable",String
"Traversable"]

-- | Classes that can't require newtype deriving
noDeriveNewtype :: [String]
noDeriveNewtype =
    forall a. Eq a => a -> [a] -> [a]
delete String
"Enum" [String]
deriveHaskell forall a. [a] -> [a] -> [a]
++ -- Enum can't always be derived on a newtype
    [String]
deriveGenerics -- Generics stuff can't newtype derive since it has the ctor in it

-- | Classes that can appear as stock, and can't appear as anyclass
deriveStock :: [String]
deriveStock :: [String]
deriveStock = [String]
deriveHaskell forall a. [a] -> [a] -> [a]
++ [String]
deriveGenerics forall a. [a] -> [a] -> [a]
++ [String]
deriveCategory

usedExt :: Extension -> Located (HsModule GhcPs) -> Bool
usedExt :: Extension -> Located (HsModule GhcPs) -> Bool
usedExt Extension
NumDecimals = forall x a. (Data x, Data a) => (a -> Bool) -> x -> Bool
hasS HsExpr GhcPs -> Bool
isWholeFrac
  -- Only whole number fractions are permitted by NumDecimals
  -- extension.  Anything not-whole raises an error.
usedExt Extension
DeriveLift = [String] -> Located (HsModule GhcPs) -> Bool
hasDerive [String
"Lift"]
usedExt Extension
DeriveAnyClass = Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a. Foldable t => t a -> Bool
null forall b c a. (b -> c) -> (a -> b) -> a -> c
. Derives -> [String]
derivesAnyclass forall b c a. (b -> c) -> (a -> b) -> a -> c
. Located (HsModule GhcPs) -> Derives
derives
usedExt Extension
x = Extension -> Located (HsModule GhcPs) -> Bool
used Extension
x

used :: Extension -> Located (HsModule GhcPs) -> Bool

used :: Extension -> Located (HsModule GhcPs) -> Bool
used Extension
RecursiveDo = forall x a. (Data x, Data a) => (a -> Bool) -> x -> Bool
hasS HsDoFlavour -> Bool
isMDo forall (m :: * -> *). Monad m => m Bool -> m Bool -> m Bool
||^ forall x a. (Data x, Data a) => (a -> Bool) -> x -> Bool
hasS StmtLR GhcPs GhcPs (LHsExpr GhcPs) -> Bool
isRecStmt
used Extension
ParallelListComp = forall x a. (Data x, Data a) => (a -> Bool) -> x -> Bool
hasS StmtLR GhcPs GhcPs (LHsExpr GhcPs) -> Bool
isParComp
used Extension
FunctionalDependencies = forall {from} {a}. (Data from, Data a) => a -> from -> Bool
hasT (forall {a}. a
un :: FunDep GhcPs)
used Extension
ImplicitParams = forall {from} {a}. (Data from, Data a) => a -> from -> Bool
hasT (forall {a}. a
un :: HsIPName)

used Extension
TypeApplications = forall x a. (Data x, Data a) => (a -> Bool) -> x -> Bool
hasS LHsExpr GhcPs -> Bool
isTypeApp forall (m :: * -> *). Monad m => m Bool -> m Bool -> m Bool
||^ forall x a. (Data x, Data a) => (a -> Bool) -> x -> Bool
hasS LHsType GhcPs -> Bool
isKindTyApp

used Extension
EmptyDataDecls = forall x a. (Data x, Data a) => (a -> Bool) -> x -> Bool
hasS HsDataDefn GhcPs -> Bool
f
  where
    f :: HsDataDefn GhcPs -> Bool
    f :: HsDataDefn GhcPs -> Bool
f (HsDataDefn XCHsDataDefn GhcPs
_ Maybe (LHsContext GhcPs)
_ Maybe (XRec GhcPs CType)
_ Maybe (LHsType GhcPs)
_ (DataTypeCons Bool
_ []) HsDeriving GhcPs
_) = Bool
True
    f HsDataDefn GhcPs
_ = Bool
False
used Extension
TypeData  = forall x a. (Data x, Data a) => (a -> Bool) -> x -> Bool
hasS HsDataDefn GhcPs -> Bool
f
  where
    f :: HsDataDefn GhcPs -> Bool
    f :: HsDataDefn GhcPs -> Bool
f (HsDataDefn XCHsDataDefn GhcPs
_ Maybe (LHsContext GhcPs)
_ Maybe (XRec GhcPs CType)
_ Maybe (LHsType GhcPs)
_ (DataTypeCons Bool
True [LConDecl GhcPs]
_) HsDeriving GhcPs
_) = Bool
True
    f HsDataDefn GhcPs
_ = Bool
False
used Extension
EmptyCase = forall x a. (Data x, Data a) => (a -> Bool) -> x -> Bool
hasS HsExpr GhcPs -> Bool
f
  where
    f :: HsExpr GhcPs -> Bool
    f :: HsExpr GhcPs -> Bool
f (HsCase XCase GhcPs
_ LHsExpr GhcPs
_ (MG XMG GhcPs (LHsExpr GhcPs)
_ (L SrcSpanAnnL
_ []))) = Bool
True
    f (HsLamCase XLamCase GhcPs
_ LamCaseVariant
_ (MG XMG GhcPs (LHsExpr GhcPs)
_ (L SrcSpanAnnL
_ []))) = Bool
True
    f HsExpr GhcPs
_ = Bool
False
used Extension
KindSignatures = forall {from} {a}. (Data from, Data a) => a -> from -> Bool
hasT (forall {a}. a
un :: HsKind GhcPs)
used Extension
BangPatterns = forall x a. (Data x, Data a) => (a -> Bool) -> x -> Bool
hasS LPat GhcPs -> Bool
isPBangPat forall (m :: * -> *). Monad m => m Bool -> m Bool -> m Bool
||^ forall x a. (Data x, Data a) => (a -> Bool) -> x -> Bool
hasS HsMatchContext GhcPs -> Bool
isStrictMatch
used Extension
TemplateHaskell = forall x a. (Data x, Data a) => (a -> Bool) -> x -> Bool
hasS forall a b. (a -> b) -> a -> b
$ Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. HsUntypedSplice GhcPs -> Bool
isQuasiQuoteSplice
used Extension
TemplateHaskellQuotes = forall x a. (Data x, Data a) => (a -> Bool) -> x -> Bool
hasS HsExpr GhcPs -> Bool
f
  where
    f :: HsExpr GhcPs -> Bool
    f :: HsExpr GhcPs -> Bool
f HsTypedBracket{} = Bool
True
    f HsUntypedBracket{} = Bool
True
    f HsExpr GhcPs
_ = Bool
False
used Extension
ForeignFunctionInterface = forall {from} {a}. (Data from, Data a) => a -> from -> Bool
hasT (forall {a}. a
un :: CCallConv)
used Extension
PatternGuards = forall x a. (Data x, Data a) => (a -> Bool) -> x -> Bool
hasS GRHS GhcPs (LHsExpr GhcPs) -> Bool
f
  where
    f :: GRHS GhcPs (LHsExpr GhcPs) -> Bool
    f :: GRHS GhcPs (LHsExpr GhcPs) -> Bool
f (GRHS XCGRHS GhcPs (LHsExpr GhcPs)
_ [GuardLStmt GhcPs]
xs LHsExpr GhcPs
_) = [GuardLStmt GhcPs] -> Bool
g [GuardLStmt GhcPs]
xs
    g :: [GuardLStmt GhcPs] -> Bool
    g :: [GuardLStmt GhcPs] -> Bool
g [] = Bool
False
    g [L SrcSpanAnnA
_ BodyStmt{}] = Bool
False
    g [GuardLStmt GhcPs]
_ = Bool
True
used Extension
StandaloneDeriving = forall x a. (Data x, Data a) => (a -> Bool) -> x -> Bool
hasS LHsDecl GhcPs -> Bool
isDerivD
used Extension
TypeOperators = forall x a. (Data x, Data a) => (a -> Bool) -> x -> Bool
hasS HsType GhcPs -> Bool
tyOpInSig forall (m :: * -> *). Monad m => m Bool -> m Bool -> m Bool
||^ forall x a. (Data x, Data a) => (a -> Bool) -> x -> Bool
hasS HsDecl GhcPs -> Bool
tyOpInDecl
  where
    tyOpInSig :: HsType GhcPs -> Bool
    tyOpInSig :: HsType GhcPs -> Bool
tyOpInSig = \case
      HsOpTy{} -> Bool
True; HsType GhcPs
_ -> Bool
False

    tyOpInDecl :: HsDecl GhcPs -> Bool
    tyOpInDecl :: HsDecl GhcPs -> Bool
tyOpInDecl = \case
      (TyClD XTyClD GhcPs
_ (FamDecl XFamDecl GhcPs
_ FamilyDecl{LIdP GhcPs
fdLName :: forall pass. FamilyDecl pass -> LIdP pass
fdLName :: LIdP GhcPs
fdLName})) -> forall {l}. GenLocated l RdrName -> Bool
isOp LIdP GhcPs
fdLName
      (TyClD XTyClD GhcPs
_ SynDecl{LIdP GhcPs
tcdLName :: forall pass. TyClDecl pass -> LIdP pass
tcdLName :: LIdP GhcPs
tcdLName}) -> forall {l}. GenLocated l RdrName -> Bool
isOp LIdP GhcPs
tcdLName
      (TyClD XTyClD GhcPs
_ DataDecl{LIdP GhcPs
tcdLName :: LIdP GhcPs
tcdLName :: forall pass. TyClDecl pass -> LIdP pass
tcdLName}) -> forall {l}. GenLocated l RdrName -> Bool
isOp LIdP GhcPs
tcdLName
      (TyClD XTyClD GhcPs
_ ClassDecl{LIdP GhcPs
tcdLName :: LIdP GhcPs
tcdLName :: forall pass. TyClDecl pass -> LIdP pass
tcdLName, [LFamilyDecl GhcPs]
tcdATs :: forall pass. TyClDecl pass -> [LFamilyDecl pass]
tcdATs :: [LFamilyDecl GhcPs]
tcdATs}) -> forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any forall {l}. GenLocated l RdrName -> Bool
isOp (LIdP GhcPs
tcdLName forall a. a -> [a] -> [a]
: [forall pass. FamilyDecl pass -> LIdP pass
fdLName FamilyDecl GhcPs
famDecl | L SrcSpanAnnA
_ FamilyDecl GhcPs
famDecl <- [LFamilyDecl GhcPs]
tcdATs])
      HsDecl GhcPs
_ -> Bool
False

    isOp :: GenLocated l RdrName -> Bool
isOp (L l
_ RdrName
name) = RdrName -> Bool
isSymbolRdrName RdrName
name

used Extension
RecordWildCards = forall x a. (Data x, Data a) => (a -> Bool) -> x -> Bool
hasS HsRecFields GhcPs (LHsExpr GhcPs) -> Bool
hasFieldsDotDot forall (m :: * -> *). Monad m => m Bool -> m Bool -> m Bool
||^ forall x a. (Data x, Data a) => (a -> Bool) -> x -> Bool
hasS HsRecFields GhcPs (LPat GhcPs) -> Bool
hasPFieldsDotDot
used Extension
NamedFieldPuns = forall x a. (Data x, Data a) => (a -> Bool) -> x -> Bool
hasS LHsFieldBind GhcPs (LFieldOcc GhcPs) (LPat GhcPs) -> Bool
isPFieldPun forall (m :: * -> *). Monad m => m Bool -> m Bool -> m Bool
||^ forall x a. (Data x, Data a) => (a -> Bool) -> x -> Bool
hasS LHsFieldBind GhcPs (LFieldOcc GhcPs) (LHsExpr GhcPs) -> Bool
isFieldPun forall (m :: * -> *). Monad m => m Bool -> m Bool -> m Bool
||^ forall x a. (Data x, Data a) => (a -> Bool) -> x -> Bool
hasS HsFieldBind (LAmbiguousFieldOcc GhcPs) (LHsExpr GhcPs) -> Bool
isFieldPunUpdate
used Extension
UnboxedTuples = forall x a. (Data x, Data a) => (a -> Bool) -> x -> Bool
hasS HsTupleSort -> Bool
isUnboxedTuple forall (m :: * -> *). Monad m => m Bool -> m Bool -> m Bool
||^ forall x a. (Data x, Data a) => (a -> Bool) -> x -> Bool
hasS (forall a. Eq a => a -> a -> Bool
== Boxity
Unboxed) forall (m :: * -> *). Monad m => m Bool -> m Bool -> m Bool
||^ forall x a. (Data x, Data a) => (a -> Bool) -> x -> Bool
hasS Maybe (LDerivStrategy GhcPs) -> Bool
isDeriving
  where
      -- detect if there are deriving declarations or data ... deriving stuff
      -- by looking for the deriving strategy both contain (even if its Nothing)
      -- see https://github.com/ndmitchell/hlint/issues/833 for why we care
      isDeriving :: Maybe (LDerivStrategy GhcPs) -> Bool
      isDeriving :: Maybe (LDerivStrategy GhcPs) -> Bool
isDeriving Maybe (LDerivStrategy GhcPs)
_ = Bool
True
used Extension
PackageImports = forall x a. (Data x, Data a) => (a -> Bool) -> x -> Bool
hasS ImportDecl GhcPs -> Bool
f
  where
      f :: ImportDecl GhcPs -> Bool
      f :: ImportDecl GhcPs -> Bool
f ImportDecl{ideclPkgQual :: forall pass. ImportDecl pass -> ImportDeclPkgQual pass
ideclPkgQual=RawPkgQual StringLiteral
_} = Bool
True
      f ImportDecl GhcPs
_ = Bool
False
used Extension
QuasiQuotes = forall x a. (Data x, Data a) => (a -> Bool) -> x -> Bool
hasS LHsExpr GhcPs -> Bool
isQuasiQuoteExpr forall (m :: * -> *). Monad m => m Bool -> m Bool -> m Bool
||^ forall x a. (Data x, Data a) => (a -> Bool) -> x -> Bool
hasS LHsType GhcPs -> Bool
isTyQuasiQuote
used Extension
ViewPatterns = forall x a. (Data x, Data a) => (a -> Bool) -> x -> Bool
hasS LPat GhcPs -> Bool
isPViewPat
used Extension
InstanceSigs = forall x a. (Data x, Data a) => (a -> Bool) -> x -> Bool
hasS HsDecl GhcPs -> Bool
f
  where
    f :: HsDecl GhcPs -> Bool
    f :: HsDecl GhcPs -> Bool
f (InstD XInstD GhcPs
_ InstDecl GhcPs
decl) = forall {from} {a}. (Data from, Data a) => a -> from -> Bool
hasT (forall {a}. a
un :: Sig GhcPs) InstDecl GhcPs
decl
    f HsDecl GhcPs
_ = Bool
False
used Extension
DefaultSignatures = forall x a. (Data x, Data a) => (a -> Bool) -> x -> Bool
hasS Sig GhcPs -> Bool
isClsDefSig
used Extension
DeriveDataTypeable = [String] -> Located (HsModule GhcPs) -> Bool
hasDerive [String
"Data",String
"Typeable"]
used Extension
DeriveFunctor = [String] -> Located (HsModule GhcPs) -> Bool
hasDerive [String
"Functor"]
used Extension
DeriveFoldable = [String] -> Located (HsModule GhcPs) -> Bool
hasDerive [String
"Foldable"]
used Extension
DeriveTraversable = [String] -> Located (HsModule GhcPs) -> Bool
hasDerive [String
"Traversable",String
"Foldable",String
"Functor"]
used Extension
DeriveGeneric = [String] -> Located (HsModule GhcPs) -> Bool
hasDerive [String
"Generic",String
"Generic1"]
used Extension
GeneralizedNewtypeDeriving = Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a. Foldable t => t a -> Bool
null forall b c a. (b -> c) -> (a -> b) -> a -> c
. Derives -> [String]
derivesNewtype' forall b c a. (b -> c) -> (a -> b) -> a -> c
. Located (HsModule GhcPs) -> Derives
derives
used Extension
MultiWayIf = forall x a. (Data x, Data a) => (a -> Bool) -> x -> Bool
hasS HsExpr GhcPs -> Bool
isMultiIf
used Extension
NumericUnderscores = forall x a. (Data x, Data a) => (a -> Bool) -> x -> Bool
hasS OverLitVal -> Bool
f
  where
    f :: OverLitVal -> Bool
    f :: OverLitVal -> Bool
f (HsIntegral (IL (SourceText String
t) Bool
_ Integer
_)) = Char
'_' forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` String
t
    f (HsFractional (FL (SourceText String
t) Bool
_ Rational
_ Integer
_ FractionalExponentBase
_)) = Char
'_' forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` String
t
    f OverLitVal
_ = Bool
False

used Extension
LambdaCase = forall x a. (Data x, Data a) => (a -> Bool) -> x -> Bool
hasS LHsExpr GhcPs -> Bool
isLCase
used Extension
TupleSections = forall x a. (Data x, Data a) => (a -> Bool) -> x -> Bool
hasS HsTupArg GhcPs -> Bool
isTupleSection
used Extension
OverloadedStrings = forall x a. (Data x, Data a) => (a -> Bool) -> x -> Bool
hasS HsLit GhcPs -> Bool
isString
used Extension
OverloadedLists = forall x a. (Data x, Data a) => (a -> Bool) -> x -> Bool
hasS HsExpr GhcPs -> Bool
isListExpr forall (m :: * -> *). Monad m => m Bool -> m Bool -> m Bool
||^ forall x a. (Data x, Data a) => (a -> Bool) -> x -> Bool
hasS Pat GhcPs -> Bool
isListPat
  where
    isListExpr :: HsExpr GhcPs -> Bool
    isListExpr :: HsExpr GhcPs -> Bool
isListExpr (HsVar XVar GhcPs
_ LIdP GhcPs
n) = LocatedN RdrName -> String
rdrNameStr LIdP GhcPs
n forall a. Eq a => a -> a -> Bool
== String
"[]"
    isListExpr ExplicitList{} = Bool
True
    isListExpr ArithSeq{} = Bool
True
    isListExpr HsExpr GhcPs
_ = Bool
False

    isListPat :: Pat GhcPs -> Bool
    isListPat :: Pat GhcPs -> Bool
isListPat ListPat{} = Bool
True
    isListPat Pat GhcPs
_ = Bool
False

used Extension
OverloadedLabels = forall x a. (Data x, Data a) => (a -> Bool) -> x -> Bool
hasS LHsExpr GhcPs -> Bool
isOverLabel

used Extension
Arrows = forall x a. (Data x, Data a) => (a -> Bool) -> x -> Bool
hasS HsExpr GhcPs -> Bool
isProc
used Extension
TransformListComp = forall x a. (Data x, Data a) => (a -> Bool) -> x -> Bool
hasS StmtLR GhcPs GhcPs (LHsExpr GhcPs) -> Bool
isTransStmt
used Extension
MagicHash = forall x a. (Data x, Data a) => (a -> Bool) -> x -> Bool
hasS RdrName -> Bool
f forall (m :: * -> *). Monad m => m Bool -> m Bool -> m Bool
||^ forall x a. (Data x, Data a) => (a -> Bool) -> x -> Bool
hasS HsLit GhcPs -> Bool
isPrimLiteral
  where
    f :: RdrName -> Bool
    f :: RdrName -> Bool
f RdrName
s = String
"#" forall a. Eq a => [a] -> [a] -> Bool
`isSuffixOf` RdrName -> String
occNameStr RdrName
s
used Extension
PatternSynonyms = forall x a. (Data x, Data a) => (a -> Bool) -> x -> Bool
hasS HsBind GhcPs -> Bool
isPatSynBind forall (m :: * -> *). Monad m => m Bool -> m Bool -> m Bool
||^ forall x a. (Data x, Data a) => (a -> Bool) -> x -> Bool
hasS IEWrappedName GhcPs -> Bool
isPatSynIE
used Extension
ImportQualifiedPost = forall x a. (Data x, Data a) => (a -> Bool) -> x -> Bool
hasS (forall a. Eq a => a -> a -> Bool
== ImportDeclQualifiedStyle
QualifiedPost)
used Extension
StandaloneKindSignatures = forall {from} {a}. (Data from, Data a) => a -> from -> Bool
hasT (forall {a}. a
un :: StandaloneKindSig GhcPs)
used Extension
OverloadedRecordDot = forall {from} {a}. (Data from, Data a) => a -> from -> Bool
hasT (forall {a}. a
un :: DotFieldOcc GhcPs)

used Extension
_= forall a b. a -> b -> a
const Bool
True

hasDerive :: [String] -> Located (HsModule GhcPs) -> Bool
hasDerive :: [String] -> Located (HsModule GhcPs) -> Bool
hasDerive [String]
want = forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [String]
want) forall b c a. (b -> c) -> (a -> b) -> a -> c
. Derives -> [String]
derivesStock' forall b c a. (b -> c) -> (a -> b) -> a -> c
. Located (HsModule GhcPs) -> Derives
derives

-- Derivations can be implemented using any one of 3 strategies, so for each derivation
-- add it to all the strategies that might plausibly implement it
data Derives = Derives
    {Derives -> [String]
derivesStock' :: [String]
    ,Derives -> [String]
derivesAnyclass :: [String]
    ,Derives -> [String]
derivesNewtype' :: [String]
    }
instance Semigroup Derives where
    Derives [String]
x1 [String]
x2 [String]
x3 <> :: Derives -> Derives -> Derives
<> Derives [String]
y1 [String]
y2 [String]
y3 =
        [String] -> [String] -> [String] -> Derives
Derives ([String]
x1 forall a. [a] -> [a] -> [a]
++ [String]
y1) ([String]
x2 forall a. [a] -> [a] -> [a]
++ [String]
y2) ([String]
x3 forall a. [a] -> [a] -> [a]
++ [String]
y3)
instance Monoid Derives where
    mempty :: Derives
mempty = [String] -> [String] -> [String] -> Derives
Derives [] [] []
    mappend :: Derives -> Derives -> Derives
mappend = forall a. Semigroup a => a -> a -> a
(<>)

addDerives :: Maybe NewOrData -> Maybe (DerivStrategy GhcPs) -> [String] -> Derives
addDerives :: Maybe NewOrData
-> Maybe (DerivStrategy GhcPs) -> [String] -> Derives
addDerives Maybe NewOrData
_ (Just DerivStrategy GhcPs
s) [String]
xs = case DerivStrategy GhcPs
s of
    StockStrategy {} -> forall a. Monoid a => a
mempty{derivesStock' :: [String]
derivesStock' = [String]
xs}
    AnyclassStrategy {} -> forall a. Monoid a => a
mempty{derivesAnyclass :: [String]
derivesAnyclass = [String]
xs}
    NewtypeStrategy {} -> forall a. Monoid a => a
mempty{derivesNewtype' :: [String]
derivesNewtype' = [String]
xs}
    ViaStrategy {} -> forall a. Monoid a => a
mempty
addDerives Maybe NewOrData
nt Maybe (DerivStrategy GhcPs)
_ [String]
xs = forall a. Monoid a => a
mempty
    {derivesStock' :: [String]
derivesStock' = [String]
stock
    ,derivesAnyclass :: [String]
derivesAnyclass = [String]
other
    ,derivesNewtype' :: [String]
derivesNewtype' = if forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
True NewOrData -> Bool
isNewType Maybe NewOrData
nt then forall a. (a -> Bool) -> [a] -> [a]
filter (forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [String]
noDeriveNewtype) [String]
xs else []}
    where ([String]
stock, [String]
other) = forall a. (a -> Bool) -> [a] -> ([a], [a])
partition (forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [String]
deriveStock) [String]
xs

derives :: Located (HsModule GhcPs) -> Derives
derives :: Located (HsModule GhcPs) -> Derives
derives (L SrcSpan
_ HsModule GhcPs
m) =  forall a. Monoid a => [a] -> a
mconcat forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map LHsDecl GhcPs -> Derives
decl (forall from to. Biplate from to => from -> [to]
childrenBi HsModule GhcPs
m) forall a. [a] -> [a] -> [a]
++ forall a b. (a -> b) -> [a] -> [b]
map DataFamInstDecl GhcPs -> Derives
idecl (forall from to. Biplate from to => from -> [to]
childrenBi HsModule GhcPs
m)
  where
    idecl :: DataFamInstDecl GhcPs -> Derives
    idecl :: DataFamInstDecl GhcPs -> Derives
idecl (DataFamInstDecl FamEqn {feqn_rhs :: forall pass rhs. FamEqn pass rhs -> rhs
feqn_rhs=HsDataDefn {dd_cons :: forall pass. HsDataDefn pass -> DataDefnCons (LConDecl pass)
dd_cons=DataDefnCons (LConDecl GhcPs)
data_defn_cons, dd_derivs :: forall pass. HsDataDefn pass -> HsDeriving pass
dd_derivs=HsDeriving GhcPs
ds}}) = NewOrData -> HsDeriving GhcPs -> Derives
g (forall a. DataDefnCons a -> NewOrData
dataDefnConsNewOrData DataDefnCons (LConDecl GhcPs)
data_defn_cons) HsDeriving GhcPs
ds

    decl :: LHsDecl GhcPs -> Derives
    decl :: LHsDecl GhcPs -> Derives
decl (L SrcSpanAnnA
_ (TyClD XTyClD GhcPs
_ (DataDecl XDataDecl GhcPs
_ LIdP GhcPs
_ LHsQTyVars GhcPs
_ LexicalFixity
_ HsDataDefn {dd_cons :: forall pass. HsDataDefn pass -> DataDefnCons (LConDecl pass)
dd_cons=DataDefnCons (LConDecl GhcPs)
data_defn_cons, dd_derivs :: forall pass. HsDataDefn pass -> HsDeriving pass
dd_derivs=HsDeriving GhcPs
ds}))) = NewOrData -> HsDeriving GhcPs -> Derives
g (forall a. DataDefnCons a -> NewOrData
dataDefnConsNewOrData DataDefnCons (LConDecl GhcPs)
data_defn_cons) HsDeriving GhcPs
ds -- Data declaration.
    decl (L SrcSpanAnnA
_ (DerivD XDerivD GhcPs
_ (DerivDecl XCDerivDecl GhcPs
_ (HsWC XHsWC GhcPs (LHsSigType GhcPs)
_ LHsSigType GhcPs
sig) Maybe (LDerivStrategy GhcPs)
strategy Maybe (XRec GhcPs OverlapMode)
_))) = Maybe NewOrData
-> Maybe (DerivStrategy GhcPs) -> [String] -> Derives
addDerives forall a. Maybe a
Nothing (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall l e. GenLocated l e -> e
unLoc Maybe (LDerivStrategy GhcPs)
strategy) [LHsSigType GhcPs -> String
derivedToStr LHsSigType GhcPs
sig] -- A deriving declaration.
    decl LHsDecl GhcPs
_ = forall a. Monoid a => a
mempty

    g :: NewOrData -> [LHsDerivingClause GhcPs] -> Derives
    g :: NewOrData -> HsDeriving GhcPs -> Derives
g NewOrData
dn HsDeriving GhcPs
ds = forall a. Monoid a => [a] -> a
mconcat [Maybe NewOrData
-> Maybe (DerivStrategy GhcPs) -> [String] -> Derives
addDerives (forall a. a -> Maybe a
Just NewOrData
dn) (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall l e. GenLocated l e -> e
unLoc Maybe (GenLocated (SrcAnn NoEpAnns) (DerivStrategy GhcPs))
strategy) forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map LHsSigType GhcPs -> String
derivedToStr [GenLocated SrcSpanAnnA (HsSigType GhcPs)]
tys | (Maybe (GenLocated (SrcAnn NoEpAnns) (DerivStrategy GhcPs))
strategy, [GenLocated SrcSpanAnnA (HsSigType GhcPs)]
tys) <- [(Maybe (GenLocated (SrcAnn NoEpAnns) (DerivStrategy GhcPs)),
  [GenLocated SrcSpanAnnA (HsSigType GhcPs)])]
stys]
      where
        stys :: [(Maybe (GenLocated (SrcAnn NoEpAnns) (DerivStrategy GhcPs)),
  [GenLocated SrcSpanAnnA (HsSigType GhcPs)])]
stys =
          [(Maybe (LDerivStrategy GhcPs)
strategy, [LHsSigType GhcPs
ty]) | L SrcAnn NoEpAnns
_ (HsDerivingClause XCHsDerivingClause GhcPs
_ Maybe (LDerivStrategy GhcPs)
strategy (L SrcSpanAnnC
_ (DctSingle XDctSingle GhcPs
_ LHsSigType GhcPs
ty))) <- HsDeriving GhcPs
ds] forall a. [a] -> [a] -> [a]
++
          [(Maybe (LDerivStrategy GhcPs)
strategy, [LHsSigType GhcPs]
tys ) | L SrcAnn NoEpAnns
_ (HsDerivingClause XCHsDerivingClause GhcPs
_ Maybe (LDerivStrategy GhcPs)
strategy (L SrcSpanAnnC
_ (DctMulti XDctMulti GhcPs
_ [LHsSigType GhcPs]
tys))) <- HsDeriving GhcPs
ds]

    derivedToStr :: LHsSigType GhcPs -> String
    derivedToStr :: LHsSigType GhcPs -> String
derivedToStr (L SrcSpanAnnA
_ (HsSig XHsSig GhcPs
_ HsOuterSigTyVarBndrs GhcPs
_ LHsType GhcPs
t)) = LHsType GhcPs -> String
ih LHsType GhcPs
t
      where
        ih :: LHsType GhcPs -> String
        ih :: LHsType GhcPs -> String
ih (L SrcSpanAnnA
_ (HsQualTy XQualTy GhcPs
_ LHsContext GhcPs
_ LHsType GhcPs
a)) = LHsType GhcPs -> String
ih LHsType GhcPs
a
        ih (L SrcSpanAnnA
_ (HsParTy XParTy GhcPs
_ LHsType GhcPs
a)) = LHsType GhcPs -> String
ih LHsType GhcPs
a
        ih (L SrcSpanAnnA
_ (HsAppTy XAppTy GhcPs
_ LHsType GhcPs
a LHsType GhcPs
_)) = LHsType GhcPs -> String
ih LHsType GhcPs
a
        ih (L SrcSpanAnnA
_ (HsTyVar XTyVar GhcPs
_ PromotionFlag
_ LIdP GhcPs
a)) = forall a. Outputable a => a -> String
unsafePrettyPrint forall a b. (a -> b) -> a -> b
$ LocatedN RdrName -> LocatedN RdrName
unqual LIdP GhcPs
a
        ih (L SrcSpanAnnA
_ HsType GhcPs
a) = forall a. Outputable a => a -> String
unsafePrettyPrint HsType GhcPs
a -- I don't anticipate this case is called.

un :: a
un = forall a. HasCallStack => a
undefined

hasT :: a -> from -> Bool
hasT a
t from
x = Bool -> Bool
not forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t a -> Bool
null (forall from to. Biplate from to => from -> [to]
universeBi from
x forall a. a -> a -> a
`asTypeOf` [a
t])

hasS :: (Data x, Data a) => (a -> Bool) -> x -> Bool
hasS :: forall x a. (Data x, Data a) => (a -> Bool) -> x -> Bool
hasS a -> Bool
test = forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any a -> Bool
test forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall from to. Biplate from to => from -> [to]
universeBi