diff options
| -rw-r--r-- | src/Language/Haskell/Stylish/Step/LanguagePragmas.hs | 47 | ||||
| -rw-r--r-- | stylish-haskell.cabal | 2 | ||||
| -rw-r--r-- | tests/Language/Haskell/Stylish/Step/LanguagePragmas/Tests.hs | 22 |
3 files changed, 55 insertions, 16 deletions
diff --git a/src/Language/Haskell/Stylish/Step/LanguagePragmas.hs b/src/Language/Haskell/Stylish/Step/LanguagePragmas.hs index 8d71c68..a39e88d 100644 --- a/src/Language/Haskell/Stylish/Step/LanguagePragmas.hs +++ b/src/Language/Haskell/Stylish/Step/LanguagePragmas.hs @@ -9,7 +9,7 @@ module Language.Haskell.Stylish.Step.LanguagePragmas -------------------------------------------------------------------------------- -import Data.List (nub, sort) +import qualified Data.Set as S import qualified Language.Haskell.Exts.Annotated as H @@ -41,13 +41,11 @@ firstLocation = minimum . map (blockStart . fst) -------------------------------------------------------------------------------- -verticalPragmas :: [String] -> Lines -verticalPragmas pragmas' = +verticalPragmas :: Int -> [String] -> Lines +verticalPragmas longest pragmas' = [ "{-# LANGUAGE " ++ padRight longest pragma ++ " #-}" | pragma <- pragmas' ] - where - longest = maximum $ map length pragmas' -------------------------------------------------------------------------------- @@ -57,9 +55,26 @@ compactPragmas columns pragmas' = wrap columns "{-# LANGUAGE" 13 $ -------------------------------------------------------------------------------- -prettyPragmas :: Int -> Style -> [String] -> Lines -prettyPragmas _ Vertical = verticalPragmas -prettyPragmas columns Compact = compactPragmas columns +prettyPragmas :: Int -> Int -> Style -> [String] -> Lines +prettyPragmas _ longest Vertical = verticalPragmas longest +prettyPragmas columns _ Compact = compactPragmas columns + + +-------------------------------------------------------------------------------- +-- | Filter redundant (and duplicate) pragmas out of the groups. As a side +-- effect, we also sort the pragmas in their group... +filterRedundant :: (String -> Bool) + -> [(l, [String])] + -> [(l, [String])] +filterRedundant isRedundant' = snd . foldr filterRedundant' (S.empty, []) + where + filterRedundant' (l, xs) (known, zs) + | S.null xs' = (known', zs) + | otherwise = (known', (l, S.toAscList xs') : zs) + where + fxs = filter (not . isRedundant') xs + xs' = S.fromList fxs `S.difference` known + known' = xs' `S.union` known -------------------------------------------------------------------------------- @@ -73,15 +88,17 @@ step' columns style removeRedundant ls (module', _) | null pragmas' = ls | otherwise = applyChanges changes ls where - filterRedundant - | removeRedundant = filter (not . isRedundant module') - | otherwise = id + isRedundant' + | removeRedundant = isRedundant module' + | otherwise = const False 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 + longest = maximum $ map length $ snd =<< pragmas' + groups = [(b, concat pgs) | (b, pgs) <- groupAdjacent pragmas'] + changes = + [ change b (const $ prettyPragmas columns longest style pg) + | (b, pg) <- filterRedundant isRedundant' groups + ] -------------------------------------------------------------------------------- diff --git a/stylish-haskell.cabal b/stylish-haskell.cabal index e59e3d0..18e4a66 100644 --- a/stylish-haskell.cabal +++ b/stylish-haskell.cabal @@ -1,5 +1,5 @@ Name: stylish-haskell -Version: 0.5.4.0 +Version: 0.5.5.0 Synopsis: Haskell code prettifier Homepage: https://github.com/jaspervdj/stylish-haskell License: BSD3 diff --git a/tests/Language/Haskell/Stylish/Step/LanguagePragmas/Tests.hs b/tests/Language/Haskell/Stylish/Step/LanguagePragmas/Tests.hs index 716d56a..d26c6a4 100644 --- a/tests/Language/Haskell/Stylish/Step/LanguagePragmas/Tests.hs +++ b/tests/Language/Haskell/Stylish/Step/LanguagePragmas/Tests.hs @@ -22,6 +22,7 @@ tests = testGroup "Language.Haskell.Stylish.Step.LanguagePragmas.Tests" , testCase "case 02" case02 , testCase "case 03" case03 , testCase "case 04" case04 + , testCase "case 05" case05 ] @@ -91,3 +92,24 @@ case04 = expected @=? testStep (step 80 Compact False) input "TemplateHaskell," , " TypeOperators, ViewPatterns #-}" ] + + +-------------------------------------------------------------------------------- +case05 :: Assertion +case05 = expected @=? testStep (step 80 Vertical False) input + where + input = unlines + [ "{-# LANGUAGE CPP #-}" + , "" + , "#if __GLASGOW_HASKELL__ >= 702" + , "{-# LANGUAGE Trustworthy #-}" + , "#endif" + ] + + expected = unlines + [ "{-# LANGUAGE CPP #-}" + , "" + , "#if __GLASGOW_HASKELL__ >= 702" + , "{-# LANGUAGE Trustworthy #-}" + , "#endif" + ] |