1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
|
{-# LANGUAGE ViewPatterns #-}
{-# LANGUAGE FlexibleContexts #-}
{-
Suggest better pragmas
OPTIONS_GHC -cpp => LANGUAGE CPP
OPTIONS_GHC -fglasgow-exts => LANGUAGE ... (in HSE)
OPTIONS_GHC -XFoo => LANGUAGE Foo
LANGUAGE A, A => LANGUAGE A
-- do not do LANGUAGE A, LANGUAGE B to combine
<TEST>
{-# OPTIONS_GHC -cpp #-} -- {-# LANGUAGE CPP #-}
{-# OPTIONS -cpp #-} -- {-# LANGUAGE CPP #-}
{-# OPTIONS_YHC -cpp #-}
{-# OPTIONS_GHC -XFoo #-} -- {-# LANGUAGE Foo #-}
{-# OPTIONS_GHC -fglasgow-exts #-} -- ???
{-# LANGUAGE A, B, C, A #-} -- {-# LANGUAGE A, B, C #-}
{-# LANGUAGE A #-}
{-# OPTIONS_GHC -cpp -foo #-} -- {-# LANGUAGE CPP #-} {-# OPTIONS_GHC -foo #-}
{-# OPTIONS_GHC -cpp #-} \
{-# LANGUAGE CPP, Text #-} --
{-# LANGUAGE A #-} \
{-# LANGUAGE B #-}
{-# LANGUAGE A #-} \
{-# LANGUAGE B, A #-} -- {-# LANGUAGE A, B #-}
</TEST>
-}
module Hint.Pragma(pragmaHint) where
import Hint.Type
import Data.List.Extra
import Data.Maybe
import Refact.Types
import qualified Refact.Types as R
pragmaHint :: ModuHint
pragmaHint _ x = languageDupes lang ++ optToPragma x lang
where
lang = [x | x@LanguagePragma{} <- modulePragmas x]
optToPragma :: Module_ -> [ModulePragma S] -> [Idea]
optToPragma x lang =
[pragmaIdea (OptionsToComment old ys rs) | old /= []]
where
(old,new,ns, rs) =
unzip4 [(old,new,ns, r)
| old <- modulePragmas x, Just (new,ns) <- [optToLanguage old ls]
, let r = mkRefact old new ns]
ls = concat [map fromNamed n | LanguagePragma _ n <- lang]
ns2 = nubOrd (concat ns) \\ ls
ys = [LanguagePragma an (map toNamed ns2) | ns2 /= []] ++ catMaybes new
mkRefact :: ModulePragma S -> Maybe (ModulePragma S) -> [String] -> Refactoring R.SrcSpan
mkRefact old (maybe "" prettyPrint -> new) ns =
let ns' = map (\n -> prettyPrint $ LanguagePragma an [toNamed n]) ns
in
ModifyComment (toSS old) (intercalate "\n" (filter (not . null) (new: ns')))
data PragmaIdea = SingleComment (ModulePragma S) (ModulePragma S)
| MultiComment (ModulePragma S) (ModulePragma S) (ModulePragma S)
| OptionsToComment [ModulePragma S] [ModulePragma S] [Refactoring R.SrcSpan]
pragmaIdea :: PragmaIdea -> Idea
pragmaIdea pidea =
case pidea of
SingleComment old new ->
mkFewer (srcInfoSpan . ann $ old)
(prettyPrint old) (Just $ prettyPrint new) []
[ModifyComment (toSS old) (prettyPrint new)]
MultiComment repl delete new ->
mkFewer (srcInfoSpan . ann $ repl)
(f [repl, delete]) (Just $ prettyPrint new) []
[ ModifyComment (toSS repl) (prettyPrint new)
, ModifyComment (toSS delete) ""]
OptionsToComment old new r ->
mkLanguage (srcInfoSpan . ann . head $ old)
(f old) (Just $ f new) []
r
where
f = unlines . map prettyPrint
mkFewer = rawIdea Warning "Use fewer LANGUAGE pragmas"
mkLanguage = rawIdea Warning "Use LANGUAGE pragmas"
languageDupes :: [ModulePragma S] -> [Idea]
languageDupes (a@(LanguagePragma _ x):xs) =
(if nub_ x `neqList` x
then [pragmaIdea (SingleComment a (LanguagePragma (ann a) $ nub_ x))]
else [pragmaIdea (MultiComment a b (LanguagePragma (ann a) (nub_ $ x ++ y))) | b@(LanguagePragma _ y) <- xs, not $ null $ intersect_ x y]) ++
languageDupes xs
languageDupes _ = []
-- Given a pragma, can you extract some language features out
strToLanguage :: String -> Maybe [String]
strToLanguage "-cpp" = Just ["CPP"]
strToLanguage x | "-X" `isPrefixOf` x = Just [drop 2 x]
strToLanguage "-fglasgow-exts" = Just $ map prettyExtension glasgowExts
strToLanguage _ = Nothing
optToLanguage :: ModulePragma S -> [String] -> Maybe (Maybe (ModulePragma S), [String])
optToLanguage (OptionsPragma sl tool val) ls
| maybe True (== GHC) tool && any isJust vs =
Just (res, filter (not . (`elem` ls)) (concat $ catMaybes vs))
where
strs = words val
vs = map strToLanguage strs
keep = concat $ zipWith (\v s -> [s | isNothing v]) vs strs
res = if null keep then Nothing else Just $ OptionsPragma sl tool (unwords keep)
optToLanguage _ _ = Nothing
|
