module Hint.All(
Hint(..), ModuHint,
resolveHints, hintRules, builtinHints
) where
import Data.Monoid
import Config.Type
import Data.Either
import Data.List.Extra
import Hint.Type
import Timing
import Util
import Prelude
import Hint.Match
import Hint.List
import Hint.ListRec
import Hint.Monad
import Hint.Lambda
import Hint.Bracket
import Hint.Fixities
import Hint.Naming
import Hint.Pattern
import Hint.Import
import Hint.Export
import Hint.Pragma
import Hint.Restrict
import Hint.Extensions
import Hint.Duplicate
import Hint.Comment
import Hint.Unsafe
import Hint.NewType
import Hint.Smell
data HintBuiltin =
HintList | HintListRec | HintMonad | HintLambda | HintFixities |
HintBracket | HintNaming | HintPattern | HintImport | HintExport |
HintPragma | HintExtensions | HintUnsafe | HintDuplicate | HintRestrict |
| HintNewType | HintSmell
deriving (Int -> HintBuiltin -> ShowS
[HintBuiltin] -> ShowS
HintBuiltin -> String
(Int -> HintBuiltin -> ShowS)
-> (HintBuiltin -> String)
-> ([HintBuiltin] -> ShowS)
-> Show HintBuiltin
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [HintBuiltin] -> ShowS
$cshowList :: [HintBuiltin] -> ShowS
show :: HintBuiltin -> String
$cshow :: HintBuiltin -> String
showsPrec :: Int -> HintBuiltin -> ShowS
$cshowsPrec :: Int -> HintBuiltin -> ShowS
Show,HintBuiltin -> HintBuiltin -> Bool
(HintBuiltin -> HintBuiltin -> Bool)
-> (HintBuiltin -> HintBuiltin -> Bool) -> Eq HintBuiltin
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: HintBuiltin -> HintBuiltin -> Bool
$c/= :: HintBuiltin -> HintBuiltin -> Bool
== :: HintBuiltin -> HintBuiltin -> Bool
$c== :: HintBuiltin -> HintBuiltin -> Bool
Eq,Eq HintBuiltin
Eq HintBuiltin
-> (HintBuiltin -> HintBuiltin -> Ordering)
-> (HintBuiltin -> HintBuiltin -> Bool)
-> (HintBuiltin -> HintBuiltin -> Bool)
-> (HintBuiltin -> HintBuiltin -> Bool)
-> (HintBuiltin -> HintBuiltin -> Bool)
-> (HintBuiltin -> HintBuiltin -> HintBuiltin)
-> (HintBuiltin -> HintBuiltin -> HintBuiltin)
-> Ord HintBuiltin
HintBuiltin -> HintBuiltin -> Bool
HintBuiltin -> HintBuiltin -> Ordering
HintBuiltin -> HintBuiltin -> HintBuiltin
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 :: HintBuiltin -> HintBuiltin -> HintBuiltin
$cmin :: HintBuiltin -> HintBuiltin -> HintBuiltin
max :: HintBuiltin -> HintBuiltin -> HintBuiltin
$cmax :: HintBuiltin -> HintBuiltin -> HintBuiltin
>= :: HintBuiltin -> HintBuiltin -> Bool
$c>= :: HintBuiltin -> HintBuiltin -> Bool
> :: HintBuiltin -> HintBuiltin -> Bool
$c> :: HintBuiltin -> HintBuiltin -> Bool
<= :: HintBuiltin -> HintBuiltin -> Bool
$c<= :: HintBuiltin -> HintBuiltin -> Bool
< :: HintBuiltin -> HintBuiltin -> Bool
$c< :: HintBuiltin -> HintBuiltin -> Bool
compare :: HintBuiltin -> HintBuiltin -> Ordering
$ccompare :: HintBuiltin -> HintBuiltin -> Ordering
$cp1Ord :: Eq HintBuiltin
Ord,HintBuiltin
HintBuiltin -> HintBuiltin -> Bounded HintBuiltin
forall a. a -> a -> Bounded a
maxBound :: HintBuiltin
$cmaxBound :: HintBuiltin
minBound :: HintBuiltin
$cminBound :: HintBuiltin
Bounded,Int -> HintBuiltin
HintBuiltin -> Int
HintBuiltin -> [HintBuiltin]
HintBuiltin -> HintBuiltin
HintBuiltin -> HintBuiltin -> [HintBuiltin]
HintBuiltin -> HintBuiltin -> HintBuiltin -> [HintBuiltin]
(HintBuiltin -> HintBuiltin)
-> (HintBuiltin -> HintBuiltin)
-> (Int -> HintBuiltin)
-> (HintBuiltin -> Int)
-> (HintBuiltin -> [HintBuiltin])
-> (HintBuiltin -> HintBuiltin -> [HintBuiltin])
-> (HintBuiltin -> HintBuiltin -> [HintBuiltin])
-> (HintBuiltin -> HintBuiltin -> HintBuiltin -> [HintBuiltin])
-> Enum HintBuiltin
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 :: HintBuiltin -> HintBuiltin -> HintBuiltin -> [HintBuiltin]
$cenumFromThenTo :: HintBuiltin -> HintBuiltin -> HintBuiltin -> [HintBuiltin]
enumFromTo :: HintBuiltin -> HintBuiltin -> [HintBuiltin]
$cenumFromTo :: HintBuiltin -> HintBuiltin -> [HintBuiltin]
enumFromThen :: HintBuiltin -> HintBuiltin -> [HintBuiltin]
$cenumFromThen :: HintBuiltin -> HintBuiltin -> [HintBuiltin]
enumFrom :: HintBuiltin -> [HintBuiltin]
$cenumFrom :: HintBuiltin -> [HintBuiltin]
fromEnum :: HintBuiltin -> Int
$cfromEnum :: HintBuiltin -> Int
toEnum :: Int -> HintBuiltin
$ctoEnum :: Int -> HintBuiltin
pred :: HintBuiltin -> HintBuiltin
$cpred :: HintBuiltin -> HintBuiltin
succ :: HintBuiltin -> HintBuiltin
$csucc :: HintBuiltin -> HintBuiltin
Enum)
issue1150 :: Bool
issue1150 = Bool
True
builtin :: HintBuiltin -> Hint
builtin :: HintBuiltin -> Hint
builtin HintBuiltin
x = case HintBuiltin
x of
HintBuiltin
HintLambda -> (Scope -> ModuleEx -> LHsDecl GhcPs -> [Idea]) -> Hint
decl Scope -> ModuleEx -> LHsDecl GhcPs -> [Idea]
lambdaHint
HintBuiltin
HintImport -> (Scope -> ModuleEx -> [Idea]) -> Hint
modu Scope -> ModuleEx -> [Idea]
importHint
HintBuiltin
HintExport -> (Scope -> ModuleEx -> [Idea]) -> Hint
modu Scope -> ModuleEx -> [Idea]
exportHint
HintBuiltin
HintComment -> (Scope -> ModuleEx -> [Idea]) -> Hint
modu Scope -> ModuleEx -> [Idea]
commentHint
HintBuiltin
HintPragma -> (Scope -> ModuleEx -> [Idea]) -> Hint
modu Scope -> ModuleEx -> [Idea]
pragmaHint
HintBuiltin
HintDuplicate -> if Bool
issue1150 then Hint
forall a. Monoid a => a
mempty else ([(Scope, ModuleEx)] -> [Idea]) -> Hint
mods [(Scope, ModuleEx)] -> [Idea]
duplicateHint
HintBuiltin
HintRestrict -> Hint
forall a. Monoid a => a
mempty{hintModule :: [Setting] -> Scope -> ModuleEx -> [Idea]
hintModule=[Setting] -> Scope -> ModuleEx -> [Idea]
restrictHint}
HintBuiltin
HintList -> (Scope -> ModuleEx -> LHsDecl GhcPs -> [Idea]) -> Hint
decl Scope -> ModuleEx -> LHsDecl GhcPs -> [Idea]
listHint
HintBuiltin
HintNewType -> (Scope -> ModuleEx -> LHsDecl GhcPs -> [Idea]) -> Hint
decl Scope -> ModuleEx -> LHsDecl GhcPs -> [Idea]
newtypeHint
HintBuiltin
HintUnsafe -> (Scope -> ModuleEx -> LHsDecl GhcPs -> [Idea]) -> Hint
decl Scope -> ModuleEx -> LHsDecl GhcPs -> [Idea]
unsafeHint
HintBuiltin
HintListRec -> (Scope -> ModuleEx -> LHsDecl GhcPs -> [Idea]) -> Hint
decl Scope -> ModuleEx -> LHsDecl GhcPs -> [Idea]
listRecHint
HintBuiltin
HintNaming -> (Scope -> ModuleEx -> LHsDecl GhcPs -> [Idea]) -> Hint
decl Scope -> ModuleEx -> LHsDecl GhcPs -> [Idea]
namingHint
HintBuiltin
HintBracket -> (Scope -> ModuleEx -> LHsDecl GhcPs -> [Idea]) -> Hint
decl Scope -> ModuleEx -> LHsDecl GhcPs -> [Idea]
bracketHint
HintBuiltin
HintFixities -> Hint
forall a. Monoid a => a
mempty{hintDecl :: [Setting] -> Scope -> ModuleEx -> LHsDecl GhcPs -> [Idea]
hintDecl=[Setting] -> Scope -> ModuleEx -> LHsDecl GhcPs -> [Idea]
fixitiesHint}
HintBuiltin
HintSmell -> Hint
forall a. Monoid a => a
mempty{hintDecl :: [Setting] -> Scope -> ModuleEx -> LHsDecl GhcPs -> [Idea]
hintDecl=[Setting] -> Scope -> ModuleEx -> LHsDecl GhcPs -> [Idea]
smellHint,hintModule :: [Setting] -> Scope -> ModuleEx -> [Idea]
hintModule=[Setting] -> Scope -> ModuleEx -> [Idea]
smellModuleHint}
HintBuiltin
HintPattern -> (Scope -> ModuleEx -> LHsDecl GhcPs -> [Idea]) -> Hint
decl Scope -> ModuleEx -> LHsDecl GhcPs -> [Idea]
patternHint
HintBuiltin
HintMonad -> (Scope -> ModuleEx -> LHsDecl GhcPs -> [Idea]) -> Hint
decl Scope -> ModuleEx -> LHsDecl GhcPs -> [Idea]
monadHint
HintBuiltin
HintExtensions -> (Scope -> ModuleEx -> [Idea]) -> Hint
modu Scope -> ModuleEx -> [Idea]
extensionsHint
where
wrap :: [a] -> [a]
wrap = String -> String -> [a] -> [a]
forall a. String -> String -> a -> a
timed String
"Hint" (Int -> ShowS
forall a. Int -> [a] -> [a]
drop Int
4 ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ HintBuiltin -> String
forall a. Show a => a -> String
show HintBuiltin
x) ([a] -> [a]) -> ([a] -> [a]) -> [a] -> [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [a] -> [a]
forall a. [a] -> [a]
forceList
decl :: (Scope -> ModuleEx -> LHsDecl GhcPs -> [Idea]) -> Hint
decl Scope -> ModuleEx -> LHsDecl GhcPs -> [Idea]
f = Hint
forall a. Monoid a => a
mempty{hintDecl :: [Setting] -> Scope -> ModuleEx -> LHsDecl GhcPs -> [Idea]
hintDecl=(Scope -> ModuleEx -> LHsDecl GhcPs -> [Idea])
-> [Setting] -> Scope -> ModuleEx -> LHsDecl GhcPs -> [Idea]
forall a b. a -> b -> a
const ((Scope -> ModuleEx -> LHsDecl GhcPs -> [Idea])
-> [Setting] -> Scope -> ModuleEx -> LHsDecl GhcPs -> [Idea])
-> (Scope -> ModuleEx -> LHsDecl GhcPs -> [Idea])
-> [Setting]
-> Scope
-> ModuleEx
-> LHsDecl GhcPs
-> [Idea]
forall a b. (a -> b) -> a -> b
$ \Scope
a ModuleEx
b LHsDecl GhcPs
c -> [Idea] -> [Idea]
forall a. [a] -> [a]
wrap ([Idea] -> [Idea]) -> [Idea] -> [Idea]
forall a b. (a -> b) -> a -> b
$ Scope -> ModuleEx -> LHsDecl GhcPs -> [Idea]
f Scope
a ModuleEx
b LHsDecl GhcPs
c}
modu :: (Scope -> ModuleEx -> [Idea]) -> Hint
modu Scope -> ModuleEx -> [Idea]
f = Hint
forall a. Monoid a => a
mempty{hintModule :: [Setting] -> Scope -> ModuleEx -> [Idea]
hintModule=(Scope -> ModuleEx -> [Idea])
-> [Setting] -> Scope -> ModuleEx -> [Idea]
forall a b. a -> b -> a
const ((Scope -> ModuleEx -> [Idea])
-> [Setting] -> Scope -> ModuleEx -> [Idea])
-> (Scope -> ModuleEx -> [Idea])
-> [Setting]
-> Scope
-> ModuleEx
-> [Idea]
forall a b. (a -> b) -> a -> b
$ \Scope
a ModuleEx
b -> [Idea] -> [Idea]
forall a. [a] -> [a]
wrap ([Idea] -> [Idea]) -> [Idea] -> [Idea]
forall a b. (a -> b) -> a -> b
$ Scope -> ModuleEx -> [Idea]
f Scope
a ModuleEx
b}
mods :: ([(Scope, ModuleEx)] -> [Idea]) -> Hint
mods [(Scope, ModuleEx)] -> [Idea]
f = Hint
forall a. Monoid a => a
mempty{hintModules :: [Setting] -> [(Scope, ModuleEx)] -> [Idea]
hintModules=([(Scope, ModuleEx)] -> [Idea])
-> [Setting] -> [(Scope, ModuleEx)] -> [Idea]
forall a b. a -> b -> a
const (([(Scope, ModuleEx)] -> [Idea])
-> [Setting] -> [(Scope, ModuleEx)] -> [Idea])
-> ([(Scope, ModuleEx)] -> [Idea])
-> [Setting]
-> [(Scope, ModuleEx)]
-> [Idea]
forall a b. (a -> b) -> a -> b
$ \[(Scope, ModuleEx)]
a -> [Idea] -> [Idea]
forall a. [a] -> [a]
wrap ([Idea] -> [Idea]) -> [Idea] -> [Idea]
forall a b. (a -> b) -> a -> b
$ [(Scope, ModuleEx)] -> [Idea]
f [(Scope, ModuleEx)]
a}
builtinHints :: [(String, Hint)]
builtinHints :: [(String, Hint)]
builtinHints = [(Int -> ShowS
forall a. Int -> [a] -> [a]
drop Int
4 ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ HintBuiltin -> String
forall a. Show a => a -> String
show HintBuiltin
h, HintBuiltin -> Hint
builtin HintBuiltin
h) | HintBuiltin
h <- [HintBuiltin]
forall a. (Enum a, Bounded a) => [a]
enumerate]
resolveHints :: [Either HintBuiltin HintRule] -> Hint
resolveHints :: [Either HintBuiltin HintRule] -> Hint
resolveHints [Either HintBuiltin HintRule]
xs =
[Hint] -> Hint
forall a. Monoid a => [a] -> a
mconcat ([Hint] -> Hint) -> [Hint] -> Hint
forall a b. (a -> b) -> a -> b
$ Hint
forall a. Monoid a => a
mempty{hintDecl :: [Setting] -> Scope -> ModuleEx -> LHsDecl GhcPs -> [Idea]
hintDecl=(Scope -> ModuleEx -> LHsDecl GhcPs -> [Idea])
-> [Setting] -> Scope -> ModuleEx -> LHsDecl GhcPs -> [Idea]
forall a b. a -> b -> a
const ((Scope -> ModuleEx -> LHsDecl GhcPs -> [Idea])
-> [Setting] -> Scope -> ModuleEx -> LHsDecl GhcPs -> [Idea])
-> (Scope -> ModuleEx -> LHsDecl GhcPs -> [Idea])
-> [Setting]
-> Scope
-> ModuleEx
-> LHsDecl GhcPs
-> [Idea]
forall a b. (a -> b) -> a -> b
$ [HintRule] -> Scope -> ModuleEx -> LHsDecl GhcPs -> [Idea]
readMatch [HintRule]
rights} Hint -> [Hint] -> [Hint]
forall a. a -> [a] -> [a]
: (HintBuiltin -> Hint) -> [HintBuiltin] -> [Hint]
forall a b. (a -> b) -> [a] -> [b]
map HintBuiltin -> Hint
builtin ([HintBuiltin] -> [HintBuiltin]
forall a. Ord a => [a] -> [a]
nubOrd [HintBuiltin]
lefts)
where ([HintBuiltin]
lefts,[HintRule]
rights) = [Either HintBuiltin HintRule] -> ([HintBuiltin], [HintRule])
forall a b. [Either a b] -> ([a], [b])
partitionEithers [Either HintBuiltin HintRule]
xs
hintRules :: [HintRule] -> Hint
hintRules :: [HintRule] -> Hint
hintRules = [Either HintBuiltin HintRule] -> Hint
resolveHints ([Either HintBuiltin HintRule] -> Hint)
-> ([HintRule] -> [Either HintBuiltin HintRule])
-> [HintRule]
-> Hint
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (HintRule -> Either HintBuiltin HintRule)
-> [HintRule] -> [Either HintBuiltin HintRule]
forall a b. (a -> b) -> [a] -> [b]
map HintRule -> Either HintBuiltin HintRule
forall a b. b -> Either a b
Right