diff options
author | Jasper Van der Jeugt <m@jaspervdj.be> | 2012-06-01 15:07:03 +0200 |
---|---|---|
committer | Jasper Van der Jeugt <m@jaspervdj.be> | 2012-06-01 15:07:03 +0200 |
commit | f53dcf0f60df80b5f5fa7071d1b5d6464055b503 (patch) | |
tree | 2208b71237988d0c0d39fe74e2607a9593fb0c67 | |
parent | 73507718f63b7c7dbf04fde7595f6f3f7fdcabb7 (diff) | |
download | stylish-haskell-f53dcf0f60df80b5f5fa7071d1b5d6464055b503.tar.gz |
Remove redundant ViewPatterns
See #4
-rw-r--r-- | .stylish-haskell.yaml | 12 | ||||
-rw-r--r-- | src/StylishHaskell/Config.hs | 13 | ||||
-rw-r--r-- | src/StylishHaskell/Stylish/LanguagePragmas.hs | 27 | ||||
-rw-r--r-- | tests/StylishHaskell/Stylish/LanguagePragmas/Tests.hs | 33 |
4 files changed, 70 insertions, 15 deletions
diff --git a/.stylish-haskell.yaml b/.stylish-haskell.yaml index 688d853..661c516 100644 --- a/.stylish-haskell.yaml +++ b/.stylish-haskell.yaml @@ -1,18 +1,22 @@ stylish: # Convert some ASCII sequences to their Unicode equivalents - - unicode_syntax: {} + # - unicode_syntax: {} # Import cleanup - imports: - # Align import names and import lists + # Align import names and import lists. Default: true. align: true # Language pragmas - - languages_pragmas: {} + - languages_pragmas: + # stylish-haskell can detect redundancy of some language pragmas. If this + # is set to true, it will remove those redundant pragmas. Default: true. + remove_redundant: true # Replace tabs by spaces - tabs: - # Number of spaces to use for each tab + # Number of spaces to use for each tab. Default: 8, as specified by the + # Haskell report. spaces: 8 # Remove trailing whitespace diff --git a/src/StylishHaskell/Config.hs b/src/StylishHaskell/Config.hs index 18c1d24..4b1add8 100644 --- a/src/StylishHaskell/Config.hs +++ b/src/StylishHaskell/Config.hs @@ -14,8 +14,8 @@ import Data.Aeson (FromJSON(..)) import qualified Data.Aeson as A import qualified Data.Aeson.Types as A import qualified Data.ByteString as B -import Data.Map (Map) -import qualified Data.Map as M +import Data.Map (Map) +import qualified Data.Map as M import Data.Yaml (decodeEither) import System.Directory import System.FilePath ((</>)) @@ -45,7 +45,7 @@ instance FromJSON Config where defaultConfig :: Config defaultConfig = Config $ [ StylishHaskell.Stylish.Imports.stylish True - , StylishHaskell.Stylish.LanguagePragmas.stylish + , StylishHaskell.Stylish.LanguagePragmas.stylish True , StylishHaskell.Stylish.TrailingWhitespace.stylish ] @@ -114,18 +114,19 @@ parseStylish val = do -------------------------------------------------------------------------------- parseImports :: A.Object -> A.Parser Stylish parseImports o = StylishHaskell.Stylish.Imports.stylish - <$> o A..: "align" + <$> o A..:? "align" A..!= True -------------------------------------------------------------------------------- parseLanguagePragmas :: A.Object -> A.Parser Stylish -parseLanguagePragmas _ = return StylishHaskell.Stylish.LanguagePragmas.stylish +parseLanguagePragmas o = StylishHaskell.Stylish.LanguagePragmas.stylish + <$> o A..:? "remove_redundant" A..!= True -------------------------------------------------------------------------------- parseTabs :: A.Object -> A.Parser Stylish parseTabs o = StylishHaskell.Stylish.Tabs.stylish - <$> o A..: "spaces" + <$> o A..:? "spaces" A..!= 8 -------------------------------------------------------------------------------- diff --git a/src/StylishHaskell/Stylish/LanguagePragmas.hs b/src/StylishHaskell/Stylish/LanguagePragmas.hs index f4da813..60e3187 100644 --- a/src/StylishHaskell/Stylish/LanguagePragmas.hs +++ b/src/StylishHaskell/Stylish/LanguagePragmas.hs @@ -44,15 +44,19 @@ prettyPragmas pragmas' = -------------------------------------------------------------------------------- -stylish :: Stylish -stylish ls (module', _) +stylish :: Bool -> Stylish +stylish removeRedundant ls (module', _) | null pragmas' = ls | otherwise = applyChanges changes ls where + filterRedundant + | removeRedundant = filter (not . isRedundant module') + | otherwise = id + pragmas' = pragmas $ fmap linesFromSrcSpan module' - deletes = map (delete . fst) pragmas' - uniques = nub $ sort $ concatMap snd pragmas' + uniques = filterRedundant $ nub $ sort $ snd =<< pragmas' loc = firstLocation pragmas' + deletes = map (delete . fst) pragmas' changes = insert loc (prettyPragmas uniques) : deletes @@ -66,3 +70,18 @@ addLanguagePragma pragma modu 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 _ _ = 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]] diff --git a/tests/StylishHaskell/Stylish/LanguagePragmas/Tests.hs b/tests/StylishHaskell/Stylish/LanguagePragmas/Tests.hs index 80a50bc..c802f62 100644 --- a/tests/StylishHaskell/Stylish/LanguagePragmas/Tests.hs +++ b/tests/StylishHaskell/Stylish/LanguagePragmas/Tests.hs @@ -19,12 +19,14 @@ import StylishHaskell.Tests.Util tests :: Test tests = testGroup "StylishHaskell.Stylish.LanguagePragmas.Tests" [ case01 + , case02 + , case03 ] -------------------------------------------------------------------------------- case01 :: Test -case01 = testCase "case 01" $ expected @=? testStylish stylish input +case01 = testCase "case 01" $ expected @=? testStylish (stylish False) input where input = unlines [ "{-# LANGUAGE ViewPatterns #-}" @@ -39,3 +41,32 @@ case01 = testCase "case 01" $ expected @=? testStylish stylish input , "{-# LANGUAGE ViewPatterns #-}" , "module Main where" ] + + +-------------------------------------------------------------------------------- +case02 :: Test +case02 = testCase "case 02" $ expected @=? testStylish (stylish True) input + where + input = unlines + [ "{-# LANGUAGE ViewPatterns #-}" + , "increment ((+ 1) -> x) = x" + ] + + expected = unlines + [ "{-# LANGUAGE ViewPatterns #-}" + , "increment ((+ 1) -> x) = x" + ] + + +-------------------------------------------------------------------------------- +case03 :: Test +case03 = testCase "case 03" $ expected @=? testStylish (stylish True) input + where + input = unlines + [ "{-# LANGUAGE ViewPatterns #-}" + , "increment x = x + 1" + ] + + expected = unlines + [ "increment x = x + 1" + ] |