blob: 8d71c680e3eaecc8f46a0165285d02280b2a03d0 (
plain)
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
116
117
118
119
|
--------------------------------------------------------------------------------
module Language.Haskell.Stylish.Step.LanguagePragmas
( Style (..)
, step
-- * Utilities
, addLanguagePragma
) where
--------------------------------------------------------------------------------
import Data.List (nub, sort)
import qualified Language.Haskell.Exts.Annotated as H
--------------------------------------------------------------------------------
import Language.Haskell.Stylish.Block
import Language.Haskell.Stylish.Editor
import Language.Haskell.Stylish.Step
import Language.Haskell.Stylish.Util
--------------------------------------------------------------------------------
data Style
= Vertical
| Compact
deriving (Eq, Show)
--------------------------------------------------------------------------------
pragmas :: H.Module l -> [(l, [String])]
pragmas (H.Module _ _ ps _ _) =
[(l, map nameToString names) | H.LanguagePragma l names <- ps]
pragmas _ = []
--------------------------------------------------------------------------------
-- | The start of the first block
firstLocation :: [(Block a, [String])] -> Int
firstLocation = minimum . map (blockStart . fst)
--------------------------------------------------------------------------------
verticalPragmas :: [String] -> Lines
verticalPragmas pragmas' =
[ "{-# LANGUAGE " ++ padRight longest pragma ++ " #-}"
| pragma <- pragmas'
]
where
longest = maximum $ map length pragmas'
--------------------------------------------------------------------------------
compactPragmas :: Int -> [String] -> Lines
compactPragmas columns pragmas' = wrap columns "{-# LANGUAGE" 13 $
map (++ ",") (init pragmas') ++ [last pragmas', "#-}"]
--------------------------------------------------------------------------------
prettyPragmas :: Int -> Style -> [String] -> Lines
prettyPragmas _ Vertical = verticalPragmas
prettyPragmas columns Compact = compactPragmas columns
--------------------------------------------------------------------------------
step :: Int -> Style -> Bool -> Step
step columns style = makeStep "LanguagePragmas" . step' columns style
--------------------------------------------------------------------------------
step' :: Int -> Style -> Bool -> Lines -> Module -> Lines
step' columns style removeRedundant ls (module', _)
| null pragmas' = ls
| otherwise = applyChanges changes ls
where
filterRedundant
| removeRedundant = filter (not . isRedundant module')
| otherwise = id
pragmas' = pragmas $ fmap linesFromSrcSpan module'
uniques = filterRedundant $ nub $ sort $ snd =<< pragmas'
loc = firstLocation pragmas'
deletes = map (delete . fst) pragmas'
changes = insert loc (prettyPragmas columns style uniques) : deletes
--------------------------------------------------------------------------------
-- | Add a LANGUAGE pragma to a module if it is not present already.
addLanguagePragma :: String -> H.Module H.SrcSpanInfo -> [Change String]
addLanguagePragma prag modu
| prag `elem` present = []
| otherwise = [insert line ["{-# LANGUAGE " ++ prag ++ " #-}"]]
where
pragmas' = pragmas (fmap linesFromSrcSpan modu)
present = concatMap snd pragmas'
line = if null pragmas' then 1 else firstLocation pragmas'
--------------------------------------------------------------------------------
-- | Check if a language pragma is redundant. We can't do this for all pragmas,
-- but we do a best effort.
isRedundant :: H.Module H.SrcSpanInfo -> String -> Bool
isRedundant m "ViewPatterns" = isRedundantViewPatterns m
isRedundant m "BangPatterns" = isRedundantBangPatterns m
isRedundant _ _ = False
--------------------------------------------------------------------------------
-- | Check if the ViewPatterns language pragma is redundant.
isRedundantViewPatterns :: H.Module H.SrcSpanInfo -> Bool
isRedundantViewPatterns m = null
[() | H.PViewPat _ _ _ <- everything m :: [H.Pat H.SrcSpanInfo]]
--------------------------------------------------------------------------------
-- | Check if the BangPatterns language pragma is redundant.
isRedundantBangPatterns :: H.Module H.SrcSpanInfo -> Bool
isRedundantBangPatterns m = null
[() | H.PBangPat _ _ <- everything m :: [H.Pat H.SrcSpanInfo]]
|
