module Hint.Extensions where
import Hint.Type
import Data.Maybe
import Data.List
import Util
extensionsHint :: ModuHint
extensionsHint _ x = [rawIdea Error "Unused LANGUAGE pragma" (toSrcLoc sl)
(prettyPrint o) (if null new then "" else prettyPrint $ LanguagePragma sl $ map (toNamed . showExt) new)
| not $ used TemplateHaskell x
, o@(LanguagePragma sl exts) <- modulePragmas x
, let old = map (classifyExtension . prettyPrint) exts
, let new = minimalExtensions x old
, sort new /= sort old]
where
showExt (UnknownExtension x) = x
showExt x = show x
minimalExtensions :: Module_ -> [Extension] -> [Extension]
minimalExtensions x es = nub $ concatMap f es
where f e = if used e x then [e] else concatMap f $ implies e
implies :: Extension -> [Extension]
implies RecordWildCards = [DisambiguateRecordFields]
implies _ = []
used :: Extension -> Module_ -> Bool
used RecursiveDo = hasS isMDo
used ParallelListComp = hasS isParComp
used FunctionalDependencies = hasT (un :: FunDep S)
used ImplicitParams = hasT (un :: IPName S)
used EmptyDataDecls = hasS f
where f (DataDecl _ _ _ _ [] _) = True
f (GDataDecl _ _ _ _ _ [] _) = True
f _ = False
used KindSignatures = hasT (un :: Kind S)
used BangPatterns = hasS isPBangPat
used TemplateHaskell = hasT2 (un :: (Bracket S, Splice S)) & hasS f
where f VarQuote{} = True
f TypQuote{} = True
f _ = False
used ForeignFunctionInterface = hasT (un :: CallConv S)
used Generics = hasS isPExplTypeArg
used PatternGuards = hasS f1 & hasS f2
where f1 (GuardedRhs _ xs _) = g xs
f2 (GuardedAlt _ xs _) = g xs
g [] = False
g [Qualifier{}] = False
g _ = True
used StandaloneDeriving = hasS isDerivDecl
used PatternSignatures = hasS isPatTypeSig
used RecordWildCards = hasS isPFieldWildcard & hasS isFieldWildcard
used RecordPuns = hasS isPFieldPun & hasS isFieldPun
used UnboxedTuples = has isBoxed
used PackageImports = hasS (isJust . importPkg)
used QuasiQuotes = hasS isQuasiQuote
used ViewPatterns = hasS isPViewPat
used Arrows = hasS f
where f Proc{} = True
f LeftArrApp{} = True
f RightArrApp{} = True
f LeftArrHighApp{} = True
f RightArrHighApp{} = True
f _ = False
used TransformListComp = hasS f
where f QualStmt{} = False
f _ = True
used _ = const True
un = undefined
(&) f g x = f x || g x
hasT t x = notNull (universeBi x `asTypeOf` [t])
hasT2 ~(t1,t2) = hasT t1 & hasT t2
hasS :: Biplate x (f S) => (f S -> Bool) -> x -> Bool
hasS test = any test . universeBi
has f = any f . universeBi