imp 1.0.0.1 → 1.0.1.0

raw patch · 10 files changed

+197/−48 lines, 10 filesdep +transformersPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependencies added: transformers

API changes (from Hackage documentation)

Files

• README.md +25/−0
• imp.cabal +5/−1
• source/library/Imp.hs +78/−30
• source/library/Imp/Extra/HsModule.hs +7/−0
• source/library/Imp/Extra/Located.hs +6/−0
• source/library/Imp/Type/Alias.hs +7/−7
• source/library/Imp/Type/Context.hs +3/−2
• source/library/Imp/Type/Source.hs +24/−0
• source/library/Imp/Type/Target.hs +18/−0
• source/test-suite/Main.hs +24/−8

@@ -75,6 +75,30 @@  Later aliases will override earlier ones. +## Aliasing Current Module++You can use the special source module name `_` (a single underscore) to refer+to the current module. This allows you to disambiguate identifiers without+referring to the current module name. For example if you want to use `This`,+you can do so with `--alias=_:This`. As a complete example, this input:++``` hs+{-# OPTIONS_GHC+  -fplugin=Imp+  -fplugin-opt=Imp:--alias=_:This #-}+module Qualified.Example where+print = putStrLn . show+defaultMain = This.print ()+```++Will effectively produce this output:++``` hs+module Qualified.Example where+print = putStrLn . show+defaultMain = Qualified.Example.print ()+```+ ## Recommended Usage  Combining the previous sections, the recommended usage of Imp is to enable it@@ -86,6 +110,7 @@   build-depends: imp ^>= 1.0.0.0   ghc-options:     -fplugin=Imp+    -fplugin-opt=Imp:--alias=_:This     -fplugin-opt=Imp:--alias=Data.Map.Strict:Map     -fplugin-opt=Imp:--alias=Data.Sequence:Seq     -fplugin-opt=Imp:--alias=Data.Set:Set

@@ -1,6 +1,6 @@ cabal-version: 2.2 name: imp-version: 1.0.0.1+version: 1.0.1.0 synopsis: A GHC plugin for automatically importing modules. description: Imp is a GHC plugin for automatically importing modules. category: Plugin@@ -49,6 +49,7 @@     containers ^>=0.6.7,     exceptions ^>=0.10.5,     ghc ^>=9.4.1 || ^>=9.6.1 || ^>=9.8.1,+    transformers ^>=0.5.6 || ^>=0.6.1,    -- cabal-gild: discover source/ghc-9.4 source/ghc-9.6 source/library   exposed-modules:@@ -64,6 +65,7 @@     Imp.Extra.HsModule     Imp.Extra.HsParsedModule     Imp.Extra.ImportDecl+    Imp.Extra.Located     Imp.Extra.ModuleName     Imp.Extra.ParsedResult     Imp.Extra.ReadP@@ -73,6 +75,8 @@     Imp.Type.Config     Imp.Type.Context     Imp.Type.Flag+    Imp.Type.Source+    Imp.Type.Target    hs-source-dirs: source/library   other-modules: Paths_imp

