{-# LANGUAGE LambdaCase, NamedFieldPuns #-}

{-
    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 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 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
</TEST>
-}


module Hint.Extensions(extensionsHint) where

import Hint.Type(ModuHint,rawIdea,Severity(Warning),Note(..),toSS,ghcAnnotations,ghcModule)
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 qualified Data.Set as Set
import qualified Data.Map as Map

import GHC.Types.SrcLoc
import GHC.Hs
import GHC.Types.Basic
import GHC.Core.Class
import GHC.Types.Name.Reader
import GHC.Types.ForeignCall

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.Types
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"
        SrcSpan
sl
        (Located AnnotationComment -> String
comment (SrcSpan -> [String] -> Located AnnotationComment
mkLanguagePragmas SrcSpan
sl [String]
exts))
        (String -> Maybe String
forall a. a -> Maybe a
Just String
newPragma)
        ( [String -> Note
RequiresExtension (Extension -> String
forall a. Show a => a -> String
show Extension
gone) | (String
_, Just Extension
x) <- [(String, Maybe Extension)]
before [(String, Maybe Extension)]
-> [(String, Maybe Extension)] -> [(String, Maybe Extension)]
forall a. Eq a => [a] -> [a] -> [a]
\\ [(String, Maybe Extension)]
after, Extension
gone <- [Extension]
-> Extension -> Map Extension [Extension] -> [Extension]
forall k a. Ord k => a -> k -> Map k a -> a
Map.findWithDefault [] Extension
x Map Extension [Extension]
disappear] [Note] -> [Note] -> [Note]
forall a. [a] -> [a] -> [a]
++
            [ String -> Note
Note (String -> Note) -> String -> Note
forall a b. (a -> b) -> a -> b
$ String
"Extension " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
s String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" is " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Extension -> String
reason Extension
x
            | (String
s, Just Extension
x) <- [(String, Maybe Extension)]
explainedRemovals])
        [SrcSpan -> String -> Refactoring SrcSpan
forall a. a -> String -> Refactoring a
ModifyComment (Located AnnotationComment -> SrcSpan
forall a. Located a -> SrcSpan
toSS (SrcSpan -> [String] -> Located AnnotationComment
mkLanguagePragmas SrcSpan
sl [String]
exts)) String
newPragma]
    | (L SrcSpan
sl AnnotationComment
_,  [String]
exts) <- [(Located AnnotationComment, String)]
-> [(Located AnnotationComment, [String])]
languagePragmas ([(Located AnnotationComment, String)]
 -> [(Located AnnotationComment, [String])])
-> [(Located AnnotationComment, String)]
-> [(Located AnnotationComment, [String])]
forall a b. (a -> b) -> a -> b
$ ApiAnns -> [(Located AnnotationComment, String)]
pragmas (ModuleEx -> ApiAnns
ghcAnnotations 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 = ((String, Maybe Extension) -> Bool)
-> [(String, Maybe Extension)] -> [(String, Maybe Extension)]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> (Extension -> Bool) -> Maybe Extension -> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
True (Extension -> Set Extension -> Bool
forall a. Ord a => a -> Set a -> Bool
`Set.member` Set Extension
keep) (Maybe Extension -> Bool)
-> ((String, Maybe Extension) -> Maybe Extension)
-> (String, Maybe Extension)
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String, Maybe Extension) -> Maybe Extension
forall a b. (a, b) -> b
snd) [(String, Maybe Extension)]
before
    , [(String, Maybe Extension)]
before [(String, Maybe Extension)] -> [(String, Maybe Extension)] -> Bool
forall a. Eq a => a -> a -> Bool
/= [(String, Maybe Extension)]
after
    , let explainedRemovals :: [(String, Maybe Extension)]
explainedRemovals
            | [(String, Maybe Extension)] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [(String, Maybe Extension)]
after Bool -> Bool -> Bool
&& Bool -> Bool
not ((Extension -> Bool) -> [Extension] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (Extension -> Map Extension Extension -> Bool
forall k a. Ord k => k -> Map k a -> Bool
`Map.member` Map Extension Extension
implied) ([Extension] -> Bool) -> [Extension] -> Bool
forall a b. (a -> b) -> a -> b
$ ((String, Maybe Extension) -> Maybe Extension)
-> [(String, Maybe Extension)] -> [Extension]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (String, Maybe Extension) -> Maybe Extension
forall a b. (a, b) -> b
snd [(String, Maybe Extension)]
before) = []
            | Bool
otherwise = [(String, Maybe Extension)]
before [(String, Maybe Extension)]
-> [(String, Maybe Extension)] -> [(String, Maybe Extension)]
forall a. Eq a => [a] -> [a] -> [a]
\\ [(String, Maybe Extension)]
after
    , let newPragma :: String
