module Config.Type(
    Severity(..), Classify(..), HintRule(..), Note(..), Setting(..),
    Restrict(..), RestrictType(..), RestrictIdents(..), SmellType(..),
    defaultHintName, isUnifyVar, showNotes, getSeverity, getRestrictType, getSmellType
    ) where

import Data.Char
import Data.List.Extra
import Prelude


import qualified GHC.Hs
import Fixity
import GHC.Util
import Language.Haskell.GhclibParserEx.GHC.Hs.ExtendInstances

getSeverity :: String -> Maybe Severity
getSeverity :: String -> Maybe Severity
getSeverity String
"ignore" = Severity -> Maybe Severity
forall a. a -> Maybe a
Just Severity
Ignore
getSeverity String
"warn" = Severity -> Maybe Severity
forall a. a -> Maybe a
Just Severity
Warning
getSeverity String
"warning" = Severity -> Maybe Severity
forall a. a -> Maybe a
Just Severity
Warning
getSeverity String
"suggest" = Severity -> Maybe Severity
forall a. a -> Maybe a
Just Severity
Suggestion
getSeverity String
"suggestion" = Severity -> Maybe Severity
forall a. a -> Maybe a
Just Severity
Suggestion
getSeverity String
"error" = Severity -> Maybe Severity
forall a. a -> Maybe a
Just Severity
Error
getSeverity String
"hint" = Severity -> Maybe Severity
forall a. a -> Maybe a
Just Severity
Suggestion
getSeverity String
_ = Maybe Severity
forall a. Maybe a
Nothing

getRestrictType :: String -> Maybe RestrictType
getRestrictType :: String -> Maybe RestrictType
getRestrictType String
"modules" = RestrictType -> Maybe RestrictType
forall a. a -> Maybe a
Just RestrictType
RestrictModule
getRestrictType String
"extensions" = RestrictType -> Maybe RestrictType
forall a. a -> Maybe a
Just RestrictType
RestrictExtension
getRestrictType String
"flags" = RestrictType -> Maybe RestrictType
forall a. a -> Maybe a
Just RestrictType
RestrictFlag
getRestrictType String
"functions" = RestrictType -> Maybe RestrictType
forall a. a -> Maybe a
Just RestrictType
RestrictFunction
getRestrictType String
_ = Maybe RestrictType
forall a. Maybe a
Nothing

defaultHintName :: String
defaultHintName :: String
defaultHintName = String
"Use alternative"


