From ccfacef35045325a38ace2c97d77aea7565d6a8c Mon Sep 17 00:00:00 2001 From: Taylor Fausak Date: Mon, 18 Mar 2024 12:27:22 -0500 Subject: [PATCH] Add some tests --- imp.cabal | 20 +++- source/library/Imp.hs | 38 +++++--- source/library/Imp/Extra/HsParsedModule.hs | 7 +- source/library/Imp/Extra/ParsedResult.hs | 7 +- source/test-suite/Main.hs | 105 +++++++++++++++++++++ 5 files changed, 156 insertions(+), 21 deletions(-) create mode 100644 source/test-suite/Main.hs diff --git a/imp.cabal b/imp.cabal index 864bea6..b4525e9 100644 --- a/imp.cabal +++ b/imp.cabal @@ -1,6 +1,6 @@ cabal-version: 2.2 name: imp -version: 0.2024.3.11 +version: 0.2024.3.18 synopsis: Automatically import modules. description: Imp is a GHC plugin that automatically imports modules when they are used, @@ -35,6 +35,13 @@ common library -Wno-safe -Wno-unsafe +common executable + import: library + build-depends: imp + ghc-options: + -rtsopts + -threaded + library import: library autogen-modules: Paths_imp @@ -73,3 +80,14 @@ library hs-source-dirs: source/ghc-9.6 else hs-source-dirs: source/ghc-9.4 + +test-suite imp-test-suite + import: executable + build-depends: + exceptions, + ghc, + hspec ^>=2.11.7, + + hs-source-dirs: source/test-suite + main-is: Main.hs + type: exitcode-stdio-1.0 diff --git a/source/library/Imp.hs b/source/library/Imp.hs index 3084ce6..d1e0ead 100644 --- a/source/library/Imp.hs +++ b/source/library/Imp.hs @@ -34,12 +34,10 @@ parsedResultAction :: modSummary -> Plugin.ParsedResult -> Plugin.Hsc Plugin.ParsedResult -parsedResultAction commandLineOptions _ parsedResult = - Plugin.liftIO . Exception.handle handleException $ do - flags <- Flag.fromArguments commandLineOptions - config <- Config.fromFlags flags - context <- Context.fromConfig config - pure $ ParsedResult.overModule (HsParsedModule.overModule $ imp context) parsedResult +parsedResultAction commandLineOptions _ = + Plugin.liftIO + . Exception.handle handleException + . ParsedResult.overModule (HsParsedModule.overModule $ imp commandLineOptions) handleException :: Exception.SomeException -> IO a handleException e = do @@ -53,17 +51,24 @@ exceptionToExitCode e | otherwise = Exit.ExitFailure 1 imp :: - Context.Context -> + (Exception.MonadThrow m) => + [String] -> Plugin.Located Ghc.HsModulePs -> - Plugin.Located Ghc.HsModulePs -imp context lHsModule = + m (Plugin.Located Ghc.HsModulePs) +imp arguments lHsModule = do + flags <- Flag.fromArguments arguments + config <- Config.fromFlags flags + context <- Context.fromConfig config let aliases = Context.aliases context - moduleNames = Set.fromList $ biplate lHsModule :: Set.Set Plugin.ModuleName - in fmap (HsModule.overImports $ updateImports aliases moduleNames) lHsModule + moduleNames = + Set.fromList @Plugin.ModuleName + . biplate + . Hs.hsmodDecls + $ Plugin.unLoc lHsModule + pure $ fmap (HsModule.overImports $ updateImports aliases moduleNames) lHsModule biplate :: (Data.Data a, Data.Data b) => a -> [b] -biplate = - concat . Data.gmapQ (\d -> maybe (biplate d) pure $ Data.cast d) +biplate = concat . Data.gmapQ (\d -> maybe (biplate d) pure $ Data.cast d) updateImports :: Map.Map Plugin.ModuleName Plugin.ModuleName -> @@ -81,4 +86,9 @@ createImport :: Hs.ImportDecl Hs.GhcPs createImport aliases target = let source = Map.findWithDefault target target aliases - in (Ghc.newImportDecl source) {Hs.ideclAs = Just $ Hs.noLocA target} + in (Ghc.newImportDecl source) + { Hs.ideclAs = + if source == target + then Nothing + else Just $ Hs.noLocA target + } diff --git a/source/library/Imp/Extra/HsParsedModule.hs b/source/library/Imp/Extra/HsParsedModule.hs index 75d77e2..b15f2d0 100644 --- a/source/library/Imp/Extra/HsParsedModule.hs +++ b/source/library/Imp/Extra/HsParsedModule.hs @@ -5,7 +5,8 @@ import qualified GHC.Plugins as Plugin import qualified Imp.Ghc as Ghc overModule :: - (Plugin.Located Ghc.HsModulePs -> Plugin.Located Ghc.HsModulePs) -> + (Functor f) => + (Plugin.Located Ghc.HsModulePs -> f (Plugin.Located Ghc.HsModulePs)) -> Plugin.HsParsedModule -> - Plugin.HsParsedModule -overModule f x = x {Hs.hpm_module = f $ Hs.hpm_module x} + f Plugin.HsParsedModule +overModule f x = (\y -> x {Hs.hpm_module = y}) <$> f (Hs.hpm_module x) diff --git a/source/library/Imp/Extra/ParsedResult.hs b/source/library/Imp/Extra/ParsedResult.hs index f196b8c..5612e0a 100644 --- a/source/library/Imp/Extra/ParsedResult.hs +++ b/source/library/Imp/Extra/ParsedResult.hs @@ -3,7 +3,8 @@ module Imp.Extra.ParsedResult where import qualified GHC.Plugins as Plugin overModule :: - (Plugin.HsParsedModule -> Plugin.HsParsedModule) -> + (Functor f) => + (Plugin.HsParsedModule -> f Plugin.HsParsedModule) -> Plugin.ParsedResult -> - Plugin.ParsedResult -overModule f x = x {Plugin.parsedResultModule = f $ Plugin.parsedResultModule x} + f Plugin.ParsedResult +overModule f x = (\y -> x {Plugin.parsedResultModule = y}) <$> f (Plugin.parsedResultModule x) diff --git a/source/test-suite/Main.hs b/source/test-suite/Main.hs new file mode 100644 index 0000000..42162f1 --- /dev/null +++ b/source/test-suite/Main.hs @@ -0,0 +1,105 @@ +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.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 + +main :: IO () +main = Hspec.hspec . Hspec.parallel . Hspec.describe "Imp" $ do + Hspec.it "does nothing with an empty module" $ do + expectImp + [] + "" + "" + + Hspec.it "does nothing when nothing needs to be imported" $ do + expectImp + [] + "true = True" + "true = True" + + Hspec.it "inserts an import for a qualified value" $ do + expectImp + [] + "true = Data.Bool.True" + "import qualified Data.Bool\ntrue = Data.Bool.True" + + Hspec.it "inserts an aliased import" $ do + expectImp + ["--alias=Data.Bool:Bool"] + "true = Bool.True" + "import qualified Data.Bool as Bool\ntrue = Bool.True" + + Hspec.it "prefers later aliases over earlier ones" $ do + expectImp + ["--alias=Relude.Bool:Bool", "--alias=Data.Bool:Bool"] + "true = Bool.True" + "import qualified Data.Bool as Bool\ntrue = Bool.True" + + Hspec.it "inserts an import for a qualified type" $ do + expectImp + [] + "true = True :: Data.Bool.Bool" + "import qualified Data.Bool\ntrue = True :: Data.Bool.Bool" + + Hspec.it "inserts multiple imports sorted" $ do + expectImp + [] + "true :: Relude.Bool.Bool\ntrue = Data.Bool.True" + "import qualified Data.Bool\nimport qualified Relude.Bool\ntrue :: Relude.Bool.Bool\ntrue = Data.Bool.True" + + Hspec.it "does not re-import an open import" $ do + expectImp + [] + "import Data.Bool\ntrue = Data.Bool.True" + "import Data.Bool\ntrue = Data.Bool.True" + + Hspec.it "does not re-import a qualified import" $ do + expectImp + [] + "import qualified Data.Bool\ntrue = Data.Bool.True" + "import qualified Data.Bool\ntrue = Data.Bool.True" + + Hspec.it "does not re-import an aliased import" $ do + expectImp + [] + "import qualified Data.Bool as Bool\ntrue = Bool.True" + "import qualified Data.Bool as Bool\ntrue = Bool.True" + + Hspec.it "inserts imports after existing ones" $ do + expectImp + [] + "import qualified Relude.Bool\ntrue :: Relude.Bool.Bool\ntrue = Data.Bool.True" + "import qualified Relude.Bool\nimport qualified Data.Bool\ntrue :: Relude.Bool.Bool\ntrue = Data.Bool.True" + +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 + actual `Hspec.shouldBe` expected + +parseModule :: (Exception.MonadThrow m) => String -> m (SrcLoc.Located Ghc.HsModulePs) +parseModule input = do + let parserOpts = Lexer.mkParserOpts EnumSet.empty Error.emptyDiagOpts [] False False False False + stringBuffer = StringBuffer.stringToStringBuffer input + realSrcLoc = SrcLoc.mkRealSrcLoc (FastString.mkFastString "") 1 1 + pState = Lexer.initParserState parserOpts stringBuffer realSrcLoc + parseResult = Lexer.unP Parser.parseModule pState + case parseResult of + Lexer.PFailed _ -> Exception.throwM $ InvalidInput input + Lexer.POk _ lHsModule -> pure lHsModule + +newtype InvalidInput + = InvalidInput String + deriving (Eq, Show) + +instance Exception.Exception InvalidInput