newPragma =
            if [(String, Maybe Extension)] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [(String, Maybe Extension)]
after then String
"" else Located AnnotationComment -> String
comment (SrcSpan -> [String] -> Located AnnotationComment
mkLanguagePragmas SrcSpan
sl ([String] -> Located AnnotationComment)
-> [String] -> Located AnnotationComment
forall a b. (a -> b) -> a -> b
$ ((String, Maybe Extension) -> String)
-> [(String, Maybe Extension)] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (String, Maybe Extension) -> String
forall a b. (a, b) -> a
fst [(String, Maybe Extension)]
after)
    ]
  where
    usedTH :: Bool
    usedTH :: Bool
usedTH = Extension -> Located HsModule -> Bool
used Extension
TemplateHaskell (ModuleEx -> Located HsModule
ghcModule ModuleEx
x) Bool -> Bool -> Bool
|| Extension -> Located HsModule -> Bool
used Extension
QuasiQuotes (ModuleEx -> Located HsModule
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 = [Extension] -> Set Extension
forall a. Ord a => [a] -> Set a
Set.fromList ([Extension] -> Set Extension) -> [Extension] -> Set Extension
forall a b. (a -> b) -> a -> b
$ (String -> Maybe Extension) -> [String] -> [Extension]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe String -> Maybe Extension
readExtension ([String] -> [Extension]) -> [String] -> [Extension]
forall a b. (a -> b) -> a -> b
$
        ((Located AnnotationComment, [String]) -> [String])
-> [(Located AnnotationComment, [String])] -> [String]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (Located AnnotationComment, [String]) -> [String]
forall a b. (a, b) -> b
snd ([(Located AnnotationComment, [String])] -> [String])
-> [(Located AnnotationComment, [String])] -> [String]
forall a b. (a -> b) -> a -> b
$ [(Located AnnotationComment, String)]
-> [(Located AnnotationComment, [String])]
languagePragmas (ApiAnns -> [(Located AnnotationComment, String)]
pragmas (ModuleEx -> ApiAnns
ghcAnnotations ModuleEx
x))

    -- Those extensions we detect to be useful.
    useful :: Set.Set Extension
    useful :: Set Extension
useful = if Bool
usedTH then Set Extension
extensions else (Extension -> Bool) -> Set Extension -> Set Extension
forall a. (a -> Bool) -> Set a -> Set a
Set.filter (Extension -> Located HsModule -> Bool
`usedExt` ModuleEx -> Located HsModule
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 = [(Extension, Extension)] -> Map Extension Extension
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList
        [ (Extension
e, Extension
a)
        | Extension
e <- Set Extension -> [Extension]
forall a. Set a -> [a]
Set.toList Set Extension
useful
        , Extension
a:[Extension]
_ <- [(Extension -> Bool) -> [Extension] -> [Extension]
forall a. (a -> Bool) -> [a] -> [a]
filter (Extension -> Set Extension -> Bool
forall a. Ord a => a -> Set a -> Bool
`Set.member` Set Extension
useful) ([Extension] -> [Extension]) -> [Extension] -> [Extension]
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 Set Extension -> Set Extension -> Set Extension
forall a. Ord a => Set a -> Set a -> Set a
`Set.difference` Map Extension Extension -> Set Extension
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 =
        ([Extension] -> [Extension] -> [Extension])
-> [(Extension, [Extension])] -> Map Extension [Extension]
forall k a. Ord k => (a -> a -> a) -> [(k, a)] -> Map k a
Map.fromListWith [Extension] -> [Extension] -> [Extension]
forall a. [a] -> [a] -> [a]
(++) ([(Extension, [Extension])] -> Map Extension [Extension])
-> [(Extension, [Extension])] -> Map Extension [Extension]
forall a b. (a -> b) -> a -> b
$
        ((Extension, [Extension]) -> [Extension])
-> [(Extension, [Extension])] -> [(Extension, [Extension])]
forall b a. Ord b => (a -> b) -> [a] -> [a]
nubOrdOn (Extension, [Extension]) -> [Extension]
forall a b. (a, b) -> b
snd -- Only keep one instance for each of a.
        [ (Extension
e, [Extension
a])
        | Extension
e <- Set Extension -> [Extension]
forall a. Set a -> [a]
Set.toList (Set Extension -> [Extension]) -> Set Extension -> [Extension]
forall a b. (a -> b) -> a -> b
$ Set Extension
extensions Set Extension -> Set Extension -> Set Extension
forall a. Ord a => Set a -> Set a -> Set a
`Set.difference` Set Extension
keep
        , Extension
a <- ([Extension], [Extension]) -> [Extension]
forall a b. (a, b) -> a
fst (([Extension], [Extension]) -> [Extension])
-> ([Extension], [Extension]) -> [Extension]
forall a b. (a -> b) -> a -> b
$ Extension -> ([Extension], [Extension])
extensionImplies Extension
e
        , Extension
a Extension -> Set Extension -> Bool
forall a. Ord a => a -> Set a -> Bool
`Set.notMember` Set Extension
useful
        , Bool
usedTH Bool -> Bool -> Bool
|| Extension -> Located HsModule -> Bool
usedExt Extension
a (ModuleEx -> Located HsModule
ghcModule ModuleEx
x)
        ]
    reason :: Extension -> String
    reason :: Extension -> String
reason Extension
x =
      case Extension -> Map Extension Extension -> Maybe Extension
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 " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Extension -> String
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 =
    String -> [String] -> [String]
forall a. Eq a => a -> [a] -> [a]
delete String
"Enum" [String]
deriveHaskell [String] -> [String] -> [String]
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 [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String]
deriveGenerics [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String]
deriveCategory

usedExt :: Extension -> Located HsModule -> Bool
usedExt :: Extension -> Located HsModule -> Bool
usedExt Extension
NumDecimals = (HsExpr GhcPs -> Bool) -> Located HsModule -> Bool
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 -> Bool
hasDerive [String
"Lift"]
usedExt Extension
DeriveAnyClass = Bool -> Bool
not (Bool -> Bool)
-> (Located HsModule -> Bool) -> Located HsModule -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null ([String] -> Bool)
-> (Located HsModule -> [String]) -> Located HsModule -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Derives -> [String]
derivesAnyclass (Derives -> [String])
-> (Located HsModule -> Derives) -> Located HsModule -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Located HsModule -> Derives
derives
usedExt Extension
x = Extension -> Located HsModule -> Bool
used Extension
x

-- The ghc-lib-parser-ex functions are getting fixed to have the new
-- signatures.
isMDo' :: HsStmtContext GhcRn -> Bool
isMDo' :: HsStmtContext GhcRn -> Bool
isMDo' = \case MDoExpr Maybe ModuleName
_ -> Bool
True; HsStmtContext GhcRn
_ -> Bool
False
isStrictMatch' :: HsMatchContext GhcPs -> Bool
isStrictMatch' :: HsMatchContext GhcPs -> Bool
isStrictMatch' = \case FunRhs{mc_strictness :: forall p. HsMatchContext p -> SrcStrictness
mc_strictness=SrcStrictness
SrcStrict} -> Bool
True; HsMatchContext GhcPs
_ -> Bool
False

used :: Extension -> Located HsModule -> Bool

used :: Extension -> Located HsModule -> Bool
used Extension
RecursiveDo = (HsStmtContext GhcRn -> Bool) -> Located HsModule -> Bool
forall x a. (Data x, Data a) => (a -> Bool) -> x -> Bool
hasS HsStmtContext GhcRn -> Bool
isMDo' (Located HsModule -> Bool)
-> (Located HsModule -> Bool) -> Located HsModule -> Bool
forall (m :: * -> *). Monad m => m Bool -> m Bool -> m Bool
||^ (StmtLR GhcPs GhcPs (LHsExpr GhcPs) -> Bool)
-> Located HsModule -> Bool
forall x a. (Data x, Data a) => (a -> Bool) -> x -> Bool
hasS StmtLR GhcPs GhcPs (LHsExpr GhcPs) -> Bool
isRecStmt
used Extension
ParallelListComp = (StmtLR GhcPs GhcPs (LHsExpr GhcPs) -> Bool)
-> Located HsModule -> Bool
forall x a. (Data x, Data a) => (a -> Bool) -> x -> Bool
hasS StmtLR GhcPs GhcPs (LHsExpr GhcPs) -> Bool
isParComp
used Extension
FunctionalDependencies = FunDep (Located RdrName) -> Located HsModule -> Bool
forall from a. (Data from, Data a) => a -> from -> Bool
hasT (FunDep (Located RdrName)
forall a. a
un :: FunDep (Located RdrName))
used Extension
ImplicitParams = HsIPName -> Located HsModule -> Bool
forall from a. (Data from, Data a) => a -> from -> Bool
hasT (HsIPName
forall a. a
un :: HsIPName)
used Extension
TypeApplications = (LHsExpr GhcPs -> Bool) -> Located HsModule -> Bool
forall x a. (Data x, Data a) => (a -> Bool) -> x -> Bool
hasS LHsExpr GhcPs -> Bool
isTypeApp
used Extension
EmptyDataDecls = (HsDataDefn GhcPs -> Bool) -> Located HsModule -> Bool
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
_ NewOrData
_ LHsContext GhcPs
_ Maybe (Located CType)
_ Maybe (LHsKind GhcPs)
_ [] HsDeriving GhcPs
_) = Bool
True
    f HsDataDefn GhcPs
_ = Bool
False
used Extension
EmptyCase = (HsExpr GhcPs -> Bool) -> Located HsModule -> Bool
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 SrcSpan
_ []) Origin
_)) = Bool
True
    f (HsLamCase XLamCase GhcPs
_ (MG XMG GhcPs (LHsExpr GhcPs)
_ (L SrcSpan
_ []) Origin
_)) = Bool
True
    f HsExpr GhcPs