-- | How severe an issue is.
data Severity
    = Ignore -- ^ The issue has been explicitly ignored and will usually be hidden (pass @--show@ on the command line to see ignored ideas).
    | Suggestion -- ^ Suggestions are things that some people may consider improvements, but some may not.
    | Warning -- ^ Warnings are suggestions that are nearly always a good idea to apply.
    | Error -- ^ Available as a setting for the user. Only parse errors have this setting by default.
      deriving (Severity -> Severity -> Bool
(Severity -> Severity -> Bool)
-> (Severity -> Severity -> Bool) -> Eq Severity
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Severity -> Severity -> Bool
$c/= :: Severity -> Severity -> Bool
== :: Severity -> Severity -> Bool
$c== :: Severity -> Severity -> Bool
Eq,Eq Severity
Eq Severity
-> (Severity -> Severity -> Ordering)
-> (Severity -> Severity -> Bool)
-> (Severity -> Severity -> Bool)
-> (Severity -> Severity -> Bool)
-> (Severity -> Severity -> Bool)
-> (Severity -> Severity -> Severity)
-> (Severity -> Severity -> Severity)
-> Ord Severity
Severity -> Severity -> Bool
Severity -> Severity -> Ordering
Severity -> Severity -> Severity
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Severity -> Severity -> Severity
$cmin :: Severity -> Severity -> Severity
max :: Severity -> Severity -> Severity
$cmax :: Severity -> Severity -> Severity
>= :: Severity -> Severity -> Bool
$c>= :: Severity -> Severity -> Bool
> :: Severity -> Severity -> Bool
$c> :: Severity -> Severity -> Bool
<= :: Severity -> Severity -> Bool
$c<= :: Severity -> Severity -> Bool
< :: Severity -> Severity -> Bool
$c< :: Severity -> Severity -> Bool
compare :: Severity -> Severity -> Ordering
$ccompare :: Severity -> Severity -> Ordering
$cp1Ord :: Eq Severity
Ord,Int -> Severity -> ShowS
[Severity] -> ShowS
Severity -> String
(Int -> Severity -> ShowS)
-> (Severity -> String) -> ([Severity] -> ShowS) -> Show Severity
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Severity] -> ShowS
$cshowList :: [Severity] -> ShowS
show :: Severity -> String
$cshow :: Severity -> String
showsPrec :: Int -> Severity -> ShowS
$cshowsPrec :: Int -> Severity -> ShowS
Show,ReadPrec [Severity]
ReadPrec Severity
Int -> ReadS Severity
ReadS [Severity]
(Int -> ReadS Severity)
-> ReadS [Severity]
-> ReadPrec Severity
-> ReadPrec [Severity]
-> Read Severity
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Severity]
$creadListPrec :: ReadPrec [Severity]
readPrec :: ReadPrec Severity
$creadPrec :: ReadPrec Severity
readList :: ReadS [Severity]
$creadList :: ReadS [Severity]
readsPrec :: Int -> ReadS Severity
$creadsPrec :: Int -> ReadS Severity
Read,Severity
Severity -> Severity -> Bounded Severity
forall a. a -> a -> Bounded a
maxBound :: Severity
$cmaxBound :: Severity
minBound :: Severity
$cminBound :: Severity
Bounded,Int -> Severity
Severity -> Int
Severity -> [Severity]
Severity -> Severity
Severity -> Severity -> [Severity]
Severity -> Severity -> Severity -> [Severity]
(Severity -> Severity)
-> (Severity -> Severity)
-> (Int -> Severity)
-> (Severity -> Int)
-> (Severity -> [Severity])
-> (Severity -> Severity -> [Severity])
-> (Severity -> Severity -> [Severity])
-> (Severity -> Severity -> Severity -> [Severity])
-> Enum Severity
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: Severity -> Severity -> Severity -> [Severity]
$cenumFromThenTo :: Severity -> Severity -> Severity -> [Severity]
enumFromTo :: Severity -> Severity -> [Severity]
$cenumFromTo :: Severity -> Severity -> [Severity]
enumFromThen :: Severity -> Severity -> [Severity]
$cenumFromThen :: Severity -> Severity -> [Severity]
enumFrom :: Severity -> [Severity]
$cenumFrom :: Severity -> [Severity]
fromEnum :: Severity -> Int
$cfromEnum :: Severity -> Int
toEnum :: Int -> Severity
$ctoEnum :: Int -> Severity
pred :: Severity -> Severity
$cpred :: Severity -> Severity
succ :: Severity -> Severity
$csucc :: Severity -> Severity
Enum)


-- Any 1-letter variable names are assumed to be unification variables
isUnifyVar :: String -> Bool
isUnifyVar :: String -> Bool
isUnifyVar [Char
x] = Char
x Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'?' Bool -> Bool -> Bool
|| Char -> Bool
isAlpha Char
x
isUnifyVar [] = Bool
False
isUnifyVar String
xs = (Char -> Bool) -> String -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'?') String
xs


---------------------------------------------------------------------
-- TYPE

