{-# LANGUAGE 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 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 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 UnboxedTuples #-} \
f x = case x of (# a, b #) -> a
{-# LANGUAGE GeneralizedNewtypeDeriving,UnboxedTuples #-} \
newtype T m a = T (m a) deriving (PrimMonad)
{-# 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(ModuHint, rawIdea',Severity(Warning),Note(..),toSS',ghcAnnotations,ghcModule,extensionImpliedBy,extensionImplies)
import Language.Haskell.Exts.Extension

import Data.Generics.Uniplate.Operations
import Control.Monad.Extra
import Data.List.Extra
import Data.Ratio
import Data.Data
import Refact.Types
import qualified Data.Set as Set
import qualified Data.Map as Map

import SrcLoc
import HsSyn
import BasicTypes
import Class
import RdrName
import OccName
import ForeignCall
import GHC.Util
import Language.Haskell.GhclibParserEx.GHC.Hs.Expr

extensionsHint :: ModuHint
extensionsHint :: ModuHint
extensionsHint _ x :: ModuleEx
x =
    [ Severity
-> String
-> SrcSpan
-> String
-> Maybe String
-> [Note]
-> [Refactoring SrcSpan]
-> Idea
rawIdea' Severity
Hint.Type.Warning "Unused LANGUAGE pragma"
        SrcSpan
sl
        (Located AnnotationComment -> String
comment (SrcSpan -> [String] -> Located AnnotationComment
mkLangExts SrcSpan
sl [String]
exts))
        (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 (Located AnnotationComment -> SrcSpan
forall e. HasSrcSpan e => e -> SrcSpan
toSS' (SrcSpan -> [String] -> Located AnnotationComment
mkLangExts SrcSpan
sl [String]
exts)) String
newPragma]
    | (LL sl :: SrcSpan
sl _,  exts :: [String]
exts) <- [(Located AnnotationComment, String)]
-> [(Located AnnotationComment, [String])]
langExts ([(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 :: [Extension]
before = (String -> Extension) -> [String] -> [Extension]
forall a b. (a -> b) -> [a] -> [b]
map String -> Extension
parseExtension [String]
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 Located AnnotationComment -> String
comment (SrcSpan -> [String] -> Located AnnotationComment
mkLangExts SrcSpan
sl ([String] -> Located AnnotationComment)
-> [String] -> Located AnnotationComment
forall a b. (a -> b) -> a -> b
$ (Extension -> String) -> [Extension] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map Extension -> String
prettyExtension [Extension]
after)
    ]
  where
    usedTH :: Bool
    usedTH :: Bool
usedTH = KnownExtension -> Located (HsModule GhcPs) -> Bool
used KnownExtension
TemplateHaskell (ModuleEx -> Located (HsModule GhcPs)
ghcModule ModuleEx
x) Bool -> Bool -> Bool
|| KnownExtension -> Located (HsModule GhcPs) -> Bool
used KnownExtension
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 = [Extension] -> Set Extension
forall a. Ord a => [a] -> Set a
Set.fromList [ String -> Extension
parseExtension String
e
                              | let exts :: [String]
exts = ((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])]
langExts (ApiAnns -> [(Located AnnotationComment, String)]
pragmas (ModuleEx -> ApiAnns
ghcAnnotations ModuleEx
x))
                              , String
e <- [String]
exts ]
    -- 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 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 = [(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.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 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 -> Located (HsModule GhcPs) -> Bool
usedExt Extension
a (ModuleEx -> Located (HsModule GhcPs)
ghcModule ModuleEx
x)
        ]
    reason :: Extension -> String
    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]
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 GhcPs) -> Bool
usedExt :: Extension -> Located (HsModule GhcPs) -> Bool
usedExt (EnableExtension x :: KnownExtension
x) = KnownExtension -> Located (HsModule GhcPs) -> Bool
used KnownExtension
x
usedExt (UnknownExtension "NumDecimals") = (HsExpr GhcPs -> Bool) -> Located (HsModule GhcPs) -> Bool
forall x a. (Data x, Data a) => (a -> Bool) -> x -> Bool
hasS HsExpr GhcPs -> Bool
isWholeFrac
usedExt (UnknownExtension "DeriveLift") = [String] -> Located (HsModule GhcPs) -> Bool
hasDerive ["Lift"]
usedExt (UnknownExtension "DeriveAnyClass") = Bool -> Bool
not (Bool -> Bool)
-> (Located (HsModule GhcPs) -> Bool)
-> Located (HsModule GhcPs)
-> 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 GhcPs) -> [String])
-> Located (HsModule GhcPs)
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Derives -> [String]
derivesAnyclass (Derives -> [String])
-> (Located (HsModule GhcPs) -> Derives)
-> Located (HsModule GhcPs)
-> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Located (HsModule GhcPs) -> Derives
derives
usedExt _ = Bool -> Located (HsModule GhcPs) -> Bool
forall a b. a -> b -> a
const Bool
True

used :: KnownExtension -> Located (HsModule GhcPs) -> Bool
used :: KnownExtension -> Located (HsModule GhcPs) -> Bool
used RecursiveDo = (HsStmtContext Name -> Bool) -> Located (HsModule GhcPs) -> Bool
forall x a. (Data x, Data a) => (a -> Bool) -> x -> Bool
hasS HsStmtContext Name -> Bool
isMDo (Located (HsModule GhcPs) -> Bool)
-> (Located (HsModule GhcPs) -> Bool)
-> Located (HsModule GhcPs)
-> Bool
forall (m :: * -> *). Monad m => m Bool -> m Bool -> m Bool
||^ (StmtLR GhcPs GhcPs (LHsExpr GhcPs) -> Bool)
-> Located (HsModule GhcPs) -> Bool
forall x a. (Data x, Data a) => (a -> Bool) -> x -> Bool
hasS StmtLR GhcPs GhcPs (LHsExpr GhcPs) -> Bool
isRecStmt
used ParallelListComp = (StmtLR GhcPs GhcPs (LHsExpr GhcPs) -> Bool)
-> Located (HsModule GhcPs) -> Bool
forall x a. (Data x, Data a) => (a -> Bool) -> x -> Bool
hasS StmtLR GhcPs GhcPs (LHsExpr GhcPs) -> Bool
isParComp
used FunctionalDependencies = FunDep (Located RdrName) -> Located (HsModule GhcPs) -> Bool
forall from a. (Data from, Data a) => a -> from -> Bool
hasT (FunDep (Located RdrName)
forall a. a
un :: FunDep (Located RdrName))
used ImplicitParams = HsIPName -> Located (HsModule GhcPs) -> Bool
forall from a. (Data from, Data a) => a -> from -> Bool
hasT (HsIPName
forall a. a
un :: HsIPName)
used TypeApplications = (LHsExpr GhcPs -> Bool) -> Located (HsModule GhcPs) -> Bool
forall x a. (Data x, Data a) => (a -> Bool) -> x -> Bool
hasS LHsExpr GhcPs -> Bool
isTypeApp
used EmptyDataDecls = (HsDataDefn GhcPs -> Bool) -> Located (HsModule GhcPs) -> 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 _ _ _ _ _ [] _) = Bool
True
    f _ = Bool
False
used EmptyCase = (HsExpr GhcPs -> Bool) -> Located (HsModule GhcPs) -> 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 _ _ (MG _ (LL _ []) _)) = Bool
True
    f (HsLamCase _ (MG _ (LL _ []) _)) = Bool