_ = Bool
False
used Extension
KindSignatures = HsKind GhcPs -> Located HsModule -> Bool
forall from a. (Data from, Data a) => a -> from -> Bool
hasT (HsKind GhcPs
forall a. a
un :: HsKind GhcPs)
used Extension
BangPatterns = (Located (Pat GhcPs) -> Bool) -> Located HsModule -> Bool
forall x a. (Data x, Data a) => (a -> Bool) -> x -> Bool
hasS LPat GhcPs -> Bool
Located (Pat GhcPs) -> Bool
isPBangPat (Located HsModule -> Bool)
-> (Located HsModule -> Bool) -> Located HsModule -> Bool
forall (m :: * -> *). Monad m => m Bool -> m Bool -> m Bool
||^ (HsMatchContext GhcPs -> Bool) -> Located HsModule -> Bool
forall x a. (Data x, Data a) => (a -> Bool) -> x -> Bool
hasS HsMatchContext GhcPs -> Bool
isStrictMatch'
used Extension
TemplateHaskell = (HsBracket GhcPs, HsSplice GhcPs) -> Located HsModule -> Bool
forall from a a.
(Data from, Data a, Data a) =>
(a, a) -> from -> Bool
hasT2' ((HsBracket GhcPs, HsSplice GhcPs)
forall a. a
un :: (HsBracket GhcPs, HsSplice GhcPs)) (Located HsModule -> Bool)
-> (Located HsModule -> Bool) -> Located HsModule -> Bool
forall (m :: * -> *). Monad m => m Bool -> m Bool -> m Bool
||^ (HsBracket GhcPs -> Bool) -> Located HsModule -> Bool
forall x a. (Data x, Data a) => (a -> Bool) -> x -> Bool
hasS HsBracket GhcPs -> Bool
f (Located HsModule -> Bool)
-> (Located HsModule -> Bool) -> Located HsModule -> Bool
forall (m :: * -> *). Monad m => m Bool -> m Bool -> m Bool
||^ (HsExpr GhcPs -> Bool) -> Located HsModule -> Bool
forall x a. (Data x, Data a) => (a -> Bool) -> x -> Bool
hasS HsExpr GhcPs -> Bool
isSpliceDecl
  where
    f :: HsBracket GhcPs -> Bool
    f :: HsBracket GhcPs -> Bool
