diff --git a/data/stylish-haskell.yaml b/data/stylish-haskell.yaml index 51441363..df79ccc4 100644 --- a/data/stylish-haskell.yaml +++ b/data/stylish-haskell.yaml @@ -426,6 +426,19 @@ steps: # is set to true, it will remove those redundant pragmas. Default: true. remove_redundant: true + # When remove_redundant is enabled, extensions that are implied by the + # chosen language variant will also be removed. The following language + # variants are supported: + # + # - GHC2021 + # + # - Haskell2010 + # + # - Haskell98 + # + # Default: Haskell2010 + language_variant: Haskell2010 + # Language prefix to be used for pragma declaration, this allows you to # use other options non case-sensitive like "language" or "Language". # If a non correct String is provided, it will default to: LANGUAGE. diff --git a/lib/Language/Haskell/Stylish.hs b/lib/Language/Haskell/Stylish.hs index a767889e..ede671f7 100644 --- a/lib/Language/Haskell/Stylish.hs +++ b/lib/Language/Haskell/Stylish.hs @@ -66,6 +66,7 @@ languagePragmas :: Maybe Int -- ^ columns -> LanguagePragmas.Style -> Bool -- ^ Pad to same length in vertical mode? -> Bool -- ^ remove redundant? + -> LanguagePragmas.LanguageVariant -> String -- ^ language prefix -> Step languagePragmas = LanguagePragmas.step diff --git a/lib/Language/Haskell/Stylish/Config.hs b/lib/Language/Haskell/Stylish/Config.hs index 3e62108c..e1220933 100644 --- a/lib/Language/Haskell/Stylish/Config.hs +++ b/lib/Language/Haskell/Stylish/Config.hs @@ -334,6 +334,7 @@ parseLanguagePragmas config o = LanguagePragmas.step <*> (o A..:? "style" >>= parseEnum styles LanguagePragmas.Vertical) <*> o A..:? "align" A..!= True <*> o A..:? "remove_redundant" A..!= True + <*> (o A..:? "language_variant" >>= parseEnum languageVariants LanguagePragmas.Haskell2010) <*> mkLanguage o where styles = @@ -342,6 +343,11 @@ parseLanguagePragmas config o = LanguagePragmas.step , ("compact_line", LanguagePragmas.CompactLine) , ("vertical_compact", LanguagePragmas.VerticalCompact) ] + languageVariants = + [ ("GHC2021", LanguagePragmas.GHC2021) + , ("Haskell2010", LanguagePragmas.Haskell2010) + , ("Haskell98", LanguagePragmas.Haskell98) + ] -------------------------------------------------------------------------------- diff --git a/lib/Language/Haskell/Stylish/Step/LanguagePragmas.hs b/lib/Language/Haskell/Stylish/Step/LanguagePragmas.hs index 24b2c886..27159ebb 100644 --- a/lib/Language/Haskell/Stylish/Step/LanguagePragmas.hs +++ b/lib/Language/Haskell/Stylish/Step/LanguagePragmas.hs @@ -4,6 +4,7 @@ {-# LANGUAGE OverloadedStrings #-} module Language.Haskell.Stylish.Step.LanguagePragmas ( Style (..) + , LanguageVariant (..) , step -- * Utilities , addLanguagePragma @@ -113,19 +114,20 @@ filterRedundant isRedundant' = snd . foldr filterRedundant' (S.empty, []) . fmap known' = xs' `S.union` known -------------------------------------------------------------------------------- -step :: Maybe Int -> Style -> Bool -> Bool -> String -> Step -step = ((((makeStep "LanguagePragmas" .) .) .) .) . step' +step :: Maybe Int -> Style -> Bool -> Bool -> LanguageVariant -> String -> Step +step = (((((makeStep "LanguagePragmas" .) .) .) .) .) . step' -------------------------------------------------------------------------------- -step' :: Maybe Int -> Style -> Bool -> Bool -> String -> Lines -> Module -> Lines -step' columns style align removeRedundant lngPrefix ls m +step' :: Maybe Int -> Style -> Bool -> Bool -> LanguageVariant -> String -> Lines -> Module -> Lines +step' columns style align removeRedundant lngVariant lngPrefix ls m | null languagePragmas = ls | otherwise = Editor.apply changes ls where - isRedundant' - | removeRedundant = isRedundant m - | otherwise = const False + isRedundant' prag + | removeRedundant = isRedundant m prag || + isRedundantWrtLanguageVariant lngVariant prag + | otherwise = False languagePragmas = moduleLanguagePragmas m @@ -200,3 +202,97 @@ isRedundantBangPatterns modul = getMatchStrict (GHC.Match _ ctx _ _) = case ctx of GHC.FunRhs _ _ GHC.SrcStrict -> [()] _ -> [] + + +-------------------------------------------------------------------------------- +data LanguageVariant + = GHC2021 + | Haskell2010 + | Haskell98 + deriving (Eq, Show) + + +-------------------------------------------------------------------------------- +isRedundantWrtLanguageVariant :: LanguageVariant -> String -> Bool +isRedundantWrtLanguageVariant lngVariant prag = + prag `S.member` case lngVariant of + GHC2021 -> ghc2021Pragmas + Haskell2010 -> haskell2010Pragmas + Haskell98 -> haskell98Pragmas + where + ghc2021Pragmas = S.fromList + [ "BangPatterns" + , "BinaryLiterals" + , "ConstrainedClassMethods" + , "ConstraintKinds" + , "DeriveDataTypeable" + , "DeriveFoldable" + , "DeriveFunctor" + , "DeriveGeneric" + , "DeriveLift" + , "DeriveTraversable" + , "DoAndIfThenElse" + , "EmptyCase" + , "EmptyDataDecls" + , "EmptyDataDeriving" + , "ExistentialQuantification" + , "ExplicitForAll" + , "FieldSelectors" + , "FlexibleContexts" + , "FlexibleInstances" + , "ForeignFunctionInterface" + , "GADTSyntax" + , "GeneralisedNewtypeDeriving" + , "GeneralizedNewtypeDeriving" + , "HexFloatLiterals" + , "ImplicitPrelude" + , "ImportQualifiedPost" + , "InstanceSigs" + , "KindSignatures" + , "MonomorphismRestriction" + , "MultiParamTypeClasses" + , "NamedFieldPuns" + , "NamedWildCards" + , "NumericUnderscores" + , "PatternGuards" + , "PolyKinds" + , "PostfixOperators" + , "RankNTypes" + , "RelaxedPolyRec" + , "ScopedTypeVariables" + , "StandaloneDeriving" + , "StandaloneKindSignatures" + , "StarIsType" + , "TraditionalRecordSyntax" + , "TupleSections" + , "TypeApplications" + , "TypeOperators" + , "TypeSynonymInstances" + ] + + haskell2010Pragmas = S.fromList + [ "CUSKs" + , "DatatypeContexts" + , "DoAndIfThenElse" + , "EmptyDataDecls" + , "FieldSelectors" + , "ForeignFunctionInterface" + , "ImplicitPrelude" + , "MonomorphismRestriction" + , "PatternGuards" + , "RelaxedPolyRec" + , "StarIsType" + , "TraditionalRecordSyntax" + ] + + haskell98Pragmas = S.fromList + [ "CUSKs" + , "DatatypeContexts" + , "FieldSelectors" + , "ImplicitPrelude" + , "MonomorphismRestriction" + , "NPlusKPatterns" + , "NondecreasingIndentation" + , "StarIsType" + , "TraditionalRecordSyntax" + ] diff --git a/tests/Language/Haskell/Stylish/Step/LanguagePragmas/Tests.hs b/tests/Language/Haskell/Stylish/Step/LanguagePragmas/Tests.hs index ecb6a7f9..a7a5ce8d 100644 --- a/tests/Language/Haskell/Stylish/Step/LanguagePragmas/Tests.hs +++ b/tests/Language/Haskell/Stylish/Step/LanguagePragmas/Tests.hs @@ -33,6 +33,10 @@ tests = testGroup "Language.Haskell.Stylish.Step.LanguagePragmas.Tests" , testCase "case 12" case12 , testCase "case 13" case13 , testCase "case 14" case14 + , testCase "case 15" case15 + , testCase "case 16" case16 + , testCase "case 17" case17 + , testCase "case 18" case18 ] lANG :: String @@ -41,7 +45,7 @@ lANG = "LANGUAGE" -------------------------------------------------------------------------------- case01 :: Assertion case01 = assertSnippet - (step (Just 80) Vertical True False lANG) + (step (Just 80) Vertical True False Haskell2010 lANG) [ "{-# LANGUAGE ViewPatterns #-}" , "{-# LANGUAGE TemplateHaskell, ViewPatterns #-}" , "{-# LANGUAGE ScopedTypeVariables #-}" @@ -58,7 +62,7 @@ case01 = assertSnippet -------------------------------------------------------------------------------- case02 :: Assertion case02 = assertSnippet - (step (Just 80) Vertical True True lANG) + (step (Just 80) Vertical True True Haskell2010 lANG) [ "{-# LANGUAGE BangPatterns #-}" , "{-# LANGUAGE ViewPatterns #-}" , "increment ((+ 1) -> x) = x" @@ -72,7 +76,7 @@ case02 = assertSnippet -------------------------------------------------------------------------------- case03 :: Assertion case03 = assertSnippet - (step (Just 80) Vertical True True lANG) + (step (Just 80) Vertical True True Haskell2010 lANG) [ "{-# LANGUAGE BangPatterns #-}" , "{-# LANGUAGE ViewPatterns #-}" , "increment x = case x of !_ -> x + 1" @@ -86,7 +90,7 @@ case03 = assertSnippet -------------------------------------------------------------------------------- case04 :: Assertion case04 = assertSnippet - (step (Just 80) Compact True False lANG) + (step (Just 80) Compact True False Haskell2010 lANG) [ "{-# LANGUAGE TypeOperators, StandaloneDeriving, DeriveDataTypeable," , " TemplateHaskell #-}" , "{-# LANGUAGE TemplateHaskell, ViewPatterns #-}" @@ -101,7 +105,7 @@ case04 = assertSnippet -------------------------------------------------------------------------------- case05 :: Assertion case05 = assertSnippet - (step (Just 80) Vertical True False lANG) + (step (Just 80) Vertical True False Haskell2010 lANG) [ "{-# LANGUAGE CPP #-}" , "" , "#if __GLASGOW_HASKELL__ >= 702" @@ -120,7 +124,7 @@ case05 = assertSnippet -------------------------------------------------------------------------------- case06 :: Assertion case06 = assertSnippet - (step (Just 80) CompactLine True False lANG) + (step (Just 80) CompactLine True False Haskell2010 lANG) [ "{-# LANGUAGE TypeOperators, StandaloneDeriving, DeriveDataTypeable," , " TemplateHaskell #-}" , "{-# LANGUAGE TemplateHaskell, ViewPatterns #-}" @@ -133,7 +137,7 @@ case06 = assertSnippet -------------------------------------------------------------------------------- case07 :: Assertion case07 = assertSnippet - (step (Just 80) Vertical False False lANG) + (step (Just 80) Vertical False False Haskell2010 lANG) [ "{-# LANGUAGE ViewPatterns #-}" , "{-# LANGUAGE TemplateHaskell, ViewPatterns #-}" , "{-# LANGUAGE ScopedTypeVariables, NoImplicitPrelude #-}" @@ -151,7 +155,7 @@ case07 = assertSnippet -------------------------------------------------------------------------------- case08 :: Assertion case08 = assertSnippet - (step (Just 80) CompactLine False False lANG) + (step (Just 80) CompactLine False False Haskell2010 lANG) [ "{-# LANGUAGE TypeOperators, StandaloneDeriving, DeriveDataTypeable," , " TemplateHaskell #-}" , "{-# LANGUAGE TemplateHaskell, ViewPatterns #-}" @@ -165,7 +169,7 @@ case08 = assertSnippet -------------------------------------------------------------------------------- case09 :: Assertion case09 = assertSnippet - (step (Just 80) Compact True False lANG) + (step (Just 80) Compact True False Haskell2010 lANG) [ "{-# LANGUAGE DefaultSignatures, FlexibleInstances, LambdaCase, " ++ "TypeApplications" , " #-}" @@ -177,7 +181,7 @@ case09 = assertSnippet -------------------------------------------------------------------------------- case10 :: Assertion case10 = assertSnippet - (step (Just 80) Compact True False lANG) + (step (Just 80) Compact True False Haskell2010 lANG) [ "{-# LANGUAGE NondecreasingIndentation, ScopedTypeVariables," , " TypeApplications #-}" ] @@ -188,7 +192,7 @@ case10 = assertSnippet -------------------------------------------------------------------------------- case11 :: Assertion case11 = assertSnippet - (step (Just 80) Vertical False False "language") + (step (Just 80) Vertical False False Haskell2010 "language") [ "{-# LANGUAGE ViewPatterns #-}" , "{-# LANGUAGE TemplateHaskell, ViewPatterns #-}" , "{-# LANGUAGE ScopedTypeVariables, NoImplicitPrelude #-}" @@ -206,7 +210,7 @@ case11 = assertSnippet -------------------------------------------------------------------------------- case12 :: Assertion case12 = assertSnippet - (step Nothing Compact False False "language") + (step Nothing Compact False False Haskell2010 "language") [ "{-# LANGUAGE ViewPatterns, OverloadedStrings #-}" , "{-# LANGUAGE TemplateHaskell, ViewPatterns #-}" , "{-# LANGUAGE ScopedTypeVariables, NoImplicitPrelude #-}" @@ -221,7 +225,7 @@ case12 = assertSnippet -------------------------------------------------------------------------------- case13 :: Assertion case13 = assertSnippet - (step Nothing Vertical True True lANG) input input + (step Nothing Vertical True True Haskell2010 lANG) input input where input = [ "{-# LANGUAGE BangPatterns #-}" @@ -231,7 +235,7 @@ case13 = assertSnippet -------------------------------------------------------------------------------- case14 :: Assertion -case14 = assertSnippet (step Nothing VerticalCompact False False "language") +case14 = assertSnippet (step Nothing VerticalCompact False False Haskell2010 "language") [ "{-# LANGUAGE ViewPatterns, OverloadedStrings #-}" , "{-# LANGUAGE TemplateHaskell, ViewPatterns #-}" , "{-# LANGUAGE ScopedTypeVariables, NoImplicitPrelude #-}" @@ -246,3 +250,61 @@ case14 = assertSnippet (step Nothing VerticalCompact False False "language") , " #-}" , "module Main where" ] + +-------------------------------------------------------------------------------- +case15 :: Assertion +case15 = assertSnippet + (step (Just 80) Vertical False True Haskell98 lANG) + [ "{-# LANGUAGE DeriveGeneric #-}" + , "{-# LANGUAGE PatternGuards #-}" + , "{-# LANGUAGE StarIsType #-}" + , "{-# LANGUAGE TypeFamilies #-}" + ] + + [ "{-# LANGUAGE DeriveGeneric #-}" + , "{-# LANGUAGE PatternGuards #-}" + , "{-# LANGUAGE TypeFamilies #-}" + ] + +-------------------------------------------------------------------------------- +case16 :: Assertion +case16 = assertSnippet + (step (Just 80) Vertical False True Haskell2010 lANG) + [ "{-# LANGUAGE DeriveGeneric #-}" + , "{-# LANGUAGE PatternGuards #-}" + , "{-# LANGUAGE StarIsType #-}" + , "{-# LANGUAGE TypeFamilies #-}" + ] + + [ "{-# LANGUAGE DeriveGeneric #-}" + , "{-# LANGUAGE TypeFamilies #-}" + ] + +-------------------------------------------------------------------------------- +case17 :: Assertion +case17 = assertSnippet + (step (Just 80) Vertical False True GHC2021 lANG) + [ "{-# LANGUAGE DeriveGeneric #-}" + , "{-# LANGUAGE PatternGuards #-}" + , "{-# LANGUAGE StarIsType #-}" + , "{-# LANGUAGE TypeFamilies #-}" + ] + + [ "{-# LANGUAGE TypeFamilies #-}" + ] + +-------------------------------------------------------------------------------- +case18 :: Assertion +case18 = assertSnippet + (step (Just 80) Vertical False False GHC2021 lANG) + [ "{-# LANGUAGE DeriveGeneric #-}" + , "{-# LANGUAGE PatternGuards #-}" + , "{-# LANGUAGE StarIsType #-}" + , "{-# LANGUAGE TypeFamilies #-}" + ] + + [ "{-# LANGUAGE DeriveGeneric #-}" + , "{-# LANGUAGE PatternGuards #-}" + , "{-# LANGUAGE StarIsType #-}" + , "{-# LANGUAGE TypeFamilies #-}" + ]