True
    f _ = Bool
False
used KindSignatures = HsKind GhcPs -> Located (HsModule GhcPs) -> Bool
forall from a. (Data from, Data a) => a -> from -> Bool
hasT (HsKind GhcPs
forall a. a
un :: HsKind GhcPs)
used BangPatterns = (Pat GhcPs -> Bool) -> Located (HsModule GhcPs) -> Bool
forall x a. (Data x, Data a) => (a -> Bool) -> x -> Bool
hasS Pat GhcPs -> Bool
isPBangPat' (Located (HsModule GhcPs) -> Bool)
-> (Located (HsModule GhcPs) -> Bool)
-> Located (HsModule GhcPs)
-> Bool
forall (m :: * -> *). Monad m => m Bool -> m Bool -> m Bool
||^ (HsMatchContext RdrName -> Bool)
-> Located (HsModule GhcPs) -> Bool
forall x a. (Data x, Data a) => (a -> Bool) -> x -> Bool
hasS HsMatchContext RdrName -> Bool
isStrictMatch
  where
    isStrictMatch :: HsMatchContext RdrName -> Bool
    isStrictMatch :: HsMatchContext RdrName -> Bool
isStrictMatch FunRhs{mc_strictness :: forall id. HsMatchContext id -> SrcStrictness
mc_strictness=SrcStrictness
SrcStrict} = Bool
True
    isStrictMatch _ = Bool