f VarBr{} = Bool
True
    f TypBr{} = Bool
True
    f HsBracket GhcPs
_ = Bool
False
used Extension
ForeignFunctionInterface = CCallConv -> Located HsModule -> Bool
forall from a. (Data from, Data a) => a -> from -> Bool
hasT (CCallConv
forall a. a
un :: CCallConv)
used Extension
PatternGuards = (GRHS GhcPs (LHsExpr GhcPs) -> Bool) -> Located HsModule -> Bool
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 SrcSpan
_ BodyStmt{}] = Bool
False
    g [GuardLStmt GhcPs]
_ = Bool
True
used Extension
StandaloneDeriving = (LHsDecl GhcPs -> Bool) -> Located HsModule -> Bool
forall x a. (Data x, Data a) => (a -> Bool) -> x -> Bool
hasS LHsDecl GhcPs -> Bool
isDerivD
used Extension
TypeOperators = (HsKind GhcPs -> Bool) -> Located HsModule -> Bool
forall x a. (Data x, Data a) => (a -> Bool) -> x -> Bool
hasS HsKind GhcPs -> Bool
tyOpInSig (Located HsModule -> Bool)
-> (Located HsModule -> Bool) -> Located HsModule -> Bool
forall (m :: * -> *). Monad m => m Bool -> m Bool -> m Bool
||^ (HsDecl GhcPs -> Bool) -> Located HsModule -> Bool
forall x a. (Data x, Data a) => (a -> Bool) -> x -> Bool
hasS HsDecl GhcPs -> Bool
tyOpInDecl
  where
    tyOpInSig :: HsType GhcPs -> Bool
    tyOpInSig :: HsKind GhcPs -> Bool
tyOpInSig = \case
      HsOpTy{} -> Bool
True; HsKind GhcPs
_ -> Bool
False

    tyOpInDecl :: HsDecl GhcPs -> Bool
    tyOpInDecl :: HsDecl GhcPs -> Bool
