import-style-plugin (empty) → 0.1.0.0
raw patch · 9 files changed
+539/−0 lines, 9 filesdep +aesondep +basedep +containers
Dependencies added: aeson, base, containers, ghc, yaml
Files
- CHANGELOG.md +0/−0
- LICENSE +20/−0
- README.md +118/−0
- import-style-plugin.cabal +31/−0
- src/ImportStylePlugin.hs +105/−0
- src/ImportStylePlugin/Compat.hs +152/−0
- src/ImportStylePlugin/Config.hs +77/−0
- src/ImportStylePlugin/Derived.hs +12/−0
- src/ImportStylePlugin/Yaml.hs +24/−0
+ CHANGELOG.md view
+ LICENSE view
@@ -0,0 +1,20 @@+Copyright (c) 2024 goosedb++Permission is hereby granted, free of charge, to any person obtaining+a copy of this software and associated documentation files (the+"Software"), to deal in the Software without restriction, including+without limitation the rights to use, copy, modify, merge, publish,+distribute, sublicense, and/or sell copies of the Software, and to+permit persons to whom the Software is furnished to do so, subject to+the following conditions:++The above copyright notice and this permission notice shall be included+in all copies or substantial portions of the Software.++THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,+EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF+MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.+IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY+CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT,+TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE+SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
+ README.md view
@@ -0,0 +1,118 @@+# Import style GHC plugin++The plugin helps to unify imports style via compile warnings/errors++Tested with:+ * 9.2.7+ * 9.4.8+ * 9.6.4+ * 9.8.2++## Usage++### Yaml config+#### Enable plugin in your cabal file:+```cabal+ build-depends: ..., import-style-plugin, ...++ ghc-options: -fplugin ImportStylePlugin.Yaml -fplugin-opt ImportStylePlugin.Yaml:<path-to-config>+```+#### Write config:++```yaml+qualificationStyle: Post | Pre | null++bannedModules: # can be null+ Module.Name:+ severity: Error | Warning+ why: string with ban reason++importRules: # can be null+ DataModuleName:+ severity: Error | Warning+ rules:+ - qualification: Required | Forbidden | null+ aliases:+ # Either `exactly`, so alias can't be omitted + exactly:+ - Module.Alias+ - Alias+ # or just list, so alias can be omitted+ - Module.Alias+ - Alias+ # or null+ importedNames:+ # Either whitelist, so import should be + # accompanied with explicit import list + whitelist:+ - pattern (:|>) + - type (+)+ - foo+ # or blacklist, so import should be + # accompanied with explicit hiding list with all these names+ # or explicit import list shouldn't contain any of these names + blacklist:+ - pattern (:|>) + - type (+)+ - foo+ # or null+```+#### Here is example:+```yaml+qualificationStyle: Post++bannedModules:+ # Forbids Data.Map at all+ Data.Map:+ severity: Error+ why: Use 'Data.Map.Strict'++importRules:+ # Either+ # import Data.Text (Text)+ # or+ # import Data.Text qualified as Text+ Data.Text:+ severity: Warning+ rules:+ - qualification: Required+ aliases:+ exactly: + - Text++ - qualification: Forbidden+ importedNames:+ whitelist: + - Text+```+### Derived plugin+It can be useful if you have a lot of projects with one style. So you haven't to copy paste config but just use _style_ as library++ 1. Create library package+ 2. Add to deps `import-style-plugin`+ 3. Create module `YourPlugin.hs` (or something like that, it's unimportant)+ 4. Put there + ```haskell+ module YourPlugin where+ + import ImportStylePlugin.Derived qualified as Derived+ import ImportStylePlugin.Config as Cfg++ -- variable name `plugin` IS important+ -- Configure your style with Haskell types from `ImportStylePlugin.Config`+ plugin = Derived.plugin+ ImportsStyle+ { qualificationStyle = ...+ , bannedModules = ...+ , importRules = ... + }+ ```+ 5. Plug in+ ```cabal+ build-depends: ..., your-import-style-plugin, ...++ ghc-options: -fplugin YourPlugin+ ```+## Tips+### Custom warning+Since ghc-9.8 the plugin introduces custom warning `x-import-style`. So if you set `-Werror` but still want to style warnings be warnings use ghc option `-Wwarn=x-import-style`. You also can disable at all warnings with `-Wno-x-import-style`
+ import-style-plugin.cabal view
@@ -0,0 +1,31 @@+cabal-version: 3.0+name: import-style-plugin+version: 0.1.0.0+license: MIT+license-file: LICENSE+author: goosedb+maintainer: goosedb@yandex.ru+build-type: Simple+extra-doc-files: CHANGELOG.md, README.md+homepage: https://github.com/goosedb/import-style-plugin++category: Development+synopsis: Helps maintain consistency of imports++common warnings+ ghc-options: -Wall++library+ import: warnings+ exposed-modules: ImportStylePlugin+ , ImportStylePlugin.Yaml+ , ImportStylePlugin.Derived+ , ImportStylePlugin.Config+ , ImportStylePlugin.Compat+ build-depends: base >=4.11 && <4.20+ , ghc >= 9.2 && < 9.10+ , containers+ , yaml+ , aeson+ hs-source-dirs: src+ default-language: Haskell2010
+ src/ImportStylePlugin.hs view
@@ -0,0 +1,105 @@+{-# LANGUAGE BlockArguments #-}+{-# LANGUAGE DerivingStrategies #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE NamedFieldPuns #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE ViewPatterns #-}+module ImportStylePlugin where++import Control.Monad (forM_, unless)+import Data.Functor (($>), (<&>))+import Data.List (intercalate, intersperse)+import qualified Data.Map.Strict as Map+import Data.Maybe (catMaybes)+import qualified Data.Set as Set+import Data.String (fromString)+import qualified GHC.Hs as Ghc+import qualified GHC.Plugins as Ghc+import qualified GHC.Tc.Types as Ghc+import ImportStylePlugin.Compat (getExplicitlyHiddenNames, getExplicitlyImportedNames, report)+import ImportStylePlugin.Config as Config++importPlugin ::+ ImportsStyle ->+ Ghc.TcGblEnv ->+ Ghc.TcM Ghc.TcGblEnv+importPlugin ImportsStyle{..} e@Ghc.TcGblEnv{tcg_rn_imports} = corrections $> e+ where+ mkWord = \case+ Error -> "must"+ Warning -> "should"++ corrections = forM_ tcg_rn_imports \(Ghc.L Ghc.SrcSpanAnn{..} importDecl@Ghc.ImportDecl{..}) ->+ let (Ghc.L _ (Ghc.moduleNameString -> moduleName)) = ideclName+ in do+ case qualificationStyle of+ _ | ideclQualified == Ghc.NotQualified -> pure ()+ Just Pre | ideclQualified /= Ghc.QualifiedPre -> report Error "Use prefix qualification" (Just locA)+ Just Post | ideclQualified /= Ghc.QualifiedPost -> report Error "Use postfix qualification" (Just locA)+ _ -> pure ()++ case Map.lookup (Config.ModuleName moduleName) bannedModules of+ Just Ban{..} -> report severity (fromString why) (Just locA)+ Nothing -> maybe+ do pure ()+ do+ \ImportRules{..} -> unless (any (isImportValid importDecl) rules) do+ let header = fromString $ "Import " <> mkWord severity <> " satisfy the following rules:"+ let allStringRules = Ghc.vcat $ (header :) $ intersperse "or" $ map (Ghc.vcat . stringifyRule severity) rules+ report severity allStringRules (Just locA)+ do Map.lookup (Config.ModuleName moduleName) importRules++ stringifyRule severity ImportRule{..} =+ map (fromString . (" * " <>)) $+ catMaybes+ [ qualification <&> \case+ Required -> "Module " <> word <> " be qualified"+ Forbidden -> "Module " <> word <> " not be qualified"+ , let common (Set.toList -> allowed) =+ "Alias " <> word <> " be " <> case allowed of+ [name] -> name+ _ -> "one of " <> commaSep allowed+ in aliases <&> \case+ Exactly allowed -> if Set.null allowed then "Import " <> word <> " not have alias" else common allowed+ OrOmitted allowed -> common allowed <> " or alias can be omitted"+ , importedNames <&> \case+ BlackList names -> "Module " <> word <> " not import the following names: " <> printNamesList names+ WhiteList names | Set.null names -> "Module" <> word <> " not import names explicitly"+ WhiteList names -> "Module " <> word <> " import only the following names: " <> printNamesList names+ ]+ where+ printNamesList = commaSep . Set.toList+ commaSep = intercalate ", "++ word = mkWord severity++ isImportValid :: Ghc.ImportDecl Ghc.GhcRn -> ImportRule -> Bool+ isImportValid decl@Ghc.ImportDecl{..} ImportRule{..} =+ isQualificationValid+ && areImportedNamesValid+ && isAliasValid+ where+ isQualificationValid = case qualification of+ Just Required -> ideclQualified /= Ghc.NotQualified+ Just Forbidden -> ideclQualified == Ghc.NotQualified+ Nothing -> True++ isAliasValid = case aliases of+ Just (Exactly allowedAliases) -> oneOfAllowed False allowedAliases+ Just (OrOmitted allowedAliases) -> oneOfAllowed True allowedAliases+ Nothing -> True+ where+ oneOfAllowed def allowed = maybe+ do def+ do \(Ghc.L _ name) -> Ghc.moduleNameString name `Set.member` allowed+ do ideclAs++ areImportedNamesValid = case importedNames of+ Just (WhiteList allowedNames) ->+ maybe False (all (`Set.member` allowedNames)) (getExplicitlyImportedNames decl)+ Just (BlackList forbiddenNames) ->+ maybe True (Set.null . (forbiddenNames `Set.difference`) . Set.fromList) (getExplicitlyHiddenNames decl)+ && maybe False (not . any (`Set.member` forbiddenNames)) (getExplicitlyImportedNames decl)+ Nothing -> True
+ src/ImportStylePlugin/Compat.hs view
@@ -0,0 +1,152 @@+{- FOURMOLU_DISABLE -}+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE CPP #-}+{-# LANGUAGE BlockArguments #-}+{-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE OverloadedStrings #-}+module ImportStylePlugin.Compat where++#if __GLASGOW_HASKELL__ >= 908 && __GLASGOW_HASKELL__ < 910+import qualified GHC as Ghc+import qualified GHC.Utils.Outputable as Ghc+import qualified GHC.Types.Error as Ghc+import qualified GHC.Tc.Utils.Monad as Ghc+import qualified GHC.Tc.Errors.Types as Ghc+import qualified GHC.Unit.Module.Warnings as Ghc+#endif++#if __GLASGOW_HASKELL__ >= 906 && __GLASGOW_HASKELL__ < 908+import qualified GHC as Ghc+import qualified GHC.Types.Error as Ghc+import qualified GHC.Tc.Utils.Monad as Ghc+import qualified GHC.Tc.Errors.Types as Ghc+import qualified GHC.Utils.Outputable as Ghc+#endif++#if __GLASGOW_HASKELL__ >= 904 && __GLASGOW_HASKELL__ < 906+import qualified GHC as Ghc+import qualified GHC.Tc.Types as Ghc+import qualified GHC.Utils.Error as Ghc+import qualified GHC.Tc.Utils.Monad as Ghc+import qualified GHC.Tc.Errors.Types as Ghc+import qualified GHC.Types.Error as Ghc+import qualified GHC.Driver.Ppr as Ghc+#endif++#if __GLASGOW_HASKELL__ >= 902 && __GLASGOW_HASKELL__ < 904+import qualified GHC as Ghc+import qualified GHC.Utils.Outputable as Ghc+import qualified GHC.Tc.Utils.Monad as Ghc+import qualified GHC.Driver.Flags as Ghc+#endif++import ImportStylePlugin.Config as Cfg++getRawNames :: [Ghc.GenLocated l (Ghc.IE Ghc.GhcRn)] -> [String]+getRawNames names =+ [ Ghc.showPprUnsafe n+ | Ghc.L+ _+ n <-+ names+ ] ++getExplicitlyImportedNames :: Ghc.ImportDecl Ghc.GhcRn -> Maybe [String]+getExplicitlyImportedNames Ghc.ImportDecl {..} =+ case +#if __GLASGOW_HASKELL__ >= 906 + ideclImportList +#else + ideclHiding+#endif+ of+ Just + (+#if __GLASGOW_HASKELL__ >= 906 + Ghc.Exactly+#else + False+#endif+ , Ghc.L _ names+ ) -> Just (getRawNames names)+ _ -> Nothing++getExplicitlyHiddenNames :: Ghc.ImportDecl Ghc.GhcRn -> Maybe [String]+getExplicitlyHiddenNames Ghc.ImportDecl {..} =+ case +#if __GLASGOW_HASKELL__ >= 906 + ideclImportList +#else + ideclHiding+#endif+ of+ Just + ( +#if __GLASGOW_HASKELL__ >= 906 + Ghc.EverythingBut+#else + True+#endif+ , Ghc.L _ names) -> Just (getRawNames names)+ _ -> Nothing++++#if __GLASGOW_HASKELL__ >= 908 && __GLASGOW_HASKELL__ < 910+report :: Severity -> Ghc.SDoc -> Maybe Ghc.SrcSpan -> Ghc.TcRn ()+report severity msg loc =+ maybe Ghc.addDiagnostic Ghc.addDiagnosticAt loc+ . Ghc.TcRnUnknownMessage+ . Ghc.mkSimpleUnknownDiagnostic+ $ Ghc.DiagnosticMessage+ { Ghc.diagMessage = Ghc.mkSimpleDecorated msg+ , Ghc.diagReason = case severity of+ Error -> Ghc.ErrorWithoutFlag+ Warning -> Ghc.WarningWithCategory (Ghc.WarningCategory "x-import-style")+ , Ghc.diagHints = []+ }+#endif++#if __GLASGOW_HASKELL__ >= 906 && __GLASGOW_HASKELL__ < 908+report :: Severity -> Ghc.SDoc -> Maybe Ghc.SrcSpan -> Ghc.TcRn ()+report severity msg loc =+ maybe Ghc.addDiagnostic Ghc.addDiagnosticAt loc+ . Ghc.TcRnUnknownMessage+ . Ghc.UnknownDiagnostic+ $ Ghc.DiagnosticMessage+ { Ghc.diagMessage = Ghc.mkSimpleDecorated msg+ , Ghc.diagReason = case severity of+ Error -> Ghc.ErrorWithoutFlag+ Warning -> Ghc.WarningWithoutFlag + , Ghc.diagHints = []+ }+#endif++ +#if __GLASGOW_HASKELL__ >= 904 && __GLASGOW_HASKELL__ < 906+report :: Severity -> Ghc.SDoc -> Maybe Ghc.SrcSpan -> Ghc.TcRn ()+report severity msg loc = + maybe Ghc.addDiagnostic Ghc.addDiagnosticAt loc+ . Ghc.TcRnUnknownMessage+ $ Ghc.DiagnosticMessage+ { Ghc.diagMessage = Ghc.mkSimpleDecorated msg+ , Ghc.diagReason = case severity of+ Error -> Ghc.ErrorWithoutFlag+ Warning -> Ghc.WarningWithoutFlag+ , Ghc.diagHints = []+ }+#endif+++#if __GLASGOW_HASKELL__ >= 902 && __GLASGOW_HASKELL__ < 904+report :: Severity -> Ghc.SDoc -> Maybe Ghc.SrcSpan -> Ghc.TcRn ()+report severity msg loc = + maybe + do case severity of+ Error -> Ghc.addErr msg+ Warning -> Ghc.addWarn Ghc.NoReason msg+ do \l -> case severity of+ Error -> Ghc.addErrAt l msg+ Warning -> Ghc.addWarnAt Ghc.NoReason l msg+ do loc +#endif
+ src/ImportStylePlugin/Config.hs view
@@ -0,0 +1,77 @@+{-# LANGUAGE BlockArguments #-}+{-# LANGUAGE DeriveAnyClass #-}+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE DerivingStrategies #-}+{-# LANGUAGE DuplicateRecordFields #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE OverloadedStrings #-}++module ImportStylePlugin.Config where++import Control.Applicative ((<|>))+import Data.Aeson (FromJSON (..), FromJSONKey, Value (..), withObject, (.:))+import qualified Data.Map.Strict as Map+import Data.Set (Set)+import Data.String (IsString)+import GHC.Generics (Generic)++-- | Report either error or warning during compilation+data Severity = Error | Warning+ deriving (Generic, FromJSON, Show)++data Qualification = Required | Forbidden+ deriving (Generic, FromJSON, Show)++data ModuleAliases = Exactly (Set String) | OrOmitted (Set String)+ deriving (Show)++data NamesList = BlackList (Set String) | WhiteList (Set String)+ deriving (Show)++data ImportRule = ImportRule+ { qualification :: Maybe Qualification+ -- ^ @'Nothing'@ means "don\'t care"+ , aliases :: Maybe ModuleAliases+ -- ^ @'Nothing'@ means "don\'t care"+ , importedNames :: Maybe NamesList+ -- ^ @'Nothing'@ means "don\'t care"+ }+ deriving (Generic, FromJSON, Show)++data QualificationStyle = Post | Pre+ deriving (Generic, FromJSON, Show)++data ImportRules = ImportRules+ { rules :: [ImportRule]+ , severity :: Severity+ }+ deriving (Generic, FromJSON, Show)++data Ban = Ban+ { severity :: Severity+ , why :: String+ -- ^ ban reason+ }+ deriving (Generic, FromJSON, Show)++data ImportsStyle+ = ImportsStyle+ { qualificationStyle :: Maybe QualificationStyle+ -- ^ @'Nothing'@ means "don\'t care"+ , bannedModules :: Map.Map ModuleName Ban+ , importRules :: Map.Map ModuleName ImportRules+ }+ deriving (Generic, FromJSON, Show)++newtype ModuleName = ModuleName String+ deriving (Eq, Ord)+ deriving newtype (FromJSONKey, IsString, Show)++instance FromJSON NamesList where+ parseJSON = withObject "NamesList" \o ->+ BlackList <$> o .: "blacklist" <|> WhiteList <$> o .: "whitelist"++instance FromJSON ModuleAliases where+ parseJSON (Object o) = Exactly <$> o .: "exactly"+ parseJSON o = OrOmitted <$> parseJSON o
+ src/ImportStylePlugin/Derived.hs view
@@ -0,0 +1,12 @@+module ImportStylePlugin.Derived where++import qualified GHC.Plugins as Ghc+import ImportStylePlugin+import ImportStylePlugin.Config++plugin :: ImportsStyle -> Ghc.Plugin+plugin style =+ Ghc.defaultPlugin+ { Ghc.typeCheckResultAction = \_ _ c -> importPlugin style c+ , Ghc.pluginRecompile = Ghc.purePlugin+ }
+ src/ImportStylePlugin/Yaml.hs view
@@ -0,0 +1,24 @@+{-# LANGUAGE LambdaCase #-}++module ImportStylePlugin.Yaml where++import Control.Monad.IO.Class (MonadIO (..))+import Data.Functor (($>))+import Data.String (IsString (..))+import Data.Yaml (decodeFileEither, prettyPrintParseException)+import qualified GHC.Plugins as Ghc+import ImportStylePlugin (importPlugin)+import ImportStylePlugin.Compat (report)+import ImportStylePlugin.Config (Severity (..))++plugin :: Ghc.Plugin+plugin =+ Ghc.defaultPlugin+ { Ghc.typeCheckResultAction = \opts _ a -> do+ case opts of+ [filepath] -> do+ liftIO (decodeFileEither filepath) >>= \case+ Right style -> importPlugin style a+ Left err -> report Warning (fromString $ prettyPrintParseException err) Nothing $> a+ _ -> pure a+ }