-- | A note describing the impact of the replacement.
data Note
    = IncreasesLaziness -- ^ The replacement is increases laziness, for example replacing @reverse (reverse x)@ with @x@ makes the code lazier.
    | DecreasesLaziness -- ^ The replacement is decreases laziness, for example replacing @(fst x, snd x)@ with @x@ makes the code stricter.
    | RemovesError String -- ^ The replacement removes errors, for example replacing @foldr1 (+)@ with @sum@ removes an error on @[]@, and might contain the text @\"on []\"@.
    | ValidInstance String String -- ^ The replacement assumes standard type class lemmas, a hint with the note @ValidInstance \"Eq\" \"x\"@ might only be valid if
                                  --   the @x@ variable has a reflexive @Eq@ instance.
    | RequiresExtension String -- ^ The replacement requires this extension to be available.
    | Note String -- ^ An arbitrary note.
      deriving (Note -> Note -> Bool
(Note -> Note -> Bool) -> (Note -> Note -> Bool) -> Eq Note
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Note -> Note -> Bool
$c/= :: Note -> Note -> Bool
== :: Note -> Note -> Bool
$c== :: Note -> Note -> Bool
Eq,Eq Note
Eq Note
-> (Note -> Note -> Ordering)
-> (Note -> Note -> Bool)
-> (Note -> Note -> Bool)
-> (Note -> Note -> Bool)
-> (Note -> Note -> Bool)
-> (Note -> Note -> Note)
-> (Note -> Note -> Note)
-> Ord Note
Note -> Note -> Bool
Note -> Note -> Ordering
Note -> Note -> Note
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Note -> Note -> Note
$cmin :: Note -> Note -> Note
max :: Note -> Note -> Note
$cmax :: Note -> Note -> Note
>= :: Note -> Note -> Bool
$c>= :: Note -> Note -> Bool
> :: Note -> Note -> Bool
$c> :: Note -> Note -> Bool
<= :: Note -> Note -> Bool
$c<= :: Note -> Note -> Bool
< :: Note -> Note -> Bool
$c< :: Note -> Note -> Bool
compare :: Note -> Note -> Ordering
$ccompare :: Note -> Note -> Ordering
$cp1Ord :: Eq Note
Ord)

instance Show Note where
    show :: Note -> String
show Note
IncreasesLaziness = String
"increases laziness"
    show Note
DecreasesLaziness = String
"decreases laziness"
    show (RemovesError String
x) = String
"removes error " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
x
    show (ValidInstance String
x String
y) = String
"requires a valid `" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
x String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"` instance for `" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
y String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"`"
    show (RequiresExtension String
x) = String
"may require `{-# LANGUAGE " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
x String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" #-}` adding to the top of the file"
    show (Note String
x) = String
x


showNotes :: [Note] -> String
showNotes :: [Note] -> String
showNotes = String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
", " ([String] -> String) -> ([Note] -> [String]) -> [Note] -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Note -> String) -> [Note] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map Note -> String
forall a. Show a => a -> String
show ([Note] -> [String]) -> ([Note] -> [Note]) -> [Note] -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Note -> Bool) -> [Note] -> [Note]
forall a. (a -> Bool) -> [a] -> [a]
filter Note -> Bool
use
    where use :: Note -> Bool
use ValidInstance{} = Bool
False -- Not important enough to tell an end user
          use Note
_ = Bool
True

-- | How to classify an 'Idea'. If any matching field is @\"\"@ then it matches everything.
data Classify = Classify
    {Classify -> Severity
classifySeverity :: Severity -- ^ Severity to set the 'Idea' to.
    ,Classify -> String
classifyHint :: String -- ^ Match on 'Idea' field 'ideaHint'.
    ,Classify -> String
classifyModule :: String -- ^ Match on 'Idea' field 'ideaModule'.
    ,Classify -> String
classifyDecl :: String -- ^ Match on 'Idea' field 'ideaDecl'.
    }
    deriving Int -> Classify -> ShowS
[Classify] -> ShowS
Classify -> String
(Int -> Classify -> ShowS)
-> (Classify -> String) -> ([Classify] -> ShowS) -> Show Classify
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Classify] -> ShowS
$cshowList :: [Classify] -> ShowS
show :: Classify -> String
$cshow :: Classify -> String
showsPrec :: Int -> Classify -> ShowS
$cshowsPrec :: Int -> Classify -> ShowS
Show