tyOpInDecl = \case
      (TyClD XTyClD GhcPs
_ (FamDecl XFamDecl GhcPs
_ FamilyDecl{Located (IdP GhcPs)
fdLName :: forall pass. FamilyDecl pass -> Located (IdP pass)
fdLName :: Located (IdP GhcPs)
fdLName})) -> Located RdrName -> Bool
forall l. GenLocated l RdrName -> Bool
isOp Located (IdP GhcPs)
Located RdrName
fdLName
      (TyClD XTyClD GhcPs
_ SynDecl{Located (IdP GhcPs)
tcdLName :: forall pass. TyClDecl pass -> Located (IdP pass)
tcdLName :: Located (IdP GhcPs)
tcdLName}) -> Located RdrName -> Bool
forall l. GenLocated l RdrName -> Bool
isOp Located (IdP GhcPs)
Located RdrName
tcdLName
      (TyClD XTyClD GhcPs
_ DataDecl{Located (IdP GhcPs)
tcdLName :: Located (IdP GhcPs)
tcdLName :: forall pass. TyClDecl pass -> Located (IdP pass)
tcdLName}) -> Located RdrName -> Bool
forall l. GenLocated l RdrName -> Bool
isOp Located (IdP GhcPs)
Located RdrName
tcdLName
      (TyClD XTyClD GhcPs
_ ClassDecl{Located (IdP GhcPs)
tcdLName :: Located (IdP GhcPs)
tcdLName :: forall pass. TyClDecl pass -> Located (IdP pass)
tcdLName, [LFamilyDecl GhcPs]
tcdATs :: forall pass. TyClDecl pass -> [LFamilyDecl pass]
tcdATs :: [LFamilyDecl GhcPs]
tcdATs}) -> (Located RdrName -> Bool) -> [Located RdrName] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any Located RdrName -> Bool
forall l. GenLocated l RdrName -> Bool
isOp (Located (IdP GhcPs)
Located RdrName
tcdLName Located RdrName -> [Located RdrName] -> [Located RdrName]
forall a. a -> [a] -> [a]
: [FamilyDecl GhcPs -> Located (IdP GhcPs)
forall pass. FamilyDecl pass -> Located (IdP pass)
fdLName FamilyDecl GhcPs
famDecl | L SrcSpan
_ 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 = (HsRecFields GhcPs (LHsExpr GhcPs) -> Bool)
-> Located HsModule -> Bool
forall x a. (Data x, Data a) => (a -> Bool) -> x -> Bool
hasS HsRecFields GhcPs (LHsExpr GhcPs) -> Bool
hasFieldsDotDot (Located HsModule -> Bool)
-> (Located HsModule -> Bool) -> Located HsModule -> Bool
forall (m :: * -> *). Monad m => m Bool -> m Bool -> m Bool
||^ (HsRecFields GhcPs (Located (Pat GhcPs)) -> Bool)
-> Located HsModule -> Bool
forall x a. (Data x, Data a) => (a -> Bool) -> x -> Bool
hasS HsRecFields GhcPs (LPat GhcPs) -> Bool
HsRecFields GhcPs (Located (Pat GhcPs)) -> Bool
hasPFieldsDotDot
used Extension
RecordPuns = (LHsRecField GhcPs (Located (Pat GhcPs)) -> Bool)
-> Located HsModule -> Bool
forall x a. (Data x, Data a) => (a -> Bool) -> x -> Bool
hasS LHsRecField GhcPs (LPat GhcPs) -> Bool
LHsRecField GhcPs (Located (Pat GhcPs)) -> Bool
isPFieldPun (Located HsModule -> Bool)
-> (Located HsModule -> Bool) -> Located HsModule -> Bool
forall (m :: * -> *). Monad m => m Bool -> m Bool -> m Bool
||^ (LHsRecField GhcPs (LHsExpr GhcPs) -> Bool)
-> Located HsModule -> Bool
forall x a. (Data x, Data a) => (a -> Bool) -> x -> Bool
hasS LHsRecField GhcPs (LHsExpr GhcPs) -> Bool
isFieldPun (Located HsModule -> Bool)
-> (Located HsModule -> Bool) -> Located HsModule -> Bool
forall (m :: * -> *). Monad m => m Bool -> m Bool -> m Bool
||^ (HsRecField' (AmbiguousFieldOcc GhcPs) (LHsExpr GhcPs) -> Bool)
-> Located HsModule -> Bool
forall x a. (Data x, Data a) => (a -> Bool) -> x -> Bool
hasS HsRecField' (AmbiguousFieldOcc GhcPs) (LHsExpr GhcPs) -> Bool
isFieldPunUpdate
used Extension
UnboxedTuples = (HsTupleSort -> Bool) -> Located HsModule -> Bool
forall x a. (Data x, Data a) => (a -> Bool) -> x -> Bool
hasS HsTupleSort -> Bool
isUnboxedTuple (Located HsModule -> Bool)
-> (Located HsModule -> Bool) -> Located HsModule -> Bool
forall (m :: * -> *). Monad m => m Bool -> m Bool -> m Bool
||^ (Boxity -> Bool) -> Located HsModule -> Bool
forall x a. (Data x, Data a) => (a -> Bool) -> x -> Bool
hasS (Boxity -> Boxity -> Bool
forall a. Eq a => a -> a -> Bool
== Boxity
Unboxed) (Located HsModule -> Bool)
-> (Located HsModule -> Bool) -> Located HsModule -> Bool
forall (m :: * -> *). Monad m => m Bool -> m Bool -> m Bool
||^ (Maybe (LDerivStrategy GhcPs) -> Bool) -> Located HsModule -> 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 = (ImportDecl GhcPs -> Bool) -> Located HsModule -> Bool
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 -> Maybe StringLiteral
ideclPkgQual=Just StringLiteral
_} = Bool
True
      f ImportDecl GhcPs
_ = Bool
False
used Extension
QuasiQuotes = (LHsExpr GhcPs -> Bool) -> Located HsModule -> Bool
forall x a. (Data x, Data a) => (a -> Bool) -> x -> Bool
hasS LHsExpr GhcPs -> Bool
isQuasiQuote (Located HsModule -> Bool)
-> (Located HsModule -> Bool) -> Located HsModule -> Bool
forall (m :: * -> *). Monad m => m Bool -> m Bool -> m Bool
||^ (LHsKind GhcPs -> Bool) -> Located HsModule -> Bool
forall x a. (Data x, Data a) => (a -> Bool) -> x -> Bool
hasS LHsKind GhcPs -> Bool
isTyQuasiQuote
used Extension
ViewPatterns = (Located (Pat GhcPs) -> Bool) -> Located HsModule -> Bool
forall x a. (Data x, Data a) => (a -> Bool) -> x -> Bool
hasS LPat GhcPs -> Bool
Located (Pat GhcPs) -> Bool
isPViewPat
used Extension
InstanceSigs = (HsDecl GhcPs -> Bool) -> Located HsModule -> Bool
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) = Sig GhcPs -> InstDecl GhcPs -> Bool
forall from a. (Data from, Data a) => a -> from -> Bool
hasT (Sig GhcPs
forall a. a
un :: Sig GhcPs) InstDecl GhcPs
decl
    f HsDecl GhcPs
_ = Bool
False
used Extension
DefaultSignatures = (Sig GhcPs -> Bool) -> Located HsModule -> Bool
forall x a. (Data x, Data a) => (a -> Bool) -> x -> Bool
hasS Sig GhcPs -> Bool
isClsDefSig
used Extension
DeriveDataTypeable = [String] -> Located HsModule -> Bool
hasDerive [String
"Data",String
"Typeable"]
used Extension
DeriveFunctor = [String] -> Located HsModule -> Bool
hasDerive [String
"Functor"]
used Extension
DeriveFoldable = [String] -> Located HsModule -> Bool
hasDerive [String
"Foldable"]
used Extension
DeriveTraversable = [String] -> Located HsModule -> Bool
hasDerive [String
"Traversable",String
"Foldable",String
"Functor"]
used Extension
DeriveGeneric = [String] -> Located HsModule -> Bool
hasDerive [String
"Generic",String
"Generic1"]
used Extension
GeneralizedNewtypeDeriving = Bool -> Bool
not (Bool -> Bool)
-> (Located HsModule -> Bool) -> Located HsModule -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null ([String] -> Bool)
-> (Located HsModule -> [String]) -> Located HsModule -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Derives -> [String]
derivesNewtype' (Derives -> [String])
-> (Located HsModule -> Derives) -> Located HsModule -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Located HsModule -> Derives
derives
used Extension
MultiWayIf = (HsExpr GhcPs -> Bool) -> Located HsModule -> Bool
forall x a. (Data x, Data a) => (a -> Bool) -> x -> Bool
hasS HsExpr GhcPs -> Bool
isMultiIf
used Extension
NumericUnderscores = (OverLitVal -> Bool) -> Located HsModule -> Bool
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
'_' Char -> String -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` String
t
    f (HsFractional (FL (SourceText String
t) Bool
_ Rational
_)) = Char
'_' Char -> String -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` String
t
    f OverLitVal
_ = Bool
False

used Extension
LambdaCase = (LHsExpr GhcPs -> Bool) -> Located HsModule -> Bool
forall x a. (Data x, Data a) => (a -> Bool) -> x -> Bool
hasS LHsExpr GhcPs -> Bool
isLCase
used Extension
TupleSections = (HsTupArg GhcPs -> Bool) -> Located HsModule -> Bool
forall x a. (Data x, Data a) => (a -> Bool) -> x -> Bool
hasS HsTupArg GhcPs -> Bool
isTupleSection
used Extension
OverloadedStrings = (HsLit GhcPs -> Bool) -> Located HsModule -> Bool
forall x a. (Data x, Data a) => (a -> Bool) -> x -> Bool
hasS HsLit GhcPs -> Bool
isString
used Extension
OverloadedLists = (HsExpr GhcPs -> Bool) -> Located HsModule -> Bool
forall x a. (Data x, Data a) => (a -> Bool) -> x -> Bool
hasS HsExpr GhcPs -> Bool
isListExpr (Located HsModule -> Bool)
-> (Located HsModule -> Bool) -> Located HsModule -> Bool
forall (m :: * -> *). Monad m => m Bool -> m Bool -> m Bool
||^ (Pat GhcPs -> Bool) -> Located HsModule -> 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
_ Located (IdP GhcPs)
n) = Located RdrName -> String
rdrNameStr Located (IdP GhcPs)
Located RdrName
n String -> String -> Bool
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 = (HsExpr GhcPs -> Bool) -> Located HsModule -> Bool
forall x a. (Data x, Data a) => (a -> Bool) -> x -> Bool
hasS HsExpr GhcPs -> Bool
isLabel
  where
    isLabel :: HsExpr GhcPs -> Bool
    isLabel :: HsExpr GhcPs -> Bool