@@ -1,8 +1,11 @@+{-# LANGUAGE RankNTypes #-} {-# LANGUAGE TypeApplications #-}  module Imp where +import qualified Control.Monad as Monad import qualified Control.Monad.Catch as Exception+import qualified Control.Monad.Trans.State as StateT import qualified Data.Data as Data import qualified Data.Map as Map import qualified Data.Maybe as Maybe@@ -15,12 +18,15 @@ import qualified Imp.Extra.HsModule as HsModule import qualified Imp.Extra.HsParsedModule as HsParsedModule import qualified Imp.Extra.ImportDecl as ImportDecl+import qualified Imp.Extra.Located as Located import qualified Imp.Extra.ParsedResult as ParsedResult import qualified Imp.Extra.SrcSpanAnnN as SrcSpanAnnN import qualified Imp.Ghc as Ghc import qualified Imp.Type.Config as Config import qualified Imp.Type.Context as Context import qualified Imp.Type.Flag as Flag+import qualified Imp.Type.Source as Source+import qualified Imp.Type.Target as Target import qualified System.Exit as Exit import qualified System.IO as IO @@ -33,13 +39,17 @@  parsedResultAction ::   [Plugin.CommandLineOption] ->-  modSummary ->+  Plugin.ModSummary ->   Plugin.ParsedResult ->   Plugin.Hsc Plugin.ParsedResult-parsedResultAction commandLineOptions _ =+parsedResultAction commandLineOptions modSummary =   Plugin.liftIO     . Exception.handle handleException-    . ParsedResult.overModule (HsParsedModule.overModule $ imp commandLineOptions)+    . ParsedResult.overModule+      ( HsParsedModule.overModule+          . imp commandLineOptions+          $ Plugin.ms_mod_name modSummary+      )  handleException :: Exception.SomeException -> IO a handleException e = do@@ -55,47 +65,85 @@ imp ::   (Exception.MonadThrow m) =>   [String] ->+  Plugin.ModuleName ->   Plugin.Located Ghc.HsModulePs ->   m (Plugin.Located Ghc.HsModulePs)-imp arguments lHsModule = do+imp arguments this lHsModule = do   flags <- Flag.fromArguments arguments   config <- Config.fromFlags flags   context <- Context.fromConfig config   let aliases = Context.aliases context-      moduleNames =-        Map.fromListWith SrcSpanAnnN.leftmostSmallest-          . Maybe.mapMaybe-            ( \lRdrName -> case Plugin.unLoc lRdrName of-                Plugin.Qual moduleName _ -> Just (moduleName, Plugin.getLoc lRdrName)-                _ -> Nothing-            )-          . biplate-          . Hs.hsmodDecls+      implicits =+        Set.map Target.toModuleName+          . Map.keysSet+          $ Map.filter Source.isImplicit aliases+      imports =+        Set.fromList+          . fmap (ImportDecl.toModuleName . Plugin.unLoc)+          . Hs.hsmodImports           $ Plugin.unLoc lHsModule-  pure $ fmap (HsModule.overImports $ updateImports aliases moduleNames) lHsModule+      (newLHsModule, moduleNames) =+        StateT.runState+          (Located.overValue (HsModule.overDecls $ overData $ updateQualifiedIdentifiers this implicits imports) lHsModule)+          Map.empty+  pure $ fmap (HsModule.overImports $ updateImports this aliases moduleNames) newLHsModule -biplate :: (Data.Data a, Data.Data b) => a -> [b]-biplate = concat . Data.gmapQ (\d -> maybe (biplate d) pure $ Data.cast d)+updateQualifiedIdentifiers ::+  (Data.Data a) =>+  Plugin.ModuleName ->+  Set.Set Plugin.ModuleName ->+  Set.Set Plugin.ModuleName ->+  a ->+  StateT.State (Map.Map Plugin.ModuleName Hs.SrcSpanAnnN) a+updateQualifiedIdentifiers this implicits imports x = case Data.cast x of+  Nothing -> pure x+  Just (Plugin.L l rdrName) -> case rdrName of+    Plugin.Qual moduleName occName ->+      if Set.notMember moduleName imports && Set.member moduleName implicits+        then+          pure+            . Maybe.fromMaybe x+            . Data.cast+            . Plugin.L l+            $ Plugin.Qual this occName+        else do+          StateT.modify $+            Map.insertWith+              SrcSpanAnnN.leftmostSmallest+              moduleName+              l+          pure x+    _ -> pure x +overData :: (Data.Data a, Monad m) => (forall b. (Data.Data b) => b -> m b) -> a -> m a+overData f = Data.gmapM $ overData f Monad.>=> f+ updateImports ::-  Map.Map Plugin.ModuleName Plugin.ModuleName ->+  Plugin.ModuleName ->+  Map.Map Target.Target Source.Source ->   Map.Map Plugin.ModuleName Hs.SrcSpanAnnN ->   [Hs.LImportDecl Hs.GhcPs] ->   [Hs.LImportDecl Hs.GhcPs]-updateImports aliases want imports =-  let have = Set.fromList $ fmap (ImportDecl.toModuleName . Plugin.unLoc) imports+updateImports this aliases want imports =+  let have = Set.insert this . Set.fromList $ fmap (ImportDecl.toModuleName . Plugin.unLoc) imports       need = Map.toList $ Map.withoutKeys want have-   in imports <> fmap (\(m, l) -> Plugin.L (Hs.na2la l) $ createImport aliases m) need+   in imports <> Maybe.mapMaybe (\(m, l) -> Plugin.L (Hs.na2la l) <$> createImport aliases m) need  createImport ::-  Map.Map Plugin.ModuleName Plugin.ModuleName ->+  Map.Map Target.Target Source.Source ->   Plugin.ModuleName ->-  Hs.ImportDecl Hs.GhcPs-createImport aliases target =-  let source = Map.findWithDefault target target aliases-   in (Ghc.newImportDecl source)-        { Hs.ideclAs =-            if source == target-              then Nothing-              else Just $ Hs.noLocA target-        }+  Maybe (Hs.ImportDecl Hs.GhcPs)+createImport aliases target = do+  source <-+    case Map.lookup (Target.fromModuleName target) aliases of+      Nothing -> Just target+      Just s -> case s of+        Source.Implicit -> Nothing+        Source.Explicit m -> Just m+  Just+    (Ghc.newImportDecl source)+      { Hs.ideclAs =+          if source == target+            then Nothing+            else Just $ Hs.noLocA target+      }

@@ -3,6 +3,13 @@ import qualified GHC.Hs as Hs import qualified Imp.Ghc as Ghc +overDecls ::+  (Functor f) =>+  ([Hs.LHsDecl Hs.GhcPs] -> f [Hs.LHsDecl Hs.GhcPs]) ->+  Ghc.HsModulePs ->+  f Ghc.HsModulePs+overDecls f x = (\y -> x {Hs.hsmodDecls = y}) <$> f (Hs.hsmodDecls x)+ overImports ::   ([Hs.LImportDecl Hs.GhcPs] -> [Hs.LImportDecl Hs.GhcPs]) ->   Ghc.HsModulePs ->

@@ -0,0 +1,6 @@+module Imp.Extra.Located where++import qualified GHC.Plugins as Plugin++overValue :: (Functor f) => (a -> f b) -> Plugin.Located a -> f (Plugin.Located b)+overValue f (Plugin.L l e) = Plugin.L l <$> f e

@@ -3,13 +3,13 @@ import qualified Control.Monad as Monad import qualified Control.Monad.Catch as Exception import qualified Data.Map as Map-import qualified GHC.Plugins as Plugin import qualified Imp.Exception.InvalidAlias as InvalidAlias-import qualified Imp.Extra.ModuleName as ModuleName+import qualified Imp.Type.Source as Source+import qualified Imp.Type.Target as Target  data Alias = Alias-  { source :: Plugin.ModuleName,-    target :: Plugin.ModuleName+  { source :: Source.Source,+    target :: Target.Target   }   deriving (Eq, Show) @@ -17,9 +17,9 @@ fromString string = do   let (before, after) = break (== ':') string   Monad.when (null after) . Exception.throwM $ InvalidAlias.new string-  src <- ModuleName.fromString before-  tgt <- ModuleName.fromString . drop 1 $ after+  src <- Source.fromString before+  tgt <- Target.fromString . drop 1 $ after   pure Alias {source = src, target = tgt} -toMap :: [Alias] -> Map.Map Plugin.ModuleName Plugin.ModuleName+toMap :: [Alias] -> Map.Map Target.Target Source.Source toMap = Map.fromListWith (const id) . fmap (\x -> (target x, source x))

@@ -3,14 +3,15 @@ import qualified Control.Monad as Monad import qualified Control.Monad.Catch as Exception import qualified Data.Map as Map-import qualified GHC.Plugins as Plugin import qualified Imp.Exception.ShowHelp as ShowHelp import qualified Imp.Exception.ShowVersion as ShowVersion import qualified Imp.Type.Alias as Alias import qualified Imp.Type.Config as Config+import qualified Imp.Type.Source as Source+import qualified Imp.Type.Target as Target  newtype Context = Context-  { aliases :: Map.Map Plugin.ModuleName Plugin.ModuleName+  { aliases :: Map.Map Target.Target Source.Source   }   deriving (Eq, Show) 

@@ -0,0 +1,24 @@+module Imp.Type.Source where++import qualified Control.Monad.Catch as Exception+import qualified GHC.Plugins as Plugin+import qualified Imp.Extra.ModuleName as ModuleName++data Source+  = Implicit+  | Explicit Plugin.ModuleName+  deriving (Eq, Show)++fromModuleName :: Plugin.ModuleName -> Source+fromModuleName = Explicit++fromString :: (Exception.MonadThrow m) => String -> m Source+fromString s =+  if s == "_"+    then pure Implicit+    else fromModuleName <$> ModuleName.fromString s++isImplicit :: Source -> Bool+isImplicit s = case s of+  Implicit -> True+  Explicit _ -> False

@@ -0,0 +1,18 @@+module Imp.Type.Target where++import qualified Control.Monad.Catch as Exception+import qualified GHC.Plugins as Plugin+import qualified Imp.Extra.ModuleName as ModuleName++newtype Target+  = Target Plugin.ModuleName+  deriving (Eq, Ord, Show)++fromModuleName :: Plugin.ModuleName -> Target+fromModuleName = Target++fromString :: (Exception.MonadThrow m) => String -> m Target+fromString = fmap fromModuleName . ModuleName.fromString++toModuleName :: Target -> Plugin.ModuleName+toModuleName (Target x) = x

@@ -2,14 +2,12 @@  import qualified Control.Monad.Catch as Exception import qualified GHC.Data.EnumSet as EnumSet-import qualified GHC.Data.FastString as FastString import qualified GHC.Data.StringBuffer as StringBuffer import qualified GHC.Parser as Parser import qualified GHC.Parser.Lexer as Lexer+import qualified GHC.Plugins as Plugin import qualified GHC.Stack as Stack-import qualified GHC.Types.SrcLoc as SrcLoc import qualified GHC.Utils.Error as Error-import qualified GHC.Utils.Outputable as Outputable import qualified Imp import qualified Imp.Ghc as Ghc import qualified Test.Hspec as Hspec@@ -82,18 +80,36 @@       "import qualified Relude.Bool\ntrue :: Relude.Bool.Bool\ntrue = Data.Bool.True"       "import qualified Relude.Bool\nimport (implicit) qualified Data.Bool\ntrue :: Relude.Bool.Bool\ntrue = Data.Bool.True" +  Hspec.it "replaces implicit source with current module" $ do+    expectImp+      ["--alias=_:This"]+      "undefined = This.undefined"+      "undefined = Example.undefined"++  Hspec.it "does not clobber import with implicit" $ do+    expectImp+      ["--alias=_:Data.Bool"]+      "import Data.Bool\ntrue = Data.Bool.True"+      "import Data.Bool\ntrue = Data.Bool.True"++  Hspec.it "does not insert an import for the current module" $ do+    expectImp+      []+      "undefined = Example.undefined"+      "undefined = Example.undefined"+ expectImp :: (Stack.HasCallStack) => [String] -> String -> String -> Hspec.Expectation expectImp arguments input expected = do   before <- parseModule input-  after <- Imp.imp arguments before-  let actual = Outputable.showPprUnsafe after+  after <- Imp.imp arguments (Plugin.mkModuleName "Example") before+  let actual = Plugin.showPprUnsafe after   actual `Hspec.shouldBe` expected -parseModule :: (Exception.MonadThrow m) => String -> m (SrcLoc.Located Ghc.HsModulePs)+parseModule :: (Exception.MonadThrow m) => String -> m (Plugin.Located Ghc.HsModulePs) parseModule input = do   let parserOpts = Lexer.mkParserOpts EnumSet.empty emptyDiagOpts [] False False False False       stringBuffer = StringBuffer.stringToStringBuffer input-      realSrcLoc = SrcLoc.mkRealSrcLoc (FastString.mkFastString "<interactive>") 1 1+      realSrcLoc = Plugin.mkRealSrcLoc (Plugin.mkFastString "<interactive>") 1 1       pState = Lexer.initParserState parserOpts stringBuffer realSrcLoc       parseResult = Lexer.unP Parser.parseModule pState   case parseResult of@@ -104,7 +120,7 @@ #if MIN_VERSION_ghc(9, 8, 1) emptyDiagOpts = Error.emptyDiagOpts #else-emptyDiagOpts = Error.DiagOpts EnumSet.empty EnumSet.empty False False Nothing Outputable.defaultSDocContext+emptyDiagOpts = Error.DiagOpts EnumSet.empty EnumSet.empty False False Nothing Plugin.defaultSDocContext #endif  newtype InvalidInput