{-# LANGUAGE ScopedTypeVariables #-}

{-
    Suggest removal of unnecessary extensions
    i.e. They have {-# LANGUAGE RecursiveDo #-} but no mdo keywords
<TEST>
{-# LANGUAGE Arrows #-} \
f = id --
{-# LANGUAGE TotallyUnknown #-} \
f = id
{-# LANGUAGE Foo, ParallelListComp, ImplicitParams #-} \
f = [(a,c) | a <- b | c <- d] -- {-# LANGUAGE Foo, 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 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 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 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 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" []}|]
</TEST>
-}


module Hint.Extensions(extensionsHint) where

import Hint.Type
import Control.Monad.Extra
import Data.Maybe
import Data.List.Extra
import Data.Ratio
import Data.Data
import Refact.Types
import Data.Semigroup
import qualified Data.Set as Set
import qualified Data.Map as Map
import Prelude


extensionsHint :: ModuHint
extensionsHint :: ModuHint
extensionsHint _ x :: Module_
x =
    [ Severity
-> String
-> SrcSpan
-> String
-> Maybe String
-> [Note]
-> [Refactoring SrcSpan]
-> Idea
rawIdea Severity
Warning "Unused LANGUAGE pragma"
        (SrcSpanInfo -> SrcSpan
srcInfoSpan SrcSpanInfo
sl)
        (ModulePragma SrcSpanInfo -> String
forall a. Pretty a => a -> String
prettyPrint ModulePragma SrcSpanInfo
o)
        (String -> Maybe String
forall a. a -> Maybe a
Just String
newPragma)
        ( [String -> Note
RequiresExtension (String -> Note) -> String -> Note
forall a b. (a -> b) -> a -> b
$ Extension -> String
prettyExtension Extension
gone | Extension
x <- [Extension]
before [Extension] -> [Extension] -> [Extension]
forall a. Eq a => [a] -> [a] -> [a]
\\ [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
$ "Extension " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Extension -> String
prettyExtension Extension
x String -> String -> String
forall a. [a] -> [a] -> [a]
++ " is " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Extension -> String
reason Extension
x
            | Extension
x <- [Extension]
explainedRemovals])
        [SrcSpan -> String -> Refactoring SrcSpan
forall a. a -> String -> Refactoring a
ModifyComment (ModulePragma SrcSpanInfo -> SrcSpan
forall (a :: * -> *). Annotated a => a SrcSpanInfo -> SrcSpan
toSS ModulePragma SrcSpanInfo
o) String
newPragma]
    | o :: ModulePragma SrcSpanInfo
o@(LanguagePragma sl :: SrcSpanInfo
sl exts :: [Name SrcSpanInfo]
exts) <- Module_ -> [ModulePragma SrcSpanInfo]
modulePragmas Module_
x
    , let before :: [Extension]
before = (Name SrcSpanInfo -> Extension)
-> [Name SrcSpanInfo] -> [Extension]
forall a b. (a -> b) -> [a] -> [b]
map (String -> Extension
parseExtension (String -> Extension)
-> (Name SrcSpanInfo -> String) -> Name SrcSpanInfo -> Extension
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Name SrcSpanInfo -> String
forall a. Pretty a => a -> String
prettyPrint) [Name SrcSpanInfo]
exts
    , let after :: [Extension]
after = (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
keep) [Extension]
before
    , [Extension]
before [Extension] -> [Extension] -> Bool
forall a. Eq a => a -> a -> Bool
/= [Extension]
after
    , let explainedRemovals :: [Extension]
explainedRemovals
            | [Extension] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [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]
before) = []
            | Bool
otherwise = [Extension]
before [Extension] -> [Extension] -> [Extension]
forall a. Eq a => [a] -> [a] -> [a]
\\ [Extension]
after
    , let newPragma :: String
newPragma = if [Extension] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Extension]
after then "" else ModulePragma SrcSpanInfo -> String
forall a. Pretty a => a -> String
prettyPrint (ModulePragma SrcSpanInfo -> String)
-> ModulePragma SrcSpanInfo -> String
forall a b. (a -> b) -> a -> b
$ SrcSpanInfo -> [Name SrcSpanInfo] -> ModulePragma SrcSpanInfo
forall l. l -> [Name l] -> ModulePragma l
LanguagePragma SrcSpanInfo
sl ([Name SrcSpanInfo] -> ModulePragma SrcSpanInfo)
-> [Name SrcSpanInfo] -> ModulePragma SrcSpanInfo
forall a b. (a -> b) -> a -> b
$ (Extension -> Name SrcSpanInfo)
-> [Extension] -> [Name SrcSpanInfo]
forall a b. (a -> b) -> [a] -> [b]
map (String -> Name SrcSpanInfo
forall a. Named a => String -> a
toNamed (String -> Name SrcSpanInfo)
-> (Extension -> String) -> Extension -> Name SrcSpanInfo
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Extension -> String
prettyExtension) [Extension]
after
    ]
    where
        usedTH :: Bool
usedTH = KnownExtension -> Module_ -> Bool
used KnownExtension
TemplateHaskell Module_
x Bool -> Bool -> Bool
|| KnownExtension -> Module_ -> Bool
used KnownExtension
QuasiQuotes Module_
x
            -- if TH or QuasiQuotes is on, can use all other extensions programmatically

        -- all the extensions defined to be used
        extensions :: Set Extension
extensions = [Extension] -> Set Extension
forall a. Ord a => [a] -> Set a
Set.fromList [String -> Extension
parseExtension (String -> Extension) -> String -> Extension
forall a b. (a -> b) -> a -> b
$ Name SrcSpanInfo -> String
forall a. Named a => a -> String
fromNamed Name SrcSpanInfo
e | LanguagePragma _ exts :: [Name SrcSpanInfo]
exts <- Module_ -> [ModulePragma SrcSpanInfo]
modulePragmas Module_
x, Name SrcSpanInfo
e <- [Name SrcSpanInfo]
exts]

        -- those extensions we detect to be useful
        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 -> Module_ -> Bool
`usedExt` Module_
x) Set Extension
extensions

        -- those extensions which are useful, but implied by other useful extensions
        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
            , a :: Extension
a:_ <- [(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]
extensionImpliedBy Extension
e]]

        -- those we should keep
        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

        -- (a,b) means a used to imply b, but has gone, so suggest enabling b
        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]
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 -> Module_ -> Bool
usedExt Extension
a Module_
x
            ]

        reason :: Extension -> String
reason x :: 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 a :: Extension
a -> "implied by " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Extension -> String
prettyExtension Extension
a
            Nothing -> "not used"

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

-- | Classes that can't require newtype deriving
noDeriveNewtype :: [String]
noDeriveNewtype =
    String -> [String] -> [String]
forall a. Eq a => a -> [a] -> [a]
delete "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]
deriveHaskell [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String]
deriveGenerics [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String]
deriveCategory


usedExt :: Extension -> Module_ -> Bool
usedExt :: Extension -> Module_ -> Bool
usedExt (EnableExtension x :: KnownExtension
x) = KnownExtension -> Module_ -> Bool
used KnownExtension
x
usedExt (UnknownExtension "NumDecimals") = (Literal SrcSpanInfo -> Bool) -> Module_ -> Bool
forall x (f :: * -> *).
(Data x, Data (f SrcSpanInfo)) =>
(f SrcSpanInfo -> Bool) -> x -> Bool
hasS Literal SrcSpanInfo -> Bool
isWholeFrac
usedExt (UnknownExtension "DeriveLift") = [String] -> Module_ -> Bool
hasDerive ["Lift"]
usedExt (UnknownExtension "DeriveAnyClass") = Bool -> Bool
not (Bool -> Bool) -> (Module_ -> Bool) -> Module_ -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null ([String] -> Bool) -> (Module_ -> [String]) -> Module_ -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Derives -> [String]
derivesAnyclass (Derives -> [String])
-> (Module_ -> Derives) -> Module_ -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Module_ -> Derives
derives
usedExt _ = Bool -> Module_ -> Bool
forall a b. a -> b -> a
const Bool
True


used :: KnownExtension -> Module_ -> Bool
used :: KnownExtension -> Module_ -> Bool
used RecursiveDo = (Exp SrcSpanInfo -> Bool) -> Module_ -> Bool
forall x (f :: * -> *).
(Data x, Data (f SrcSpanInfo)) =>
(f SrcSpanInfo -> Bool) -> x -> Bool
hasS Exp SrcSpanInfo -> Bool
forall l. Exp l -> Bool
isMDo (Module_ -> Bool) -> (Module_ -> Bool) -> Module_ -> Bool
forall (m :: * -> *). Monad m => m Bool -> m Bool -> m Bool
||^ (Stmt SrcSpanInfo -> Bool) -> Module_ -> Bool
forall x (f :: * -> *).
(Data x, Data (f SrcSpanInfo)) =>
(f SrcSpanInfo -> Bool) -> x -> Bool
hasS Stmt SrcSpanInfo -> Bool
forall l. Stmt l -> Bool
isRecStmt
used ParallelListComp = (Exp SrcSpanInfo -> Bool) -> Module_ -> Bool
forall x (f :: * -> *).
(Data x, Data (f SrcSpanInfo)) =>
(f SrcSpanInfo -> Bool) -> x -> Bool
hasS Exp SrcSpanInfo -> Bool
forall l. Exp l -> Bool
isParComp
used FunctionalDependencies = FunDep SrcSpanInfo -> Module_ -> Bool
forall from a. (Data from, Data a) => a -> from -> Bool
hasT (FunDep SrcSpanInfo
forall a. a
un :: FunDep S)
used ImplicitParams = IPName SrcSpanInfo -> Module_ -> Bool
forall from a. (Data from, Data a) => a -> from -> Bool
hasT (IPName SrcSpanInfo
forall a. a
un :: IPName S)
used TypeApplications = (Exp SrcSpanInfo -> Bool) -> Module_ -> Bool
forall x (f :: * -> *).
(Data x, Data (f SrcSpanInfo)) =>
(f SrcSpanInfo -> Bool) -> x -> Bool
hasS Exp SrcSpanInfo -> Bool
forall l. Exp l -> Bool
isTypeApp
used EmptyDataDecls = (Decl SrcSpanInfo -> Bool) -> Module_ -> Bool
forall x (f :: * -> *).
(Data x, Data (f SrcSpanInfo)) =>
(f SrcSpanInfo -> Bool) -> x -> Bool
hasS Decl SrcSpanInfo -> Bool
forall l. Decl l -> Bool
f
    where f :: Decl l -> Bool
f (DataDecl _ _ _ _ [] _) = Bool
True
          f (GDataDecl _ _ _ _ _ [] _) = Bool
True
          f _ = Bool
False
used EmptyCase = (Exp SrcSpanInfo -> Bool) -> Module_ -> Bool
forall x (f :: * -> *).
(Data x, Data (f SrcSpanInfo)) =>
(f SrcSpanInfo -> Bool) -> x -> Bool
hasS Exp SrcSpanInfo -> Bool
f
    where f :: Exp SrcSpanInfo -> Bool
f (Case _ _ []) = Bool
True
          f (LCase _ []) = Bool
True
          f (Exp SrcSpanInfo
_ :: Exp_) = Bool
False
used KindSignatures = Kind SrcSpanInfo -> Module_ -> Bool
forall from a. (Data from, Data a) => a -> from -> Bool
hasT (Kind SrcSpanInfo
forall a. a
un :: Kind S)
used BangPatterns = (Pat SrcSpanInfo -> Bool) -> Module_ -> Bool
forall x (f :: * -> *).
(Data x, Data (f SrcSpanInfo)) =>
(f SrcSpanInfo -> Bool) -> x -> Bool
hasS Pat SrcSpanInfo -> Bool
forall l. Pat l -> Bool
isPBangPat
used TemplateHaskell = (Bracket SrcSpanInfo, Splice SrcSpanInfo) -> Module_ -> Bool
forall from a a.
(Data from, Data a, Data a) =>
(a, a) -> from -> Bool
hasT2 ((Bracket SrcSpanInfo, Splice SrcSpanInfo)
forall a. a
un :: (Bracket S, Splice S)) (Module_ -> Bool) -> (Module_ -> Bool) -> Module_ -> Bool
forall (m :: * -> *). Monad m => m Bool -> m Bool -> m Bool
||^ (Exp SrcSpanInfo -> Bool) -> Module_ -> Bool
forall x (f :: * -> *).
(Data x, Data (f SrcSpanInfo)) =>
(f SrcSpanInfo -> Bool) -> x -> Bool
hasS Exp SrcSpanInfo -> Bool
forall l. Exp l -> Bool
f (Module_ -> Bool) -> (Module_ -> Bool) -> Module_ -> Bool
forall (m :: * -> *). Monad m => m Bool -> m Bool -> m Bool
||^ (Decl SrcSpanInfo -> Bool) -> Module_ -> Bool
forall x (f :: * -> *).
(Data x, Data (f SrcSpanInfo)) =>
(f SrcSpanInfo -> Bool) -> x -> Bool
hasS Decl SrcSpanInfo -> Bool
forall l. Decl l -> Bool
isSpliceDecl
    where f :: Exp l -> Bool
f VarQuote{} = Bool
True
          f TypQuote{} = Bool
True
          f _ = Bool
False
used ForeignFunctionInterface = CallConv SrcSpanInfo -> Module_ -> Bool
forall from a. (Data from, Data a) => a -> from -> Bool
hasT (CallConv SrcSpanInfo
forall a. a
un :: CallConv S)
used PatternGuards = (GuardedRhs SrcSpanInfo -> Bool) -> Module_ -> Bool
forall x (f :: * -> *).
(Data x, Data (f SrcSpanInfo)) =>
(f SrcSpanInfo -> Bool) -> x -> Bool
hasS GuardedRhs SrcSpanInfo -> Bool
forall l. GuardedRhs l -> Bool
f
    where f :: GuardedRhs l -> Bool
f (GuardedRhs _ xs :: [Stmt l]
xs _) = [Stmt l] -> Bool
forall l. [Stmt l] -> Bool
g [Stmt l]
xs
          g :: [Stmt l] -> Bool
g [] = Bool
False
          g [Qualifier{}] = Bool
False
          g _ = Bool
True
used StandaloneDeriving = (Decl SrcSpanInfo -> Bool) -> Module_ -> Bool
forall x (f :: * -> *).
(Data x, Data (f SrcSpanInfo)) =>
(f SrcSpanInfo -> Bool) -> x -> Bool
hasS Decl SrcSpanInfo -> Bool
forall l. Decl l -> Bool
isDerivDecl
used PatternSignatures = (Pat SrcSpanInfo -> Bool) -> Module_ -> Bool
forall x (f :: * -> *).
(Data x, Data (f SrcSpanInfo)) =>
(f SrcSpanInfo -> Bool) -> x -> Bool
hasS Pat SrcSpanInfo -> Bool
forall l. Pat l -> Bool
isPatTypeSig
used RecordWildCards = (PatField SrcSpanInfo -> Bool) -> Module_ -> Bool
forall x (f :: * -> *).
(Data x, Data (f SrcSpanInfo)) =>
(f SrcSpanInfo -> Bool) -> x -> Bool
hasS PatField SrcSpanInfo -> Bool
forall l. PatField l -> Bool
isPFieldWildcard (Module_ -> Bool) -> (Module_ -> Bool) -> Module_ -> Bool
forall (m :: * -> *). Monad m => m Bool -> m Bool -> m Bool
||^ (FieldUpdate SrcSpanInfo -> Bool) -> Module_ -> Bool
forall x (f :: * -> *).
(Data x, Data (f SrcSpanInfo)) =>
(f SrcSpanInfo -> Bool) -> x -> Bool
hasS FieldUpdate SrcSpanInfo -> Bool
forall l. FieldUpdate l -> Bool
isFieldWildcard
used RecordPuns = (PatField SrcSpanInfo -> Bool) -> Module_ -> Bool
forall x (f :: * -> *).
(Data x, Data (f SrcSpanInfo)) =>
(f SrcSpanInfo -> Bool) -> x -> Bool
hasS PatField SrcSpanInfo -> Bool
forall l. PatField l -> Bool
isPFieldPun (Module_ -> Bool) -> (Module_ -> Bool) -> Module_ -> Bool
forall (m :: * -> *). Monad m => m Bool -> m Bool -> m Bool
||^ (FieldUpdate SrcSpanInfo -> Bool) -> Module_ -> Bool
forall x (f :: * -> *).
(Data x, Data (f SrcSpanInfo)) =>
(f SrcSpanInfo -> Bool) -> x -> Bool
hasS FieldUpdate SrcSpanInfo -> Bool
forall l. FieldUpdate l -> Bool
isFieldPun
used UnboxedTuples = (Boxed -> Bool) -> Module_ -> Bool
forall from a. (Data from, Data a) => (a -> Bool) -> from -> Bool
has (Bool -> Bool
not (Bool -> Bool) -> (Boxed -> Bool) -> Boxed -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Boxed -> Bool
isBoxed)
used PackageImports = (ImportDecl SrcSpanInfo -> Bool) -> Module_ -> Bool
forall x (f :: * -> *).
(Data x, Data (f SrcSpanInfo)) =>
(f SrcSpanInfo -> Bool) -> x -> Bool
hasS (Maybe String -> Bool
forall a. Maybe a -> Bool
isJust (Maybe String -> Bool)
-> (ImportDecl SrcSpanInfo -> Maybe String)
-> ImportDecl SrcSpanInfo
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ImportDecl SrcSpanInfo -> Maybe String
forall l. ImportDecl l -> Maybe String
importPkg)
used QuasiQuotes = (Exp SrcSpanInfo -> Bool) -> Module_ -> Bool
forall x (f :: * -> *).
(Data x, Data (f SrcSpanInfo)) =>
(f SrcSpanInfo -> Bool) -> x -> Bool
hasS Exp SrcSpanInfo -> Bool
forall l. Exp l -> Bool
isQuasiQuote (Module_ -> Bool) -> (Module_ -> Bool) -> Module_ -> Bool
forall (m :: * -> *). Monad m => m Bool -> m Bool -> m Bool
||^ (Kind SrcSpanInfo -> Bool) -> Module_ -> Bool
forall x (f :: * -> *).
(Data x, Data (f SrcSpanInfo)) =>
(f SrcSpanInfo -> Bool) -> x -> Bool
hasS Kind SrcSpanInfo -> Bool
forall l. Type l -> Bool
isTyQuasiQuote
used ViewPatterns = (Pat SrcSpanInfo -> Bool) -> Module_ -> Bool
forall x (f :: * -> *).
(Data x, Data (f SrcSpanInfo)) =>
(f SrcSpanInfo -> Bool) -> x -> Bool
hasS Pat SrcSpanInfo -> Bool
forall l. Pat l -> Bool
isPViewPat
used DefaultSignatures = (ClassDecl SrcSpanInfo -> Bool) -> Module_ -> Bool
forall x (f :: * -> *).
(Data x, Data (f SrcSpanInfo)) =>
(f SrcSpanInfo -> Bool) -> x -> Bool
hasS ClassDecl SrcSpanInfo -> Bool
forall l. ClassDecl l -> Bool
isClsDefSig
used DeriveDataTypeable = [String] -> Module_ -> Bool
hasDerive ["Data","Typeable"]
used DeriveFunctor = [String] -> Module_ -> Bool
hasDerive ["Functor"]
used DeriveFoldable = [String] -> Module_ -> Bool
hasDerive ["Foldable"]
used DeriveTraversable = [String] -> Module_ -> Bool
hasDerive ["Traversable","Foldable","Functor"]
used DeriveGeneric = [String] -> Module_ -> Bool
hasDerive ["Generic","Generic1"]
used GeneralizedNewtypeDeriving = Bool -> Bool
not (Bool -> Bool) -> (Module_ -> Bool) -> Module_ -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null ([String] -> Bool) -> (Module_ -> [String]) -> Module_ -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Derives -> [String]
derivesNewtype (Derives -> [String])
-> (Module_ -> Derives) -> Module_ -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Module_ -> Derives
derives
used LambdaCase = (Exp SrcSpanInfo -> Bool) -> Module_ -> Bool
forall x (f :: * -> *).
(Data x, Data (f SrcSpanInfo)) =>
(f SrcSpanInfo -> Bool) -> x -> Bool
hasS Exp SrcSpanInfo -> Bool
forall l. Exp l -> Bool
isLCase
used TupleSections = (Exp SrcSpanInfo -> Bool) -> Module_ -> Bool
forall x (f :: * -> *).
(Data x, Data (f SrcSpanInfo)) =>
(f SrcSpanInfo -> Bool) -> x -> Bool
hasS Exp SrcSpanInfo -> Bool
forall l. Exp l -> Bool
isTupleSection
used OverloadedStrings = (Literal SrcSpanInfo -> Bool) -> Module_ -> Bool
forall x (f :: * -> *).
(Data x, Data (f SrcSpanInfo)) =>
(f SrcSpanInfo -> Bool) -> x -> Bool
hasS Literal SrcSpanInfo -> Bool
forall l. Literal l -> Bool
isString
used Arrows = (Exp SrcSpanInfo -> Bool) -> Module_ -> Bool
forall x (f :: * -> *).
(Data x, Data (f SrcSpanInfo)) =>
(f SrcSpanInfo -> Bool) -> x -> Bool
hasS Exp SrcSpanInfo -> Bool
forall l. Exp l -> Bool
f
    where f :: Exp l -> Bool
f Proc{} = Bool
True
          f LeftArrApp{} = Bool
True
          f RightArrApp{} = Bool
True
          f LeftArrHighApp{} = Bool
True
          f RightArrHighApp{} = Bool
True
          f _ = Bool
False
used TransformListComp = (QualStmt SrcSpanInfo -> Bool) -> Module_ -> Bool
forall x (f :: * -> *).
(Data x, Data (f SrcSpanInfo)) =>
(f SrcSpanInfo -> Bool) -> x -> Bool
hasS QualStmt SrcSpanInfo -> Bool
forall l. QualStmt l -> Bool
f
    where f :: QualStmt l -> Bool
f QualStmt{} = Bool
False
          f _ = Bool
True
used MagicHash = (Name SrcSpanInfo -> Bool) -> Module_ -> Bool
forall x (f :: * -> *).
(Data x, Data (f SrcSpanInfo)) =>
(f SrcSpanInfo -> Bool) -> x -> Bool
hasS Name SrcSpanInfo -> Bool
forall l. Name l -> Bool
f (Module_ -> Bool) -> (Module_ -> Bool) -> Module_ -> Bool
forall (m :: * -> *). Monad m => m Bool -> m Bool -> m Bool
||^ (Literal SrcSpanInfo -> Bool) -> Module_ -> Bool
forall x (f :: * -> *).
(Data x, Data (f SrcSpanInfo)) =>
(f SrcSpanInfo -> Bool) -> x -> Bool
hasS Literal SrcSpanInfo -> Bool
forall l. Literal l -> Bool
isPrimLiteral
    where f :: Name l -> Bool
f (Ident _ s :: String
s) = "#" String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isSuffixOf` String
s
          f _ = Bool
False

-- for forwards compatibility, if things ever get added to the extension enumeration
used x :: KnownExtension
x = Extension -> Module_ -> Bool
usedExt (Extension -> Module_ -> Bool) -> Extension -> Module_ -> Bool
forall a b. (a -> b) -> a -> b
$ String -> Extension
UnknownExtension (String -> Extension) -> String -> Extension
forall a b. (a -> b) -> a -> b
$ KnownExtension -> String
forall a. Show a => a -> String
show KnownExtension
x


hasDerive :: [String] -> Module_ -> Bool
hasDerive :: [String] -> Module_ -> Bool
hasDerive want :: [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) -> (Module_ -> [String]) -> Module_ -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Derives -> [String]
derivesStock (Derives -> [String])
-> (Module_ -> Derives) -> Module_ -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Module_ -> 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 x1 :: [String]
x1 x2 :: [String]
x2 x3 :: [String]
x3 <> :: Derives -> Derives -> Derives
<> Derives y1 :: [String]
y1 y2 :: [String]
y2 y3 :: [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 (DataOrNew S) -> Maybe (DerivStrategy S) -> [String] -> Derives
addDerives :: Maybe (DataOrNew SrcSpanInfo)
-> Maybe (DerivStrategy SrcSpanInfo) -> [String] -> Derives
addDerives _ (Just s :: DerivStrategy SrcSpanInfo
s) xs :: [String]
xs = case DerivStrategy SrcSpanInfo
s of
    DerivStock{} -> Derives
forall a. Monoid a => a
mempty{derivesStock :: [String]
derivesStock = [String]
xs}
    DerivAnyclass{} -> Derives
forall a. Monoid a => a
mempty{derivesAnyclass :: [String]
derivesAnyclass = [String]
xs}
    DerivNewtype{} -> Derives
forall a. Monoid a => a
mempty{derivesNewtype :: [String]
derivesNewtype = [String]
xs}
    DerivVia{} -> Derives
forall a. Monoid a => a
mempty
addDerives nt :: Maybe (DataOrNew SrcSpanInfo)
nt _ xs :: [String]
xs = Derives
forall a. Monoid a => a
mempty
    {derivesStock :: [String]
derivesStock = [String]
stock
    ,derivesAnyclass :: [String]
derivesAnyclass = [String]
other
    ,derivesNewtype :: [String]
derivesNewtype = if Bool
-> (DataOrNew SrcSpanInfo -> Bool)
-> Maybe (DataOrNew SrcSpanInfo)
-> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
True DataOrNew SrcSpanInfo -> Bool
forall l. DataOrNew l -> Bool
isNewType Maybe (DataOrNew SrcSpanInfo)
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 (stock :: [String]
stock, other :: [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


-- | What is derived on newtype, and on data type
--   'deriving' declarations may be on either, so we approximate as both newtype and data
derives :: Module_ -> Derives
derives :: Module_ -> Derives
derives m :: Module_
m = [Derives] -> Derives
forall a. Monoid a => [a] -> a
mconcat ([Derives] -> Derives) -> [Derives] -> Derives
forall a b. (a -> b) -> a -> b
$ (Decl SrcSpanInfo -> Derives) -> [Decl SrcSpanInfo] -> [Derives]
forall a b. (a -> b) -> [a] -> [b]
map Decl SrcSpanInfo -> Derives
decl (Module_ -> [Decl SrcSpanInfo]
forall from to. Biplate from to => from -> [to]
childrenBi Module_
m) [Derives] -> [Derives] -> [Derives]
forall a. [a] -> [a] -> [a]
++ (InstDecl SrcSpanInfo -> Derives)
-> [InstDecl SrcSpanInfo] -> [Derives]
forall a b. (a -> b) -> [a] -> [b]
map InstDecl SrcSpanInfo -> Derives
idecl (Module_ -> [InstDecl SrcSpanInfo]
forall from to. Biplate from to => from -> [to]
childrenBi Module_
m)
    where
        idecl :: InstDecl S -> Derives
        idecl :: InstDecl SrcSpanInfo -> Derives
idecl (InsData _ dn :: DataOrNew SrcSpanInfo
dn _ _ ds :: [Deriving SrcSpanInfo]
ds) = DataOrNew SrcSpanInfo -> [Deriving SrcSpanInfo] -> Derives
g DataOrNew SrcSpanInfo
dn [Deriving SrcSpanInfo]
ds
        idecl (InsGData _ dn :: DataOrNew SrcSpanInfo
dn _ _ _ ds :: [Deriving SrcSpanInfo]
ds) = DataOrNew SrcSpanInfo -> [Deriving SrcSpanInfo] -> Derives
g DataOrNew SrcSpanInfo
dn [Deriving SrcSpanInfo]
ds
        idecl _ = Derives
forall a. Monoid a => a
mempty

        decl :: Decl_ -> Derives
        decl :: Decl SrcSpanInfo -> Derives
decl (DataDecl _ dn :: DataOrNew SrcSpanInfo
dn _ _ _ ds :: [Deriving SrcSpanInfo]
ds) = DataOrNew SrcSpanInfo -> [Deriving SrcSpanInfo] -> Derives
g DataOrNew SrcSpanInfo
dn [Deriving SrcSpanInfo]
ds
        decl (GDataDecl _ dn :: DataOrNew SrcSpanInfo
dn _ _ _ _ ds :: [Deriving SrcSpanInfo]
ds) = DataOrNew SrcSpanInfo -> [Deriving SrcSpanInfo] -> Derives
g DataOrNew SrcSpanInfo
dn [Deriving SrcSpanInfo]
ds
        decl (DataInsDecl _ dn :: DataOrNew SrcSpanInfo
dn _ _ ds :: [Deriving SrcSpanInfo]
ds) = DataOrNew SrcSpanInfo -> [Deriving SrcSpanInfo] -> Derives
g DataOrNew SrcSpanInfo
dn [Deriving SrcSpanInfo]
ds
        decl (GDataInsDecl _ dn :: DataOrNew SrcSpanInfo
dn _ _ _ ds :: [Deriving SrcSpanInfo]
ds) = DataOrNew SrcSpanInfo -> [Deriving SrcSpanInfo] -> Derives
g DataOrNew SrcSpanInfo
dn [Deriving SrcSpanInfo]
ds
        decl (DerivDecl _ strategy :: Maybe (DerivStrategy SrcSpanInfo)
strategy _ hd :: InstRule SrcSpanInfo
hd) = Maybe (DataOrNew SrcSpanInfo)
-> Maybe (DerivStrategy SrcSpanInfo) -> [String] -> Derives
addDerives Maybe (DataOrNew SrcSpanInfo)
forall a. Maybe a
Nothing Maybe (DerivStrategy SrcSpanInfo)
strategy [InstRule SrcSpanInfo -> String
ir InstRule SrcSpanInfo
hd]
        decl _ = Derives
forall a. Monoid a => a
mempty

        g :: DataOrNew SrcSpanInfo -> [Deriving SrcSpanInfo] -> Derives
g dn :: DataOrNew SrcSpanInfo
dn ds :: [Deriving SrcSpanInfo]
ds = [Derives] -> Derives
forall a. Monoid a => [a] -> a
mconcat [Maybe (DataOrNew SrcSpanInfo)
-> Maybe (DerivStrategy SrcSpanInfo) -> [String] -> Derives
addDerives (DataOrNew SrcSpanInfo -> Maybe (DataOrNew SrcSpanInfo)
forall a. a -> Maybe a
Just DataOrNew SrcSpanInfo
dn) Maybe (DerivStrategy SrcSpanInfo)
strategy ([String] -> Derives) -> [String] -> Derives
forall a b. (a -> b) -> a -> b
$ (InstRule SrcSpanInfo -> String)
-> [InstRule SrcSpanInfo] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map InstRule SrcSpanInfo -> String
ir [InstRule SrcSpanInfo]
rules | Deriving _ strategy :: Maybe (DerivStrategy SrcSpanInfo)
strategy rules :: [InstRule SrcSpanInfo]
rules <- [Deriving SrcSpanInfo]
ds]

        ir :: InstRule SrcSpanInfo -> String
ir (IRule _ _ _ x :: InstHead SrcSpanInfo
x) = InstHead SrcSpanInfo -> String
ih InstHead SrcSpanInfo
x
        ir (IParen _ x :: InstRule SrcSpanInfo
x) = InstRule SrcSpanInfo -> String
ir InstRule SrcSpanInfo
x

        ih :: InstHead SrcSpanInfo -> String
ih (IHCon _ a :: QName SrcSpanInfo
a) = QName SrcSpanInfo -> String
forall a. Pretty a => a -> String
prettyPrint (QName SrcSpanInfo -> String) -> QName SrcSpanInfo -> String
forall a b. (a -> b) -> a -> b
$ QName SrcSpanInfo -> QName SrcSpanInfo
unqual QName SrcSpanInfo
a
        ih (IHInfix _ _ a :: QName SrcSpanInfo
a) = QName SrcSpanInfo -> String
forall a. Pretty a => a -> String
prettyPrint (QName SrcSpanInfo -> String) -> QName SrcSpanInfo -> String
forall a b. (a -> b) -> a -> b
$ QName SrcSpanInfo -> QName SrcSpanInfo
unqual QName SrcSpanInfo
a
        ih (IHParen _ a :: InstHead SrcSpanInfo
a) = InstHead SrcSpanInfo -> String
ih InstHead SrcSpanInfo
a
        ih (IHApp _ a :: InstHead SrcSpanInfo
a _) = InstHead SrcSpanInfo -> String
ih InstHead SrcSpanInfo
a

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

hasT :: a -> from -> Bool
hasT t :: a
t x :: 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 ~(t1 :: a
t1,t2 :: 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 (f S)) => (f S -> Bool) -> x -> Bool
hasS :: (f SrcSpanInfo -> Bool) -> x -> Bool
hasS test :: f SrcSpanInfo -> Bool
test = (f SrcSpanInfo -> Bool) -> [f SrcSpanInfo] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any f SrcSpanInfo -> Bool
test ([f SrcSpanInfo] -> Bool) -> (x -> [f SrcSpanInfo]) -> x -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. x -> [f SrcSpanInfo]
forall from to. Biplate from to => from -> [to]
universeBi

has :: (a -> Bool) -> from -> Bool
has f :: a -> Bool
f = (a -> Bool) -> [a] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any a -> Bool
f ([a] -> Bool) -> (from -> [a]) -> from -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. from -> [a]
forall from to. Biplate from to => from -> [to]
universeBi

-- Only whole number fractions are permitted by NumDecimals extension.
-- Anything not-whole raises an error.
isWholeFrac :: Literal S -> Bool
isWholeFrac :: Literal SrcSpanInfo -> Bool
isWholeFrac (Frac _ v :: Rational
v _) = Rational -> Integer
forall a. Ratio a -> a
denominator Rational
v Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== 1
isWholeFrac _ = Bool
False