isLabel HsOverLabel{} = Bool
True
    isLabel HsExpr GhcPs
_ = Bool
False

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

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

hasDerive :: [String] -> Located HsModule -> Bool
hasDerive :: [String] -> Located HsModule -> Bool
hasDerive [String]
want = (String -> Bool) -> [String] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (String -> [String] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [String]
want) ([String] -> Bool)
-> (Located HsModule -> [String]) -> Located HsModule -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Derives -> [String]
derivesStock' (Derives -> [String])
-> (Located HsModule -> Derives) -> Located HsModule -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Located HsModule -> 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 [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String]
y1) ([String]
x2 [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String]
y2) ([String]
x3 [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String]
y3)
instance Monoid Derives where
    mempty :: Derives
mempty = [String] -> [String] -> [String] -> Derives
Derives [] [] []
    mappend :: Derives -> Derives -> Derives
mappend = Derives -> Derives -> Derives
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
    DerivStrategy GhcPs
StockStrategy -> Derives
forall a. Monoid a => a
mempty{derivesStock' :: [String]
derivesStock' = [String]
xs}
    DerivStrategy GhcPs
AnyclassStrategy -> Derives
forall a. Monoid a => a
mempty{derivesAnyclass :: [String]
derivesAnyclass = [String]
xs}
    DerivStrategy GhcPs