False
used TemplateHaskell = (HsBracket GhcPs, HsSplice GhcPs)
-> Located (HsModule GhcPs) -> 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 GhcPs) -> Bool)
-> (Located (HsModule GhcPs) -> Bool)
-> Located (HsModule GhcPs)
-> Bool
forall (m :: * -> *). Monad m => m Bool -> m Bool -> m Bool
||^ (HsBracket GhcPs -> Bool) -> Located (HsModule GhcPs) -> Bool
forall x a. (Data x, Data a) => (a -> Bool) -> x -> Bool
hasS HsBracket GhcPs -> Bool
f (Located (HsModule GhcPs) -> Bool)
-> (Located (HsModule GhcPs) -> Bool)
-> Located (HsModule GhcPs)
-> Bool
forall (m :: * -> *). Monad m => m Bool -> m Bool -> m Bool
||^ (HsExpr GhcPs -> Bool) -> Located (HsModule GhcPs) -> 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 _ = Bool
False
used ForeignFunctionInterface = CCallConv -> Located (HsModule GhcPs) -> Bool
forall from a. (Data from, Data a) => a -> from -> Bool
hasT (CCallConv
forall a. a
un :: CCallConv)
used PatternGuards = (GRHS GhcPs (LHsExpr GhcPs) -> Bool)
-> Located (HsModule GhcPs) -> 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 _ xs :: [GuardLStmt GhcPs]
xs _) = [GuardLStmt GhcPs] -> Bool
g [GuardLStmt GhcPs]
xs
    f _ = Bool
False -- new ctor
    g :: [GuardLStmt GhcPs] -> Bool
    g :: [GuardLStmt GhcPs] -> Bool
g [] = Bool
False
    g [LL _ BodyStmt{}] = Bool
False
    g _ = Bool
True
used StandaloneDeriving = (LHsDecl GhcPs -> Bool) -> Located (HsModule GhcPs) -> Bool
forall x a. (Data x, Data a) => (a -> Bool) -> x -> Bool
hasS LHsDecl GhcPs -> Bool
isDerivD'
used PatternSignatures = (Pat GhcPs -> Bool) -> Located (HsModule GhcPs) -> Bool
forall x a. (Data x, Data a) => (a -> Bool) -> x -> Bool
hasS Pat GhcPs -> Bool
isPatTypeSig'
used RecordWildCards = (HsRecFields GhcPs (LHsExpr GhcPs) -> Bool)
-> Located (HsModule GhcPs) -> Bool
forall x a. (Data x, Data a) => (a -> Bool) -> x -> Bool
hasS HsRecFields GhcPs (LHsExpr GhcPs) -> Bool
hasFieldsDotDot (Located (HsModule GhcPs) -> Bool)
-> (Located (HsModule GhcPs) -> Bool)
-> Located (HsModule GhcPs)
-> Bool
forall (m :: * -> *). Monad m => m Bool -> m Bool -> m Bool
||^ (HsRecFields GhcPs (Pat GhcPs) -> Bool)
-> Located (HsModule GhcPs) -> Bool
forall x a. (Data x, Data a) => (a -> Bool) -> x -> Bool
hasS HsRecFields GhcPs (Pat GhcPs) -> Bool
hasPFieldsDotDot'
used RecordPuns = (LHsRecField GhcPs (Pat GhcPs) -> Bool)
-> Located (HsModule GhcPs) -> Bool
forall x a. (Data x, Data a) => (a -> Bool) -> x -> Bool
hasS LHsRecField GhcPs (Pat GhcPs) -> Bool
isPFieldPun' (Located (HsModule GhcPs) -> Bool)
-> (Located (HsModule GhcPs) -> Bool)
-> Located (HsModule GhcPs)
-> Bool
forall (m :: * -> *). Monad m => m Bool -> m Bool -> m Bool
||^ (LHsRecField GhcPs (LHsExpr GhcPs) -> Bool)
-> Located (HsModule GhcPs) -> Bool
forall x a. (Data x, Data a) => (a -> Bool) -> x -> Bool
hasS LHsRecField GhcPs (LHsExpr GhcPs) -> Bool
isFieldPun
used NamedFieldPuns = (LHsRecField GhcPs (Pat GhcPs) -> Bool)
-> Located (HsModule GhcPs) -> Bool
forall x a. (Data x, Data a) => (a -> Bool) -> x -> Bool
hasS LHsRecField GhcPs (Pat GhcPs) -> Bool
isPFieldPun' (Located (HsModule GhcPs) -> Bool)
-> (Located (HsModule GhcPs) -> Bool)
-> Located (HsModule GhcPs)
-> Bool
forall (m :: * -> *). Monad m => m Bool -> m Bool -> m Bool
||^ (LHsRecField GhcPs (LHsExpr GhcPs) -> Bool)
-> Located (HsModule GhcPs) -> Bool
forall x a. (Data x, Data a) => (a -> Bool) -> x -> Bool
hasS LHsRecField GhcPs (LHsExpr GhcPs) -> Bool
isFieldPun
used UnboxedTuples = (HsTupleSort -> Bool) -> Located (HsModule GhcPs) -> Bool
forall x a. (Data x, Data a) => (a -> Bool) -> x -> Bool
has HsTupleSort -> Bool
isUnboxedTuple' (Located (HsModule GhcPs) -> Bool)
-> (Located (HsModule GhcPs) -> Bool)
-> Located (HsModule GhcPs)
-> Bool
forall (m :: * -> *). Monad m => m Bool -> m Bool -> m Bool
||^ (Boxity -> Bool) -> Located (HsModule GhcPs) -> Bool
forall x a. (Data x, Data a) => (a -> Bool) -> x -> Bool
has (Boxity -> Boxity -> Bool
forall a. Eq a => a -> a -> Bool
== Boxity
Unboxed) (Located (HsModule GhcPs) -> Bool)
-> (Located (HsModule GhcPs) -> Bool)
-> Located (HsModule GhcPs)
-> Bool
forall (m :: * -> *). Monad m => m Bool -> m Bool -> m Bool
||^ (Maybe (LDerivStrategy GhcPs) -> Bool)
-> Located (HsModule GhcPs) -> 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 _ = Bool
True
used PackageImports = (ImportDecl GhcPs -> Bool) -> Located (HsModule GhcPs) -> 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 _} = Bool
True
        f _ = Bool
