Add some tests

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

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
+        }

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)

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)

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 "<interactive>") 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