NewtypeStrategy -> Derives
forall a. Monoid a => a
mempty{derivesNewtype' :: [String]
derivesNewtype' = [String]
xs}
    ViaStrategy{} -> Derives
forall a. Monoid a => a
mempty
addDerives Maybe NewOrData
nt Maybe (DerivStrategy GhcPs)
_ [String]
xs = Derives
forall a. Monoid a => a
mempty
    {derivesStock' :: [String]
derivesStock' = [String]
stock
    ,derivesAnyclass :: [String]
derivesAnyclass = [String]
other
    ,derivesNewtype' :: [String]
derivesNewtype' = if Bool -> (NewOrData -> Bool) -> Maybe NewOrData -> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
True NewOrData -> Bool
isNewType Maybe NewOrData
nt then (String -> Bool) -> [String] -> [String]
forall a. (a -> Bool) -> [a] -> [a]
filter (String -> [String] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [String]
noDeriveNewtype) [String]
xs else []}
    where ([String]
stock, [String]
other) = (String -> Bool) -> [String] -> ([String], [String])
forall a. (a -> Bool) -> [a] -> ([a], [a])
partition (String -> [String] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [String]
deriveStock) [String]
xs

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

    decl :: LHsDecl GhcPs -> Derives
    decl :: LHsDecl GhcPs -> Derives