-- | A @LHS ==> RHS@ style hint rule.
data HintRule = HintRule
    {HintRule -> Severity
hintRuleSeverity :: Severity -- ^ Default severity for the hint.
    ,HintRule -> String
hintRuleName :: String -- ^ Name for the hint.
    ,HintRule -> [Note]
hintRuleNotes :: [Note] -- ^ Notes about application of the hint.
    ,HintRule -> Scope
hintRuleScope :: Scope -- ^ Module scope in which the hint operates (GHC parse tree).
    -- We wrap these GHC elements in 'HsExtendInstances' in order that we may derive 'Show'.
    ,HintRule -> HsExtendInstances (LHsExpr GhcPs)
hintRuleLHS :: HsExtendInstances (GHC.Hs.LHsExpr GHC.Hs.GhcPs) -- ^ LHS (GHC parse tree).
    ,HintRule -> HsExtendInstances (LHsExpr GhcPs)
hintRuleRHS :: HsExtendInstances (GHC.Hs.LHsExpr GHC.Hs.GhcPs) -- ^ RHS (GHC parse tree).
    ,HintRule -> Maybe (HsExtendInstances (LHsExpr GhcPs))
hintRuleSide :: Maybe (HsExtendInstances (GHC.Hs.LHsExpr GHC.Hs.GhcPs))  -- ^ Side condition (GHC parse tree).
    }
    deriving Int -> HintRule -> ShowS
[HintRule] -> ShowS
HintRule -> String
(Int -> HintRule -> ShowS)
-> (HintRule -> String) -> ([HintRule] -> ShowS) -> Show HintRule
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [HintRule] -> ShowS
$cshowList :: [HintRule] -> ShowS
show :: HintRule -> String
$cshow :: HintRule -> String
showsPrec :: Int -> HintRule -> ShowS
$cshowsPrec :: Int -> HintRule -> ShowS
Show

data RestrictType = RestrictModule | RestrictExtension | RestrictFlag | RestrictFunction deriving (Int -> RestrictType -> ShowS
[RestrictType] -> ShowS
RestrictType -> String
(Int -> RestrictType -> ShowS)
-> (RestrictType -> String)
-> ([RestrictType] -> ShowS)
-> Show RestrictType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RestrictType] -> ShowS
$cshowList :: [RestrictType] -> ShowS
show :: RestrictType -> String
$cshow :: RestrictType -> String
showsPrec :: Int -> RestrictType -> ShowS
$cshowsPrec :: Int -> RestrictType -> ShowS
Show,RestrictType -> RestrictType -> Bool
(RestrictType -> RestrictType -> Bool)
-> (RestrictType -> RestrictType -> Bool) -> Eq RestrictType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RestrictType -> RestrictType -> Bool
$c/= :: RestrictType -> RestrictType -> Bool
== :: RestrictType -> RestrictType -> Bool
$c== :: RestrictType -> RestrictType -> Bool
Eq,Eq RestrictType
Eq RestrictType
-> (RestrictType -> RestrictType -> Ordering)
-> (RestrictType -> RestrictType -> Bool)
-> (RestrictType -> RestrictType -> Bool)
-> (RestrictType -> RestrictType -> Bool)
-> (RestrictType -> RestrictType -> Bool)
-> (RestrictType -> RestrictType -> RestrictType)
-> (RestrictType -> RestrictType -> RestrictType)
-> Ord RestrictType
RestrictType -> RestrictType -> Bool
RestrictType -> RestrictType -> Ordering
RestrictType -> RestrictType -> RestrictType
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: RestrictType -> RestrictType -> RestrictType
$cmin :: RestrictType -> RestrictType -> RestrictType
max :: RestrictType -> RestrictType -> RestrictType
$cmax :: RestrictType -> RestrictType -> RestrictType
>= :: RestrictType -> RestrictType -> Bool
$c>= :: RestrictType -> RestrictType -> Bool
> :: RestrictType -> RestrictType -> Bool
$c> :: RestrictType -> RestrictType -> Bool
<= :: RestrictType -> RestrictType -> Bool
$c<= :: RestrictType -> RestrictType -> Bool
< :: RestrictType -> RestrictType -> Bool
$c< :: RestrictType -> RestrictType -> Bool
compare :: RestrictType -> RestrictType -> Ordering
$ccompare :: RestrictType -> RestrictType -> Ordering
$cp1Ord :: Eq RestrictType
Ord)