False
used QuasiQuotes = (LHsExpr GhcPs -> Bool) -> Located (HsModule GhcPs) -> Bool
forall x a. (Data x, Data a) => (a -> Bool) -> x -> Bool
hasS LHsExpr GhcPs -> Bool
isQuasiQuote (Located (HsModule GhcPs) -> Bool)
-> (Located (HsModule GhcPs) -> Bool)
-> Located (HsModule GhcPs)
-> Bool
forall (m :: * -> *). Monad m => m Bool -> m Bool -> m Bool
||^ (LHsType GhcPs -> Bool) -> Located (HsModule GhcPs) -> Bool
forall x a. (Data x, Data a) => (a -> Bool) -> x -> Bool
hasS LHsType GhcPs -> Bool
isTyQuasiQuote'
used ViewPatterns = (Pat GhcPs -> Bool) -> Located (HsModule GhcPs) -> Bool
forall x a. (Data x, Data a) => (a -> Bool) -> x -> Bool
hasS Pat GhcPs -> Bool
isPViewPat'
used DefaultSignatures = (Sig GhcPs -> Bool) -> Located (HsModule GhcPs) -> Bool
forall x a. (Data x, Data a) => (a -> Bool) -> x -> Bool
hasS Sig GhcPs -> Bool
isClsDefSig'
used DeriveDataTypeable = [String] -> Located (HsModule GhcPs) -> Bool
hasDerive ["Data","Typeable"]
used DeriveFunctor = [String] -> Located (HsModule GhcPs) -> Bool
hasDerive ["Functor"]
used DeriveFoldable = [String] -> Located (HsModule GhcPs) -> Bool
hasDerive ["Foldable"]
used DeriveTraversable = [String] -> Located (HsModule GhcPs) -> Bool
hasDerive ["Traversable","Foldable","Functor"]
used DeriveGeneric = [String] -> Located (HsModule GhcPs) -> Bool
hasDerive ["Generic","Generic1"]
used GeneralizedNewtypeDeriving = Bool -> Bool
not (Bool -> Bool)
-> (Located (HsModule GhcPs) -> Bool)
-> Located (HsModule GhcPs)
-> 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 GhcPs) -> [String])
-> Located (HsModule GhcPs)
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Derives -> [String]
derivesNewtype' (Derives -> [String])
-> (Located (HsModule GhcPs) -> Derives)
-> Located (HsModule GhcPs)
-> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Located (HsModule GhcPs) -> Derives
derives
used LambdaCase = (LHsExpr GhcPs -> Bool) -> Located (HsModule GhcPs) -> Bool
forall x a. (Data x, Data a) => (a -> Bool) -> x -> Bool
hasS LHsExpr GhcPs -> Bool
isLCase
used TupleSections = (HsTupArg GhcPs -> Bool) -> Located (HsModule GhcPs) -> Bool
forall x a. (Data x, Data a) => (a -> Bool) -> x -> Bool
hasS HsTupArg GhcPs -> Bool
isTupleSection
used OverloadedStrings = (HsLit GhcPs -> Bool) -> Located (HsModule GhcPs) -> Bool
forall x a. (Data x, Data a) => (a -> Bool) -> x -> Bool
hasS HsLit GhcPs -> Bool
isString
used Arrows = (HsExpr GhcPs -> Bool) -> Located (HsModule GhcPs) -> 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 HsProc{} = Bool
True
    f HsArrApp{} = Bool
