{-# LANGUAGE RecordWildCards #-}
module Config.Compute(computeSettings) where
import HSE.All
import Config.Type
import Config.Haskell
import Data.Monoid
import Prelude
computeSettings :: ParseFlags -> FilePath -> IO (String, [Setting])
computeSettings :: ParseFlags -> FilePath -> IO (FilePath, [Setting])
computeSettings flags :: ParseFlags
flags file :: FilePath
file = do
Either ParseError ModuleEx
x <- ParseFlags
-> FilePath -> Maybe FilePath -> IO (Either ParseError ModuleEx)
parseModuleEx ParseFlags
flags FilePath
file Maybe FilePath
forall a. Maybe a
Nothing
case Either ParseError ModuleEx
x of
Left (ParseError sl :: SrcLoc
sl msg :: FilePath
msg _) ->
(FilePath, [Setting]) -> IO (FilePath, [Setting])
forall (m :: * -> *) a. Monad m => a -> m a
return ("# Parse error " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ SrcLoc -> FilePath
showSrcLoc SrcLoc
sl FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ ": " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
msg, [])
Right (ModuleEx m :: Module SrcSpanInfo
m _ _ _) -> do
let xs :: [Decl_]
xs = (Decl_ -> [Decl_]) -> [Decl_] -> [Decl_]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap ((Name SrcSpanInfo -> QName SrcSpanInfo) -> Decl_ -> [Decl_]
findSetting ((Name SrcSpanInfo -> QName SrcSpanInfo) -> Decl_ -> [Decl_])
-> (Name SrcSpanInfo -> QName SrcSpanInfo) -> Decl_ -> [Decl_]
forall a b. (a -> b) -> a -> b
$ SrcSpanInfo -> Name SrcSpanInfo -> QName SrcSpanInfo
forall l. l -> Name l -> QName l
UnQual SrcSpanInfo
an) (Module SrcSpanInfo -> [Decl_]
moduleDecls Module SrcSpanInfo
m)
r :: [Setting]
r = (Decl_ -> [Setting]) -> [Decl_] -> [Setting]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (Scope -> Decl_ -> [Setting]
readSetting Scope
forall a. Monoid a => a
mempty) [Decl_]
xs
s :: FilePath
s = [FilePath] -> FilePath
unlines ([FilePath] -> FilePath) -> [FilePath] -> FilePath
forall a b. (a -> b) -> a -> b
$ ["# hints found in " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
file] [FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++ (Setting -> [FilePath]) -> [Setting] -> [FilePath]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Setting -> [FilePath]
renderSetting [Setting]
r [FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++ ["# no hints found" | [Decl_] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Decl_]
xs]
(FilePath, [Setting]) -> IO (FilePath, [Setting])
forall (m :: * -> *) a. Monad m => a -> m a
return (FilePath
s,[Setting]
r)
renderSetting :: Setting -> [String]
renderSetting :: Setting -> [FilePath]
renderSetting (SettingMatchExp HintRule{..}) =
["- warn: {lhs: " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath -> FilePath
forall a. Show a => a -> FilePath
show (Exp SrcSpanInfo -> FilePath
forall a. Pretty a => a -> FilePath
prettyPrint Exp SrcSpanInfo
hintRuleLHS) FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ ", rhs: " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath -> FilePath
forall a. Show a => a -> FilePath
show (Exp SrcSpanInfo -> FilePath
forall a. Pretty a => a -> FilePath
prettyPrint Exp SrcSpanInfo
hintRuleRHS) FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ "}"]
renderSetting (Infix x :: Fixity
x) = ["- infix: " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath -> FilePath
forall a. Show a => a -> FilePath
show (Decl () -> FilePath
forall a. Pretty a => a -> FilePath
prettyPrint (Fixity -> Decl ()
toInfixDecl Fixity
x))]
renderSetting _ = []
findSetting :: (Name S -> QName S) -> Decl_ -> [Decl_]
findSetting :: (Name SrcSpanInfo -> QName SrcSpanInfo) -> Decl_ -> [Decl_]
findSetting qual :: Name SrcSpanInfo -> QName SrcSpanInfo
qual (InstDecl _ _ _ (Just xs :: [InstDecl SrcSpanInfo]
xs)) = (Decl_ -> [Decl_]) -> [Decl_] -> [Decl_]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap ((Name SrcSpanInfo -> QName SrcSpanInfo) -> Decl_ -> [Decl_]
findSetting Name SrcSpanInfo -> QName SrcSpanInfo
qual) [Decl_
x | InsDecl _ x :: Decl_
x <- [InstDecl SrcSpanInfo]
xs]
findSetting qual :: Name SrcSpanInfo -> QName SrcSpanInfo
qual (PatBind _ (PVar _ name :: Name SrcSpanInfo
name) (UnGuardedRhs _ bod :: Exp SrcSpanInfo
bod) Nothing) = QName SrcSpanInfo -> [FilePath] -> Exp SrcSpanInfo -> [Decl_]
findExp (Name SrcSpanInfo -> QName SrcSpanInfo
qual Name SrcSpanInfo
name) [] Exp SrcSpanInfo
bod
findSetting qual :: Name SrcSpanInfo -> QName SrcSpanInfo
qual (FunBind _ [InfixMatch _ p1 :: Pat SrcSpanInfo
p1 name :: Name SrcSpanInfo
name ps :: [Pat SrcSpanInfo]
ps rhs :: Rhs SrcSpanInfo
rhs bind :: Maybe (Binds SrcSpanInfo)
bind]) = (Name SrcSpanInfo -> QName SrcSpanInfo) -> Decl_ -> [Decl_]
findSetting Name SrcSpanInfo -> QName SrcSpanInfo
qual (Decl_ -> [Decl_]) -> Decl_ -> [Decl_]
forall a b. (a -> b) -> a -> b
$ SrcSpanInfo -> [Match SrcSpanInfo] -> Decl_
forall l. l -> [Match l] -> Decl l
FunBind SrcSpanInfo
an [SrcSpanInfo
-> Name SrcSpanInfo
-> [Pat SrcSpanInfo]
-> Rhs SrcSpanInfo
-> Maybe (Binds SrcSpanInfo)
-> Match SrcSpanInfo
forall l.
l -> Name l -> [Pat l] -> Rhs l -> Maybe (Binds l) -> Match l
Match SrcSpanInfo
an Name SrcSpanInfo
name (Pat SrcSpanInfo
p1Pat SrcSpanInfo -> [Pat SrcSpanInfo] -> [Pat SrcSpanInfo]
forall a. a -> [a] -> [a]
:[Pat SrcSpanInfo]
ps) Rhs SrcSpanInfo
rhs Maybe (Binds SrcSpanInfo)
bind]
findSetting qual :: Name SrcSpanInfo -> QName SrcSpanInfo
qual (FunBind _ [Match _ name :: Name SrcSpanInfo
name ps :: [Pat SrcSpanInfo]
ps (UnGuardedRhs _ bod :: Exp SrcSpanInfo
bod) Nothing]) = QName SrcSpanInfo -> [FilePath] -> Exp SrcSpanInfo -> [Decl_]
findExp (Name SrcSpanInfo -> QName SrcSpanInfo
qual Name SrcSpanInfo
name) [] (Exp SrcSpanInfo -> [Decl_]) -> Exp SrcSpanInfo -> [Decl_]
forall a b. (a -> b) -> a -> b
$ SrcSpanInfo
-> [Pat SrcSpanInfo] -> Exp SrcSpanInfo -> Exp SrcSpanInfo
forall l. l -> [Pat l] -> Exp l -> Exp l
Lambda SrcSpanInfo
an [Pat SrcSpanInfo]
ps Exp SrcSpanInfo
bod
findSetting _ x :: Decl_
x@InfixDecl{} = [Decl_
x]
findSetting _ _ = []
findExp :: QName S -> [String] -> Exp_ -> [Decl_]
findExp :: QName SrcSpanInfo -> [FilePath] -> Exp SrcSpanInfo -> [Decl_]
findExp name :: QName SrcSpanInfo
name vs :: [FilePath]
vs (Lambda _ ps :: [Pat SrcSpanInfo]
ps bod :: Exp SrcSpanInfo
bod) | [FilePath] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [FilePath]
ps2 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== [Pat SrcSpanInfo] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Pat SrcSpanInfo]
ps = QName SrcSpanInfo -> [FilePath] -> Exp SrcSpanInfo -> [Decl_]
findExp QName SrcSpanInfo
name ([FilePath]
vs[FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++[FilePath]
ps2) Exp SrcSpanInfo
bod
| Bool
otherwise = []
where ps2 :: [FilePath]
ps2 = [FilePath
x | PVar_ x :: FilePath
x <- (Pat SrcSpanInfo -> PVar_) -> [Pat SrcSpanInfo] -> [PVar_]
forall a b. (a -> b) -> [a] -> [b]
map Pat SrcSpanInfo -> PVar_
forall a b. View a b => a -> b
view [Pat SrcSpanInfo]
ps]
findExp name :: QName SrcSpanInfo
name vs :: [FilePath]
vs Var{} = []
findExp name :: QName SrcSpanInfo
name vs :: [FilePath]
vs (InfixApp _ x :: Exp SrcSpanInfo
x dot :: QOp SrcSpanInfo
dot y :: Exp SrcSpanInfo
y) | QOp SrcSpanInfo -> Bool
isDot QOp SrcSpanInfo
dot = QName SrcSpanInfo -> [FilePath] -> Exp SrcSpanInfo -> [Decl_]
findExp QName SrcSpanInfo
name ([FilePath]
vs[FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++["_hlint"]) (Exp SrcSpanInfo -> [Decl_]) -> Exp SrcSpanInfo -> [Decl_]
forall a b. (a -> b) -> a -> b
$ SrcSpanInfo
-> Exp SrcSpanInfo -> Exp SrcSpanInfo -> Exp SrcSpanInfo
forall l. l -> Exp l -> Exp l -> Exp l
App SrcSpanInfo
an Exp SrcSpanInfo
x (Exp SrcSpanInfo -> Exp SrcSpanInfo)
-> Exp SrcSpanInfo -> Exp SrcSpanInfo
forall a b. (a -> b) -> a -> b
$ SrcSpanInfo -> Exp SrcSpanInfo -> Exp SrcSpanInfo
forall l. l -> Exp l -> Exp l
Paren SrcSpanInfo
an (Exp SrcSpanInfo -> Exp SrcSpanInfo)
-> Exp SrcSpanInfo -> Exp SrcSpanInfo
forall a b. (a -> b) -> a -> b
$ SrcSpanInfo
-> Exp SrcSpanInfo -> Exp SrcSpanInfo -> Exp SrcSpanInfo
forall l. l -> Exp l -> Exp l -> Exp l
App SrcSpanInfo
an Exp SrcSpanInfo
y (FilePath -> Exp SrcSpanInfo
forall a. Named a => FilePath -> a
toNamed "_hlint")
findExp name :: QName SrcSpanInfo
name vs :: [FilePath]
vs bod :: Exp SrcSpanInfo
bod = [SrcSpanInfo
-> Pat SrcSpanInfo
-> Rhs SrcSpanInfo
-> Maybe (Binds SrcSpanInfo)
-> Decl_
forall l. l -> Pat l -> Rhs l -> Maybe (Binds l) -> Decl l
PatBind SrcSpanInfo
an (FilePath -> Pat SrcSpanInfo
forall a. Named a => FilePath -> a
toNamed "warn") (SrcSpanInfo -> Exp SrcSpanInfo -> Rhs SrcSpanInfo
forall l. l -> Exp l -> Rhs l
UnGuardedRhs SrcSpanInfo
an (Exp SrcSpanInfo -> Rhs SrcSpanInfo)
-> Exp SrcSpanInfo -> Rhs SrcSpanInfo
forall a b. (a -> b) -> a -> b
$ SrcSpanInfo
-> Exp SrcSpanInfo
-> QOp SrcSpanInfo
-> Exp SrcSpanInfo
-> Exp SrcSpanInfo
forall l. l -> Exp l -> QOp l -> Exp l -> Exp l
InfixApp SrcSpanInfo
an Exp SrcSpanInfo
lhs (FilePath -> QOp SrcSpanInfo
forall a. Named a => FilePath -> a
toNamed "==>") Exp SrcSpanInfo
rhs) Maybe (Binds SrcSpanInfo)
forall a. Maybe a
Nothing]
where
lhs :: Exp SrcSpanInfo
lhs = Exp SrcSpanInfo -> Exp SrcSpanInfo
forall l. (Data l, Default l) => Exp l -> Exp l
g (Exp SrcSpanInfo -> Exp SrcSpanInfo)
-> Exp SrcSpanInfo -> Exp SrcSpanInfo
forall a b. (a -> b) -> a -> b
$ (Exp SrcSpanInfo -> Exp SrcSpanInfo)
-> Exp SrcSpanInfo -> Exp SrcSpanInfo
forall on. Uniplate on => (on -> on) -> on -> on
transform Exp SrcSpanInfo -> Exp SrcSpanInfo
f Exp SrcSpanInfo
bod
rhs :: Exp SrcSpanInfo
rhs = [Exp SrcSpanInfo] -> Exp SrcSpanInfo
apps ([Exp SrcSpanInfo] -> Exp SrcSpanInfo)
-> [Exp SrcSpanInfo] -> Exp SrcSpanInfo
forall a b. (a -> b) -> a -> b
$ SrcSpanInfo -> QName SrcSpanInfo -> Exp SrcSpanInfo
forall l. l -> QName l -> Exp l
Var SrcSpanInfo
an QName SrcSpanInfo
name Exp SrcSpanInfo -> [Exp SrcSpanInfo] -> [Exp SrcSpanInfo]
forall a. a -> [a] -> [a]
: ((FilePath, Exp SrcSpanInfo) -> Exp SrcSpanInfo)
-> [(FilePath, Exp SrcSpanInfo)] -> [Exp SrcSpanInfo]
forall a b. (a -> b) -> [a] -> [b]
map (FilePath, Exp SrcSpanInfo) -> Exp SrcSpanInfo
forall a b. (a, b) -> b
snd [(FilePath, Exp SrcSpanInfo)]
rep
rep :: [(FilePath, Exp SrcSpanInfo)]
rep = [FilePath] -> [Exp SrcSpanInfo] -> [(FilePath, Exp SrcSpanInfo)]
forall a b. [a] -> [b] -> [(a, b)]
zip [FilePath]
vs ([Exp SrcSpanInfo] -> [(FilePath, Exp SrcSpanInfo)])
-> [Exp SrcSpanInfo] -> [(FilePath, Exp SrcSpanInfo)]
forall a b. (a -> b) -> a -> b
$ (Char -> Exp SrcSpanInfo) -> FilePath -> [Exp SrcSpanInfo]
forall a b. (a -> b) -> [a] -> [b]
map (FilePath -> Exp SrcSpanInfo
forall a. Named a => FilePath -> a
toNamed (FilePath -> Exp SrcSpanInfo)
-> (Char -> FilePath) -> Char -> Exp SrcSpanInfo
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> FilePath
forall (m :: * -> *) a. Monad m => a -> m a
return) ['a'..]
f :: Exp SrcSpanInfo -> Exp SrcSpanInfo
f xx :: Exp SrcSpanInfo
xx | Var_ x :: FilePath
x <- Exp SrcSpanInfo -> Var_
forall a b. View a b => a -> b
view Exp SrcSpanInfo
xx, Just y :: Exp SrcSpanInfo
y <- FilePath
-> [(FilePath, Exp SrcSpanInfo)] -> Maybe (Exp SrcSpanInfo)
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup FilePath
x [(FilePath, Exp SrcSpanInfo)]
rep = Exp SrcSpanInfo
y
f (InfixApp _ x :: Exp SrcSpanInfo
x dol :: QOp SrcSpanInfo
dol y :: Exp SrcSpanInfo
y) | QOp SrcSpanInfo -> Bool
isDol QOp SrcSpanInfo
dol = SrcSpanInfo
-> Exp SrcSpanInfo -> Exp SrcSpanInfo -> Exp SrcSpanInfo
forall l. l -> Exp l -> Exp l -> Exp l
App SrcSpanInfo
an Exp SrcSpanInfo
x (Exp SrcSpanInfo -> Exp SrcSpanInfo
forall l. (Data l, Default l) => Exp l -> Exp l
paren Exp SrcSpanInfo
y)
f x :: Exp SrcSpanInfo
x = Exp SrcSpanInfo
x
g :: Exp l -> Exp l
g o :: Exp l
o@(InfixApp _ _ _ x :: Exp l
x) | Exp l -> Bool
forall l. Exp l -> Bool
isAnyApp Exp l
x Bool -> Bool -> Bool
|| Exp l -> Bool
forall a. Brackets a => a -> Bool
isAtom Exp l
x = Exp l
o
g o :: Exp l
o@App{} = Exp l
o
g o :: Exp l
o = Exp l -> Exp l
forall l. (Data l, Default l) => Exp l -> Exp l
paren Exp l
o