Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Add option to remove pragmas implied by the language variant #455

Open
wants to merge 1 commit into
base: main
Choose a base branch
from
Open

Add option to remove pragmas implied by the language variant #455

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
1 commit
Select commit
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
13 changes: 13 additions & 0 deletions data/stylish-haskell.yaml
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -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
Copy link
Contributor Author

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

  1. I was considering whether there should be a way to retain the former behaviour of remove_redundant: true, i.e., just remove BangPatterns and ViewPatterns when unused in the module. I decided not to add it because I couldn't think of a good way to make it fit the language_variant option (which language variant would that option be?) and the usefulness of the former behaviour is rather limited, IMHO.

  2. What about projects that are mix of different language variants? The mix would be across components (library vs. testsuite, etc.)


# 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.
Expand Down
1 change: 1 addition & 0 deletions lib/Language/Haskell/Stylish.hs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down
6 changes: 6 additions & 0 deletions lib/Language/Haskell/Stylish/Config.hs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -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 =
Expand All @@ -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)
]


--------------------------------------------------------------------------------
Expand Down
110 changes: 103 additions & 7 deletions lib/Language/Haskell/Stylish/Step/LanguagePragmas.hs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -4,6 +4,7 @@
{-# LANGUAGE OverloadedStrings #-}
module Language.Haskell.Stylish.Step.LanguagePragmas
( Style (..)
, LanguageVariant (..)
, step
-- * Utilities
, addLanguagePragma
Expand Down Expand Up @@ -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

Expand Down Expand Up @@ -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"
]
90 changes: 76 additions & 14 deletions tests/Language/Haskell/Stylish/Step/LanguagePragmas/Tests.hs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand All @@ -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 #-}"
Expand All @@ -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"
Expand All @@ -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"
Expand All @@ -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 #-}"
Expand All @@ -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"
Expand All @@ -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 #-}"
Expand All @@ -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 #-}"
Expand All @@ -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 #-}"
Expand All @@ -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"
, " #-}"
Expand All @@ -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 #-}"
]
Expand All @@ -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 #-}"
Expand All @@ -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 #-}"
Expand All @@ -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 #-}"
Expand All @@ -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 #-}"
Expand All @@ -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 #-}"
]