decl (L SrcSpan
_ (TyClD XTyClD GhcPs
_ (DataDecl XDataDecl GhcPs
_ Located (IdP GhcPs)
_ LHsQTyVars GhcPs
_ LexicalFixity
_ HsDataDefn {dd_ND :: forall pass. HsDataDefn pass -> NewOrData
dd_ND=NewOrData
dn, dd_derivs :: forall pass. HsDataDefn pass -> HsDeriving pass
dd_derivs=(L SrcSpan
_ [LHsDerivingClause GhcPs]
ds)}))) = NewOrData -> [LHsDerivingClause GhcPs] -> Derives
g NewOrData
dn [LHsDerivingClause GhcPs]
ds -- Data declaration.
    decl (L SrcSpan
_ (DerivD XDerivD GhcPs
_ (DerivDecl XCDerivDecl GhcPs
_ (HsWC XHsWC GhcPs (LHsSigType GhcPs)
_ LHsSigType GhcPs
sig) Maybe (LDerivStrategy GhcPs)
strategy Maybe (Located OverlapMode)
_))) = Maybe NewOrData
-> Maybe (DerivStrategy GhcPs) -> [String] -> Derives
addDerives Maybe NewOrData
forall a. Maybe a
Nothing ((LDerivStrategy GhcPs -> DerivStrategy GhcPs)
-> Maybe (LDerivStrategy GhcPs) -> Maybe (DerivStrategy GhcPs)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap LDerivStrategy GhcPs -> DerivStrategy GhcPs
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
_ = Derives
forall a. Monoid a => a
mempty

    g :: NewOrData -> [LHsDerivingClause GhcPs] -> Derives
    g :: NewOrData -> [LHsDerivingClause GhcPs] -> Derives
g NewOrData
dn [LHsDerivingClause GhcPs]
ds = [Derives] -> Derives
forall a. Monoid a => [a] -> a
mconcat [Maybe NewOrData
-> Maybe (DerivStrategy GhcPs) -> [String] -> Derives
addDerives (NewOrData -> Maybe NewOrData
forall a. a -> Maybe a
Just NewOrData
dn) ((LDerivStrategy GhcPs -> DerivStrategy GhcPs)
-> Maybe (LDerivStrategy GhcPs) -> Maybe (DerivStrategy GhcPs)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap LDerivStrategy GhcPs -> DerivStrategy GhcPs
forall l e. GenLocated l e -> e
unLoc Maybe (LDerivStrategy GhcPs)
strategy) ([String] -> Derives) -> [String] -> Derives
forall a b. (a -> b) -> a -> b
$ (LHsSigType GhcPs -> String) -> [LHsSigType GhcPs] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map LHsSigType GhcPs -> String
derivedToStr [LHsSigType GhcPs]
tys | L SrcSpan
_ (HsDerivingClause XCHsDerivingClause GhcPs
_ Maybe (LDerivStrategy GhcPs)
strategy (L SrcSpan
_ [LHsSigType GhcPs]
tys)) <- [LHsDerivingClause GhcPs]
ds]

    derivedToStr :: LHsSigType GhcPs -> String
    derivedToStr :: LHsSigType GhcPs -> String
derivedToStr (HsIB XHsIB GhcPs (LHsKind GhcPs)
_ LHsKind GhcPs
t) = LHsKind GhcPs -> String
ih LHsKind GhcPs
t
      where
        ih :: LHsType GhcPs -> String
        ih :: LHsKind GhcPs -> String
ih (L SrcSpan
_ (HsQualTy XQualTy GhcPs
_ LHsContext GhcPs
_ LHsKind GhcPs
a)) = LHsKind GhcPs -> String
ih LHsKind GhcPs
a
        ih (L SrcSpan
_ (HsParTy XParTy GhcPs
_ LHsKind GhcPs
a)) = LHsKind GhcPs -> String
ih LHsKind GhcPs
a
        ih (L SrcSpan
_ (HsAppTy XAppTy GhcPs
_ LHsKind GhcPs
a LHsKind GhcPs
_)) = LHsKind GhcPs -> String
ih LHsKind GhcPs
a
        ih (L SrcSpan
_ (HsTyVar XTyVar GhcPs
_ PromotionFlag
_ Located (IdP GhcPs)
a)) = Located RdrName -> String
forall a. Outputable a => a -> String
unsafePrettyPrint (Located RdrName -> String) -> Located RdrName -> String
forall a b. (a -> b) -> a -> b
$ Located RdrName -> Located RdrName
unqual Located (IdP GhcPs)
Located RdrName
a
        ih (L SrcSpan
_ HsKind GhcPs
a) = HsKind GhcPs -> String
forall a. Outputable a => a -> String
unsafePrettyPrint HsKind GhcPs
a -- I don't anticipate this case is called.

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

hasT :: a -> from -> Bool
hasT a
t from
x = Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null (from -> [a]
forall from to. Biplate from to => from -> [to]
universeBi from
x [a] -> [a] -> [a]
forall a. a -> a -> a
`asTypeOf` [a
t])
hasT2' :: (a, a) -> from -> Bool
hasT2' ~(a
t1,a
t2) = a -> from -> Bool
forall from a. (Data from, Data a) => a -> from -> Bool
hasT a
t1 (from -> Bool) -> (from -> Bool) -> from -> Bool
forall (m :: * -> *). Monad m => m Bool -> m Bool -> m Bool
||^ a -> from -> Bool
forall from a. (Data from, Data a) => a -> from -> Bool
hasT a
t2

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