data RestrictIdents
    = NoRestrictIdents -- No restrictions on module imports
    | ForbidIdents [String] -- Forbid importing the given identifiers from this module
    | OnlyIdents [String] -- Forbid importing all identifiers from this module, except the given identifiers
    deriving Int -> RestrictIdents -> ShowS
[RestrictIdents] -> ShowS
RestrictIdents -> String
(Int -> RestrictIdents -> ShowS)
-> (RestrictIdents -> String)
-> ([RestrictIdents] -> ShowS)
-> Show RestrictIdents
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RestrictIdents] -> ShowS
$cshowList :: [RestrictIdents] -> ShowS
show :: RestrictIdents -> String
$cshow :: RestrictIdents -> String
showsPrec :: Int -> RestrictIdents -> ShowS
$cshowsPrec :: Int -> RestrictIdents -> ShowS
Show

instance Semigroup RestrictIdents where
    RestrictIdents
NoRestrictIdents <> :: RestrictIdents -> RestrictIdents -> RestrictIdents
<> RestrictIdents
ri = RestrictIdents
ri
    RestrictIdents
ri <> RestrictIdents
NoRestrictIdents = RestrictIdents
ri
    ForbidIdents [String]
x1 <> ForbidIdents [String]
y1 = [String] -> RestrictIdents
ForbidIdents ([String] -> RestrictIdents) -> [String] -> RestrictIdents
forall a b. (a -> b) -> a -> b
$ [String]
x1 [String] -> [String] -> [String]
forall a. Semigroup a => a -> a -> a
<> [String]
y1
    OnlyIdents [String]
x1 <> OnlyIdents [String]
x2 = [String] -> RestrictIdents
OnlyIdents ([String] -> RestrictIdents) -> [String] -> RestrictIdents
forall a b. (a -> b) -> a -> b
$ [String]
x1 [String] -> [String] -> [String]
forall a. Semigroup a => a -> a -> a
<> [String]
x2
    RestrictIdents
ri1 <> RestrictIdents
ri2 = String -> RestrictIdents
forall a. HasCallStack => String -> a
error (String -> RestrictIdents) -> String -> RestrictIdents
forall a b. (a -> b) -> a -> b
$ String
"Incompatible restrictions: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ (RestrictIdents, RestrictIdents) -> String
forall a. Show a => a -> String
show (RestrictIdents
ri1, RestrictIdents
ri2)

data Restrict = Restrict
    {Restrict -> RestrictType
restrictType :: RestrictType
    ,Restrict -> Bool
restrictDefault :: Bool
    ,Restrict -> [String]
restrictName :: [String]
    ,Restrict -> [String]
restrictAs :: [String] -- for RestrictModule only, what module names you can import it as
    ,Restrict -> [(String, String)]
restrictWithin :: [(String, String)]
    ,Restrict -> RestrictIdents
restrictIdents :: RestrictIdents -- for RestrictModule only, what identifiers can be imported from it
    ,Restrict -> Maybe String
restrictMessage :: Maybe String
    } deriving Int -> Restrict -> ShowS
[Restrict] -> ShowS
Restrict -> String
(Int -> Restrict -> ShowS)
-> (Restrict -> String) -> ([Restrict] -> ShowS) -> Show Restrict
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Restrict] -> ShowS
$cshowList :: [Restrict] -> ShowS
show :: Restrict -> String
$cshow :: Restrict -> String
showsPrec :: Int -> Restrict -> ShowS
$cshowsPrec :: Int -> Restrict -> ShowS
Show