True
    f _ = Bool
False
used TransformListComp = (StmtLR GhcPs GhcPs (LHsExpr GhcPs) -> Bool)
-> Located (HsModule GhcPs) -> Bool
forall x a. (Data x, Data a) => (a -> Bool) -> x -> Bool
hasS StmtLR GhcPs GhcPs (LHsExpr GhcPs) -> Bool
f
    where
      f :: StmtLR GhcPs GhcPs (LHsExpr GhcPs) -> Bool
      f :: StmtLR GhcPs GhcPs (LHsExpr GhcPs) -> Bool
f TransStmt{} = Bool
True
      f _ = Bool
False
used MagicHash = (RdrName -> Bool) -> Located (HsModule GhcPs) -> Bool
forall x a. (Data x, Data a) => (a -> Bool) -> x -> Bool
hasS RdrName -> Bool
f (Located (HsModule GhcPs) -> Bool)
-> (Located (HsModule GhcPs) -> Bool)
-> Located (HsModule GhcPs)
-> Bool
forall (m :: * -> *). Monad m => m Bool -> m Bool -> m Bool
||^ (HsLit GhcPs -> Bool) -> Located (HsModule GhcPs) -> 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 s :: RdrName
s = "#" String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isSuffixOf` (OccName -> String
occNameString (OccName -> String) -> (RdrName -> OccName) -> RdrName -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RdrName -> OccName
rdrNameOcc) RdrName
s
-- For forwards compatibility, if things ever get added to the
-- extension enumeration.
used x :: KnownExtension
x = Extension -> Located (HsModule GhcPs) -> Bool
usedExt (Extension -> Located (HsModule GhcPs) -> Bool)
-> Extension -> Located (HsModule GhcPs) -> 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] -> Located (HsModule GhcPs) -> Bool
hasDerive :: [String] -> Located (HsModule GhcPs) -> 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)
-> (Located (HsModule GhcPs) -> [String])
-> Located (HsModule GhcPs)
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Derives -> [String]
derivesStock' (Derives -> [String])
-> (Located (HsModule GhcPs) -> Derives)
-> Located (HsModule GhcPs)
-> [String]
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 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 NewOrData -> Maybe (DerivStrategy GhcPs) -> [String] -> Derives
addDerives :: Maybe NewOrData
-> Maybe (DerivStrategy GhcPs) -> [String] -> Derives
addDerives _ (Just s :: DerivStrategy GhcPs
s) xs :: [String]
xs = case DerivStrategy GhcPs
s of
    StockStrategy -> Derives
forall a. Monoid a => a
mempty{derivesStock' :: [String]
derivesStock' = [String]
xs}
    AnyclassStrategy -> Derives
forall a. Monoid a => a
mempty{derivesAnyclass :: [String]
derivesAnyclass = [String]
xs}
    NewtypeStrategy -> Derives
forall a. Monoid a => a
mempty{derivesNewtype' :: [String]
derivesNewtype' = [String]
xs}
    ViaStrategy{} -> Derives
forall a. Monoid a => a
mempty
addDerives nt :: Maybe NewOrData
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 -> (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 (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

derives :: Located (HsModule GhcPs) -> Derives
derives :: Located (HsModule GhcPs) -> Derives
derives (LL _ m :: SrcSpanLess (Located (HsModule GhcPs))
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 GhcPs -> [LHsDecl GhcPs]
forall from to. Biplate from to => from -> [to]
childrenBi SrcSpanLess (Located (HsModule GhcPs))
HsModule GhcPs
m) [Derives] -> [Derives] -> [Derives]
forall a. [a] -> [a] -> [a]
++ (Located (DataFamInstDecl GhcPs) -> Derives)
-> [Located (DataFamInstDecl GhcPs)] -> [Derives]
forall a b. (a -> b) -> [a] -> [b]
map Located (DataFamInstDecl GhcPs) -> Derives
idecl (HsModule GhcPs -> [Located (DataFamInstDecl GhcPs)]
forall from to. Biplate from to => from -> [to]
childrenBi SrcSpanLess (Located (HsModule GhcPs))
HsModule GhcPs
m)
  where
    idecl :: Located (DataFamInstDecl GhcPs) -> Derives
    idecl :: Located (DataFamInstDecl GhcPs) -> Derives
idecl (LL _ (DataFamInstDecl (HsIB _ FamEqn {feqn_rhs=HsDataDefn {dd_ND=dn, dd_derivs=(LL _ ds)}}))) = NewOrData -> [LHsDerivingClause GhcPs] -> Derives
g NewOrData
dn [LHsDerivingClause GhcPs]
SrcSpanLess (HsDeriving GhcPs)
ds
    idecl _ = Derives
forall a. Monoid a => a
mempty

    decl :: LHsDecl GhcPs -> Derives
    decl :: LHsDecl GhcPs -> Derives
decl (LL _ (TyClD _ (DataDecl _ _ _ _ HsDataDefn {dd_ND=dn, dd_derivs=(LL _ ds)}))) = NewOrData -> [LHsDerivingClause GhcPs] -> Derives
g NewOrData
dn [LHsDerivingClause GhcPs]
SrcSpanLess (HsDeriving GhcPs)
ds -- Data declaration.
    decl (LL _ (DerivD _ (DerivDecl _ (HsWC _ sig) strategy _))) = 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 a. HasSrcSpan a => a -> SrcSpanLess a
unLoc Maybe (LDerivStrategy GhcPs)
strategy) [LHsSigType GhcPs -> String
derivedToStr LHsSigType GhcPs
sig] -- A deriving declaration.
    decl _ = Derives
forall a. Monoid a => a
mempty

    g :: NewOrData -> [LHsDerivingClause GhcPs] -> Derives
    g :: NewOrData -> [LHsDerivingClause GhcPs] -> Derives
g dn :: NewOrData
dn ds :: [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 a. HasSrcSpan a => a -> SrcSpanLess a
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]
SrcSpanLess (Located [LHsSigType GhcPs])
tys | LL _ (HsDerivingClause _ strategy (LL _ tys)) <- [LHsDerivingClause GhcPs]
ds]

    derivedToStr :: LHsSigType GhcPs -> String
    derivedToStr :: LHsSigType GhcPs -> String
derivedToStr (HsIB _ t :: LHsType GhcPs
t) = LHsType GhcPs -> String
ih LHsType GhcPs
t
      where
        ih :: LHsType GhcPs -> String
        ih :: LHsType GhcPs -> String
ih (LL _ (HsQualTy _ _ a)) = LHsType GhcPs -> String
ih LHsType GhcPs
a
        ih (LL _ (HsParTy _ a)) = LHsType GhcPs -> String
ih LHsType GhcPs
a
        ih (LL _ (HsAppTy _ a _)) = LHsType GhcPs -> String
ih LHsType GhcPs
a
        ih (LL _ (HsTyVar _ _ 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 RdrName
Located (IdP GhcPs)
a
        ih (LL _ a :: SrcSpanLess (LHsType GhcPs)
a) = HsKind GhcPs -> String
forall a. Outputable a => a -> String
unsafePrettyPrint SrcSpanLess (LHsType GhcPs)
HsKind GhcPs
a -- I don't anticipate this case is called.
        ih _ = "" -- {-# COMPLETE LL #-}
    derivedToStr _ = "" -- new ctor

derives _ = Derives
forall a. Monoid a => a
mempty -- {-# COMPLETE LL #-}

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 a) => (a -> Bool) -> x -> Bool
hasS :: (a -> Bool) -> x -> Bool
hasS test :: 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

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 :: HsExpr GhcPs -> Bool
isWholeFrac :: HsExpr GhcPs -> Bool
isWholeFrac (HsLit _ (HsRat _ (FL _ _ 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 (HsOverLit _ (OverLit _ (HsFractional (FL _ _ 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