data SmellType = SmellLongFunctions | SmellLongTypeLists | SmellManyArgFunctions | SmellManyImports
  deriving (Int -> SmellType -> ShowS
[SmellType] -> ShowS
SmellType -> String
(Int -> SmellType -> ShowS)
-> (SmellType -> String)
-> ([SmellType] -> ShowS)
-> Show SmellType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SmellType] -> ShowS
$cshowList :: [SmellType] -> ShowS
show :: SmellType -> String
$cshow :: SmellType -> String
showsPrec :: Int -> SmellType -> ShowS
$cshowsPrec :: Int -> SmellType -> ShowS
Show,SmellType -> SmellType -> Bool
(SmellType -> SmellType -> Bool)
-> (SmellType -> SmellType -> Bool) -> Eq SmellType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SmellType -> SmellType -> Bool
$c/= :: SmellType -> SmellType -> Bool
== :: SmellType -> SmellType -> Bool
$c== :: SmellType -> SmellType -> Bool
Eq,Eq SmellType
Eq SmellType
-> (SmellType -> SmellType -> Ordering)
-> (SmellType -> SmellType -> Bool)
-> (SmellType -> SmellType -> Bool)
-> (SmellType -> SmellType -> Bool)
-> (SmellType -> SmellType -> Bool)
-> (SmellType -> SmellType -> SmellType)
-> (SmellType -> SmellType -> SmellType)
-> Ord SmellType
SmellType -> SmellType -> Bool
SmellType -> SmellType -> Ordering
SmellType -> SmellType -> SmellType
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: SmellType -> SmellType -> SmellType
$cmin :: SmellType -> SmellType -> SmellType
max :: SmellType -> SmellType -> SmellType
$cmax :: SmellType -> SmellType -> SmellType
>= :: SmellType -> SmellType -> Bool
$c>= :: SmellType -> SmellType -> Bool
> :: SmellType -> SmellType -> Bool
$c> :: SmellType -> SmellType -> Bool
<= :: SmellType -> SmellType -> Bool
$c<= :: SmellType -> SmellType -> Bool
< :: SmellType -> SmellType -> Bool
$c< :: SmellType -> SmellType -> Bool
compare :: SmellType -> SmellType -> Ordering
$ccompare :: SmellType -> SmellType -> Ordering
$cp1Ord :: Eq SmellType
Ord)

getSmellType :: String -> Maybe SmellType
getSmellType :: String -> Maybe SmellType
getSmellType String
"long functions" = SmellType -> Maybe SmellType
forall a. a -> Maybe a
Just SmellType
SmellLongFunctions
getSmellType String
"long type lists" = SmellType -> Maybe SmellType
forall a. a -> Maybe a
Just SmellType
SmellLongTypeLists
getSmellType String
"many arg functions" = SmellType -> Maybe SmellType
forall a. a -> Maybe a
Just SmellType
SmellManyArgFunctions
getSmellType String
"many imports" = SmellType -> Maybe SmellType
forall a. a -> Maybe a
Just SmellType
SmellManyImports
getSmellType String
_ = Maybe SmellType
forall a. Maybe a
Nothing

data Setting
    = SettingClassify Classify
    | SettingMatchExp HintRule
    | SettingRestrict Restrict
    | SettingArgument String -- ^ Extra command-line argument
    | SettingSmell SmellType Int
    | Builtin String -- use a builtin hint set
    | Infix FixityInfo
      deriving Int -> Setting -> ShowS
[Setting] -> ShowS
Setting -> String
(Int -> Setting -> ShowS)
-> (Setting -> String) -> ([Setting] -> ShowS) -> Show Setting
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Setting] -> ShowS
$cshowList :: [Setting] -> ShowS
show :: Setting -> String
$cshow :: Setting -> String
showsPrec :: Int -> Setting -> ShowS
$cshowsPrec :: Int -> Setting -> ShowS
Show