auto-import (empty) → 0.1.0.0
raw patch · 8 files changed
+1125/−0 lines, 8 filesdep +auto-importdep +basedep +bytestring
Dependencies added: auto-import, base, bytestring, containers, directory, ghc, ghc-boot, ghc-exactprint, ghc-paths, megaparsec, process, tasty, tasty-hunit, text, time
Files
- CHANGELOG.md +5/−0
- LICENSE +29/−0
- README.md +94/−0
- auto-import.cabal +59/−0
- src/AutoImport.hs +334/−0
- src/AutoImport/Config.hs +283/−0
- src/AutoImport/GhcFacade.hs +259/−0
- test/Main.hs +62/−0
+ CHANGELOG.md view
@@ -0,0 +1,5 @@+# Revision history for auto-import++## 0.1.0.0 -- YYYY-mm-dd++* First version. Released on an unsuspecting world.
+ LICENSE view
@@ -0,0 +1,29 @@+Copyright (c) 2025, Aaron Allen+++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++ * Redistributions of source code must retain the above copyright+ notice, this list of conditions and the following disclaimer.++ * Redistributions in binary form must reproduce the above+ copyright notice, this list of conditions and the following+ disclaimer in the documentation and/or other materials provided+ with the distribution.++ * Neither the name of the copyright holder nor the names of its+ contributors may be used to endorse or promote products derived+ from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+HOLDER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ README.md view
@@ -0,0 +1,94 @@+# auto-import :inbox_tray:++A GHC plugin that automatically adds import statements to the module being compiled.++### Usage++This plugin is intended to be used with GHCi or adjacent utilities such as+`ghcid` and `ghciwatch` as a developement tool, not as a package dependency.++You must first define a config file that specifies which modules are eligible+to be automatically imported. By default this file is named `.autoimport` and+can be placed in the home directory and/or in the root directory of your+Haskell project. If the file is found in both locations, the configs will be+merged with the local file taking precedence. The local file path can be overriden+by passing this plugin option to GHC: `fplugin-opt=AutoImport:--import-cfg=path/to/file`.++Here is an example `.autoimport` file:++```+Data.Text as T+Data.Text.IO as TIO+Data.Map (Map)+Data.Map as Map+Data.Maybe (fromMaybe, isJust, isNothing)+Data.Functor.Identity (Identity(runIdentity))+UnliftIO+```++There are two ways of specifying modules that should be automatically imported:+with a qualifier or with a list of identifiers.++Modules are identified by a qualifier if there is no list of identifiers+following the module name, along with an optional explicit qualifier using+`as`. If no explicit qualifier is given then the full module name is used as+the qualifier (such as `UnliftIO` in the example). Qualified imports will be+added for these modules whenever the qualifier is used in a module where it+does not correspond to an existing import.++If a list of identifiers is given then that module will be imported unqualified+with an explicit import list (or added to an existing import if the module is+already imported) when one of the given identifiers is used in a context where+it does not have a definition in scope. Note: wildcards for type and class+subterms is not supported, i.e. `Identity(..)` is not allowed in the config.++With the plugin enabled and the example config in scope, compiling the+following module:++```haskell+tryReadFile :: FilePath -> IO (Either UnliftIO.IOException T.Text)+tryReadFile = UnliftIO.catchIO . TIO.readFile++defaultToZero :: Maybe Int -> Int+defaultToZero = fromMaybe 0+```++Results in the module file being automatically updated to:++```haskell+import qualified Data.Text as T+import qualified Data.Text.IO as TIO+import qualified UnliftIO+import Data.Maybe (fromMaybe)++tryReadFile :: FilePath -> IO (Either UnliftIO.IOException T.Text)+tryReadFile = UnliftIO.tryIO . TIO.readFile++defaultToZero :: Maybe Int -> Int+defaultToZero = fromMaybe 0+```++(Note: the above would actually need to be compiled twice because GHC does not+emit the 'missing qualifier' and 'out of scope variable' errors together. The+missing qualifier errors occur first.)++The plugin works by intercepting GHC errors indicating that a qualifier or+identifier is not defined, and if it matches a line from the config, then the+corresponding import statement is inserted. Compilation is aborted when this+occurs.++Here is an example command for starting a REPL for a stack project with the+`auto-import` plugin enabled (you may need to add `auto-import` to your+`extra-deps` first):++```+stack repl my-project --package auto-import --ghci-options='-fplugin AutoSplit'+```++likewise for a cabal project (you may need to run `cabal update` first):++```+cabal repl my-project --build-depends auto-import --repl-options='-fplugin AutoSplit'+```++This plugin aims to support the four most recent major GHC releases.
+ auto-import.cabal view
@@ -0,0 +1,59 @@+cabal-version: 3.0+name: auto-import+version: 0.1.0.0+synopsis: Automatically add import statements+description: Automatically add import statements based on configuration+license: BSD-3-Clause+license-file: LICENSE+author: Aaron Allen+maintainer: aaronallen8455@gmail.com+copyright: 2025 Aaron Allen+category: Development+build-type: Simple+extra-doc-files: CHANGELOG.md+ README.md+tested-with: GHC == 9.12.1, GHC == 9.10.1, GHC == 9.8.1, GHC == 9.6.1++source-repository head+ type: git+ location: https://github.com/aaronallen8455/auto-import++common warnings+ ghc-options: -Wall++library+ import: warnings+ exposed-modules: AutoImport+ AutoImport.GhcFacade+ AutoImport.Config+ -- other-modules:+ default-extensions: LambdaCase, OverloadedStrings+ build-depends: base < 5,+ ghc >= 9.6 && < 9.13,+ ghc-boot,+ ghc-exactprint,+ ghc-paths,+ bytestring < 0.13,+ megaparsec >= 9 && < 10,+ text,+ containers,+ directory,+ time+ hs-source-dirs: src+ default-language: GHC2021++test-suite auto-import-test+ import: warnings+ default-language: GHC2021+ -- other-modules:+ -- other-extensions:+ type: exitcode-stdio-1.0+ hs-source-dirs: test+ main-is: Main.hs+ build-depends:+ base,+ auto-import,+ directory,+ process,+ tasty,+ tasty-hunit
+ src/AutoImport.hs view
@@ -0,0 +1,334 @@+{-# LANGUAGE CPP #-}+{-# LANGUAGE TypeFamilies #-}+module AutoImport+ ( plugin+ ) where++import Control.Exception (try, throw)+import Data.Containers.ListUtils (nubOrd)+import Data.Either (partitionEithers)+import Data.Foldable+import qualified Data.List as List+import qualified Data.List.NonEmpty as NE+import qualified Data.Map as M+import qualified Data.Text as T+import qualified Data.Text.Encoding as TE+import qualified GHC.LanguageExtensions as LangExt+import qualified GHC.Paths as Paths+import qualified Language.Haskell.GHC.ExactPrint as EP+import qualified Language.Haskell.GHC.ExactPrint.Parsers as EP+import qualified Language.Haskell.GHC.ExactPrint.Utils as EP++import AutoImport.Config+import qualified AutoImport.GhcFacade as Ghc++--------------------------------------------------------------------------------+-- Plugin+--------------------------------------------------------------------------------++plugin :: Ghc.Plugin+plugin = Ghc.defaultPlugin+ { Ghc.driverPlugin = \args hscEnv -> pure $ addHscHook args hscEnv+ , Ghc.pluginRecompile = Ghc.purePlugin+ }++addHscHook :: [Ghc.CommandLineOption] -> Ghc.HscEnv -> Ghc.HscEnv+addHscHook args hscEnv = hscEnv+ { Ghc.hsc_hooks =+ let hooks = Ghc.hsc_hooks hscEnv+ in hooks+ { Ghc.runPhaseHook = Just $ phaseHook (Ghc.runPhaseHook hooks) }+ }+ where+ phaseHook mExistingHook = Ghc.PhaseHook $ \phase -> case phase of+ Ghc.T_Hsc env modSum -> do+ let modFile = Ghc.ms_hspp_file modSum+ importsAddedErr =+ Ghc.mkPlainErrorMsgEnvelope+ (Ghc.mkGeneralSrcSpan $ Ghc.mkFastString modFile)+ (Ghc.ghcUnknownMessage ImportsAddedDiag)+ eTcRes <- try $ runPhaseOrExistingHook phase+ autoImportCfg <- resolveConfig (asum $ parseConfigPathArg <$> args)+ let msgs = case eTcRes of+ Left (Ghc.SourceError m) -> m+ Right (_, m) -> m+ missingThings =+ foldMap (missingThingFromMsg autoImportCfg) (Ghc.getMessages msgs)+ case NE.nonEmpty (nubOrd $ toList missingThings) of+ Just neMissing -> do+ -- Parse from file because the parse result from GHC lacks comments+ let dynFlags = Ghc.ms_hspp_opts modSum `Ghc.gopt_set` Ghc.Opt_KeepRawTokenStream+ (eParseResult, usesCpp) <- parseModule env dynFlags modFile+ case eParseResult of+ Left errs -> throw $ Ghc.mkSrcErr errs+ Right parseResult -> do+ modifyModule parseResult usesCpp neMissing modFile+ throw . Ghc.mkSrcErr . Ghc.mkMessages $ Ghc.unitBag importsAddedErr+ _ -> either throw pure eTcRes+ _ -> runPhaseOrExistingHook phase+ where+ runPhaseOrExistingHook :: Ghc.TPhase res -> IO res+ runPhaseOrExistingHook = maybe Ghc.runPhase (\(Ghc.PhaseHook h) -> h) mExistingHook++parseConfigPathArg :: Ghc.CommandLineOption -> Maybe FilePath+parseConfigPathArg ('-':'-':'i':'m':'p':'o':'r':'t':'-':'c':'f':'g':'=':path) = Just path+parseConfigPathArg _ = Nothing++moduleNameToText :: Ghc.ModuleName -> T.Text+moduleNameToText = TE.decodeUtf8 . Ghc.bytesFS . Ghc.moduleNameFS++data MissingThing+ = MissingModule QualMod+ | MissingId UnqualIdentifier+ deriving (Eq, Ord)++missingThingFromMsg :: Config -> Ghc.MsgEnvelope Ghc.GhcMessage -> [MissingThing]+missingThingFromMsg autoImportCfg msgEnv =+ case Ghc.errMsgDiagnostic msgEnv of+ Ghc.GhcTcRnMessage+ (Ghc.TcRnMessageWithInfo _+ (Ghc.TcRnMessageDetailed _+ (Ghc.TcRnNotInScope Ghc.NotInScope _ [Ghc.MissingModule missingMod] _))+ )+ | let modTxt = moduleNameToText missingMod+ , Just qualMods <- M.lookup modTxt (unMonoidMap $ qualModules autoImportCfg)+ -> MissingModule <$> qualMods+ Ghc.GhcTcRnMessage+ (Ghc.TcRnMessageWithInfo _+ (Ghc.TcRnMessageDetailed _+ (Ghc.TcRnNotInScope Ghc.NotInScope rdrName [] hints))+ )+ | Just unqualId <- M.lookup (T.pack $ EP.rdrName2String rdrName) (unqualIdentifiers autoImportCfg)+ , let isDataKindExtHint = \case+ Ghc.SuggestExtension (Ghc.SuggestSingleExtension _ LangExt.DataKinds) -> True+ _ -> False+ -- If -XDataKinds is suggested, that means the import already exists+ -- and should not be added again.+ , not (any isDataKindExtHint hints)+ -> [MissingId unqualId]+ Ghc.GhcTcRnMessage+ (Ghc.TcRnMessageWithInfo _+ (Ghc.TcRnMessageDetailed _+ (Ghc.TcRnSolverReport' report )+ ))+ | Ghc.ReportHoleError hole _+ <- Ghc.reportContent report+ , Just unqualId <- M.lookup (T.pack . EP.rdrName2String $ Ghc.hole_occ hole) (unqualIdentifiers autoImportCfg)+ -> [MissingId unqualId]+ _ -> []++-- | Diagnostic thrown when import statements are inserted+data ImportsAddedDiag = ImportsAddedDiag++instance Ghc.Diagnostic ImportsAddedDiag where+ type DiagnosticOpts ImportsAddedDiag = Ghc.NoDiagnosticOpts+ diagnosticMessage _ _ = Ghc.mkSimpleDecorated $+ Ghc.text "Module updated by auto-import, compilation aborted"+ diagnosticReason _ = Ghc.ErrorWithoutFlag+ diagnosticHints _ = []+ diagnosticCode _ = Nothing+#if !MIN_VERSION_ghc(9,8,0)+ defaultDiagnosticOpts = Ghc.NoDiagnosticOpts+#endif++--------------------------------------------------------------------------------+-- Modify source+--------------------------------------------------------------------------------++-- | Parse the given module file. Accounts for CPP comments+parseModule+ :: Ghc.HscEnv+ -> Ghc.DynFlags+ -> String+ -> IO (EP.ParseResult Ghc.ParsedSource, Bool)+parseModule env dynFlags filePath = EP.ghcWrapper Paths.libdir $ do+ Ghc.setSession env { Ghc.hsc_dflags = dynFlags }+ res <- EP.parseModuleEpAnnsWithCppInternal EP.defaultCppOptions dynFlags filePath+ let eCppComments = fmap (\(c, _, _) -> c) res+ hasCpp = case eCppComments of+ Right cs -> not $ null cs+ _ -> False+ pure+ ( liftA2 EP.insertCppComments+ (EP.postParseTransform res)+ eCppComments+ , hasCpp+ )++modifyModule+ :: Ghc.ParsedSource+ -> Bool+ -> NE.NonEmpty MissingThing+ -> FilePath+ -> IO ()+modifyModule parsedMod usesCpp neMissing filePath = do+ let updatedAst = modifyAST neMissing parsedMod+ -- If the source contains CPP, newlines are appended+ -- to the end of the file when exact printing. The simple+ -- solution is to remove trailing newlines after exact printing+ -- if the source contains CPP comments.+ removeTrailingNewlines+ | usesCpp =+ reverse . ('\n' :) . dropWhile (== '\n') . reverse+ | otherwise = id+ printed = removeTrailingNewlines $ EP.exactPrint updatedAst+ writeFile filePath printed++modifyAST :: NE.NonEmpty MissingThing -> Ghc.ParsedSource -> Ghc.ParsedSource+modifyAST missingThings parsedSource =+ let+ Ghc.L modLoc hsMod = EP.makeDeltaAst parsedSource+ (qualMods, unqualIds) = partitionEithers $+ NE.toList missingThings >>= \case+ MissingModule m -> [Left m]+ MissingId i -> [Right (importByMod i, [i])]+ newQualImports = mkQualImport <$>+ zip (null updatedImports : repeat False)+ qualMods+ (newUnqualIds, updatedImports) =+ addIdsToExistingImports+ (M.fromListWith (<>) unqualIds)+ (Ghc.hsmodImports hsMod)+ newUnqualImports = mkUnqualImport <$>+ zip ((null updatedImports && null newQualImports) : repeat False)+ (M.toList newUnqualIds)+ importSrcSpan isFirst =+ let lineDelta = if isFirst then 2 else 1+ in Ghc.noAnnSrcSpanDP' $ Ghc.DifferentLine lineDelta 0+ mkQualImport (isFirst, qualMod) =+ let mn = Ghc.mkModuleName $ T.unpack (modName qualMod)+ in Ghc.L (importSrcSpan isFirst)+ (Ghc.simpleImportDecl mn)+ { Ghc.ideclQualified = Ghc.QualifiedPre+ , Ghc.ideclAs = Ghc.L (Ghc.noAnnSrcSpanDP' $ Ghc.SameLine 1)+ . Ghc.mkModuleName . T.unpack <$> modQual qualMod+ , Ghc.ideclName = Ghc.L (Ghc.noAnnSrcSpanDP' $ Ghc.SameLine 1) mn+ , Ghc.ideclExt = Ghc.XImportDeclPass importEpAnnQual Ghc.NoSourceText False+ }+ mkUnqualImport :: (Bool, (T.Text, [UnqualIdentifier])) -> Ghc.LImportDecl Ghc.GhcPs+ mkUnqualImport (isFirst, (moName, ids)) =+ let mn = Ghc.mkModuleName $ T.unpack moName+ impList = addCommas $ uncurry mkIE <$>+ zip+ (True : repeat False)+ (associateUnqualIds ids)+ in Ghc.L (importSrcSpan isFirst)+ (Ghc.simpleImportDecl mn)+ { Ghc.ideclName = Ghc.L (Ghc.noAnnSrcSpanDP' $ Ghc.SameLine 1) mn+ , Ghc.ideclExt = Ghc.XImportDeclPass Ghc.importEpAnn Ghc.NoSourceText False+ , Ghc.ideclImportList = Just (Ghc.Exactly, Ghc.L Ghc.importListAnn impList)+ }+ importEpAnnQual = (Ghc.noAnn :: Ghc.EpAnn Ghc.EpAnnImportDecl)+#if MIN_VERSION_ghc(9,12,0)+ { Ghc.anns = Ghc.noAnn+ { Ghc.importDeclAnnImport = Ghc.EpTok Ghc.noAnn+ , Ghc.importDeclAnnQualified = Just (Ghc.EpTok EP.d1)+ , Ghc.importDeclAnnAs = Just (Ghc.EpTok EP.d1)+ }+ }+#endif+ in Ghc.L modLoc hsMod+ { Ghc.hsmodImports = updatedImports ++ newQualImports ++ newUnqualImports+ }++addIdsToExistingImports+ :: M.Map T.Text [UnqualIdentifier]+ -> [Ghc.LImportDecl Ghc.GhcPs]+ -> (M.Map T.Text [UnqualIdentifier], [Ghc.LImportDecl Ghc.GhcPs])+addIdsToExistingImports = List.mapAccumR go+ where+ go iMap (Ghc.L iLoc idec)+ | Ghc.NotQualified <- Ghc.ideclQualified idec+ , let hsModName = moduleNameToText . Ghc.unLoc $ Ghc.ideclName idec+ , Just ids <- M.lookup hsModName iMap+ , Just (Ghc.Exactly, Ghc.L idsLoc existingIEs) <- Ghc.ideclImportList idec+ = let (idsWithParent, idsWithoutParent) = partitionEithers $ do+ i <- ids+ case parentTy i of+ Nothing -> [Right i]+ Just parent -> [Left (idLabel parent, [i])]+ idsWithParentMap = M.fromListWith (<>) idsWithParent+ (idsWithParentToAdd, updatedExistingIEs) =+ addIdsToExistingIEs idsWithParentMap existingIEs+ idsWithoutParentDeduped =+ filter (\x -> M.notMember (identifier x) idsWithParentMap) idsWithoutParent+ newIEs = uncurry mkIE <$>+ zip+ (null updatedExistingIEs : repeat False)+ (associateUnqualIds (idsWithoutParentDeduped ++ fold idsWithParentToAdd))+ updatedImportList = (Ghc.Exactly, Ghc.L idsLoc . addCommas $ updatedExistingIEs ++ newIEs)+ newDecl = idec { Ghc.ideclImportList = Just updatedImportList }+ in (M.delete hsModName iMap, Ghc.L iLoc newDecl)+ go iMap idecl = (iMap, idecl)++associateUnqualIds :: [UnqualIdentifier] -> [(IdInfo, [IdInfo])]+associateUnqualIds ids = M.toList . M.fromListWith (<>) $ do+ i <- ids+ case parentTy i of+ Nothing -> [(toIdInfo i, [])]+ Just pt -> [(pt, [toIdInfo i])]++mkIE :: Bool -> (IdInfo, [IdInfo]) -> Ghc.LIE Ghc.GhcPs+mkIE isFirstItem (parentId, children) = Ghc.L (ieLoc isFirstItem) $+ case children of+ [] -> Ghc.IEVar' (mkIEWrappedName True parentId)+ _ -> Ghc.IEThingWith' Ghc.ieThingWithAnn+ (mkIEWrappedName True parentId)+ Ghc.NoIEWildcard+ (addCommas $ uncurry mkIEWrappedName <$> zip (True : repeat False) children)+ where+ ieLoc isFirst = Ghc.noAnnSrcSpanDP' $ Ghc.SameLine (if isFirst then 0 else 1)++mkIEWrappedName :: Bool -> IdInfo -> Ghc.LIEWrappedName Ghc.GhcPs+mkIEWrappedName isFirst i =+ Ghc.L ieLoc . ieCon . txtToRdrName $ idLabel i+ where+ ieLoc = Ghc.noAnnSrcSpanDP' $ Ghc.SameLine (if isFirst then 0 else 1)+ ieCon = case idNamespace i of+ Just PatternNS -> Ghc.IEPattern Ghc.epTokD0 . Ghc.L (Ghc.nameAnn (idIsOp i) True)+ Just TypeNS -> Ghc.IEType Ghc.epTokD0 . Ghc.L (Ghc.nameAnn (idIsOp i) True)+ Nothing -> Ghc.IEName Ghc.noExtField . Ghc.L (Ghc.nameAnn (idIsOp i) False)++addCommas :: [Ghc.GenLocated Ghc.SrcSpanAnnA e] -> [Ghc.GenLocated Ghc.SrcSpanAnnA e]+addCommas [] = []+addCommas [x] = [x]+addCommas (Ghc.L ann x : xs) =+ Ghc.L (if Ghc.hasTrailingComma ann then ann else EP.addComma ann) x+ : addCommas xs++addIdsToExistingIEs+ :: M.Map T.Text [UnqualIdentifier] -- keyed by parent ty name+ -> [Ghc.LIE Ghc.GhcPs]+ -> (M.Map T.Text [UnqualIdentifier], [Ghc.LIE Ghc.GhcPs])+addIdsToExistingIEs = List.mapAccumR go+ where+ go idMap (Ghc.L ieLoc (Ghc.IEThingAbs' name))+ | Ghc.IEName _ (Ghc.L _ rdrName) <- Ghc.unLoc name+ , let nameTxt = T.pack $ EP.rdrName2String rdrName+ , Just ids <- M.lookup nameTxt idMap+ , let newChildren =+ uncurry mkIEWrappedName . fmap toIdInfo <$>+ zip (True : repeat False) ids+ newLie = Ghc.L ieLoc+ (Ghc.IEThingWith' Ghc.ieThingWithAnn name Ghc.NoIEWildcard (addCommas newChildren))+ = (M.delete nameTxt idMap, newLie)+ go idMap (Ghc.L ieLoc (Ghc.IEThingWith' x name wc children))+ | Ghc.IEName _ (Ghc.L _ rdrName) <- Ghc.unLoc name+ , let nameTxt = T.pack $ EP.rdrName2String rdrName+ , Just ids <- M.lookup nameTxt idMap+ , let newChildren =+ uncurry mkIEWrappedName . fmap toIdInfo <$>+ zip (null children : repeat False) ids+ newLie = Ghc.L ieLoc (Ghc.IEThingWith' x name wc (addCommas $ children ++ newChildren))+ = (M.delete nameTxt idMap, newLie)+ go idMap lie = (idMap, lie)++txtToRdrName :: T.Text -> Ghc.RdrName+txtToRdrName = Ghc.mkRdrUnqual . Ghc.mkVarOcc . T.unpack++toIdInfo :: UnqualIdentifier -> IdInfo+toIdInfo i = IdInfo+ { idLabel = identifier i+ , idIsOp = isOperator i+ , idNamespace = namespace i+ }
+ src/AutoImport/Config.hs view
@@ -0,0 +1,283 @@+{-# LANGUAGE CPP #-}+{-# LANGUAGE DerivingVia #-}+{-# LANGUAGE TypeFamilies #-}+module AutoImport.Config+ ( ConfigCache(..)+ , Config(..)+ , QualMods+ , QualMod(..)+ , UnqualIdentifiers+ , UnqualIdentifier(..)+ , IdInfo(..)+ , Namespace(..)+ , MonoidMap(..)+ , resolveConfig+ ) where++import Control.Applicative ((<|>))+import Control.Monad (guard)+import Control.Exception (throw)+import Data.Bifunctor (first)+import qualified Data.ByteString.Char8 as BS8+import qualified Data.Char as Char+import Data.Functor (void)+import Data.IORef+import qualified Data.Map.Strict as M+import Data.Maybe (fromMaybe)+import qualified Data.Text as T+import qualified Data.Text.IO as T+import Data.Time (UTCTime)+import Data.Void+import GHC.Generics (Generic, Generically(..))+import qualified System.Directory as Dir+import System.IO.Unsafe (unsafePerformIO)+import qualified Text.Megaparsec as Parse+import qualified Text.Megaparsec.Char as Parse+import qualified Text.Megaparsec.Char.Lexer as Parse (skipLineComment)++import qualified AutoImport.GhcFacade as Ghc++-- | A global ref used to cache the config and the mod time of the config file+configCacheRef :: IORef (Maybe ConfigCache)+configCacheRef = unsafePerformIO $ newIORef Nothing+{-# NOINLINE configCacheRef #-}++data ConfigCache = ConfigCache+ { cachedConfig :: !Config+ , localModTime :: !(Maybe UTCTime)+ , homeModTime :: !(Maybe UTCTime)+ }++data Config = Config+ { qualModules :: QualMods+ , unqualIdentifiers :: UnqualIdentifiers+ } deriving (Generic, Show)+ deriving (Semigroup, Monoid) via Generically Config++newtype MonoidMap k a = MonoidMap {unMonoidMap :: M.Map k a}+ deriving (Show)+instance (Ord k, Semigroup a) => Semigroup (MonoidMap k a) where+ MonoidMap a <> MonoidMap b = MonoidMap $ M.unionWith (<>) a b+instance (Ord k, Monoid a) => Monoid (MonoidMap k a) where+ mempty = MonoidMap mempty++type QualMods = MonoidMap T.Text [QualMod]+data QualMod = QualMod+ { modName :: T.Text+ , modQual :: Maybe T.Text+ } deriving (Show, Eq, Ord)++type UnqualIdentifiers = M.Map T.Text UnqualIdentifier+data UnqualIdentifier = UnqualIdentifier+ { importByMod :: T.Text+ , identifier :: T.Text+ , parentTy :: Maybe IdInfo+ , isOperator :: Bool+ , namespace :: Maybe Namespace+ } deriving (Show, Eq, Ord)++data Namespace+ = PatternNS+ | TypeNS+ deriving (Show, Eq, Ord)++data IdInfo = IdInfo+ { idLabel :: T.Text+ , idIsOp :: Bool+ , idNamespace :: Maybe Namespace+ } deriving (Show, Eq, Ord)++localConfigFile, homeConfigFile :: FilePath+localConfigFile = "./.autoimport"+homeConfigFile = "~/.autoimport"++resolveConfig :: Maybe FilePath -> IO Config+resolveConfig mLocalConfigFileOverride = do+ mCached <- readIORef configCacheRef+ let localFile = fromMaybe localConfigFile mLocalConfigFileOverride+ case mCached of+ Just configCache -> do+ mLocalModTime <-+ Dir.doesFileExist localFile >>= \case+ True -> Just <$> Dir.getModificationTime localFile+ False -> pure Nothing+ mHomeModTime <-+ Dir.doesFileExist homeConfigFile >>= \case+ True -> Just <$> Dir.getModificationTime homeConfigFile+ False -> pure Nothing+ if mLocalModTime /= localModTime configCache+ || mHomeModTime /= homeModTime configCache+ then readAndCacheConfig localFile+ else pure $ cachedConfig configCache+ Nothing -> readAndCacheConfig localFile++readAndCacheConfig :: FilePath -> IO Config+readAndCacheConfig localFile = do+ mHomeCfg <- readConfigFile homeConfigFile+ mLocalCfg <- readConfigFile localFile+ case (fst <$> mLocalCfg) <> (fst <$> mHomeCfg) of+ Nothing -> do+ BS8.putStrLn "'.autoimport' file not found by auto-import plugin"+ writeIORef configCacheRef Nothing+ pure mempty+ Just cfg -> do+ let cache = ConfigCache+ { cachedConfig = cfg+ , localModTime = snd <$> mLocalCfg+ , homeModTime = snd <$> mHomeCfg+ }+ writeIORef configCacheRef (Just cache)+ pure cfg++readConfigFile :: FilePath -> IO (Maybe (Config, UTCTime))+readConfigFile file = do+ exists <- Dir.doesFileExist file+ if exists+ then do+ content <- T.readFile file+ modTime <- Dir.getModificationTime file+ case parseConfig file content of+ Left err -> do+ let diag = ConfigParseFailDiag err+ msgEnv =+ Ghc.mkPlainErrorMsgEnvelope+ Ghc.noSrcSpan+ (Ghc.ghcUnknownMessage diag)+ throw $ Ghc.mkSrcErr (Ghc.mkMessages $ Ghc.unitBag msgEnv)+ Right cfg -> pure $ Just (cfg, modTime)+ else pure Nothing++parseConfig :: String -> T.Text -> Either String Config+parseConfig fileName content =+ first Parse.errorBundlePretty $ Parse.runParser parser fileName content+ where+ parser = do+ _ <- Parse.optional skipSpaceNoIndent+ mconcat+ <$> (Parse.many p <* Parse.space <* Parse.eof)+ p = ((parseConfigEntry <* Parse.optional parseLineComment)+ <|> (mempty <$ parseLineComment))+ <* skipSpaceNoIndent++parseConfigEntry :: Parse.Parsec Void T.Text Config+parseConfigEntry = do+ moName <- parseModName++ let parseUnqualIdsEntry =+ (\ids -> mempty+ {unqualIdentifiers = M.fromList $ (\i -> (identifier i, i)) <$> ids}+ ) <$> parseUnqualIds moName+ parseQualModEntry =+ (\qualMod -> mempty+ {qualModules = MonoidMap $+ M.singleton (fromMaybe (modName qualMod) (modQual qualMod)) [qualMod]+ }) <$> parseModQual moName+ selfQualMod = pure mempty+ {qualModules = MonoidMap $+ M.singleton moName [QualMod moName Nothing]+ }++ ( do+ Parse.try hspaceOrIndent+ parseUnqualIdsEntry <|> parseQualModEntry+ ) <|> selfQualMod++parseModQual :: T.Text -> Parse.Parsec Void T.Text QualMod+parseModQual moName = do+ qual <- do+ Parse.string "as" *> Parse.hspace1+ parseModName+ pure $ QualMod moName (Just qual)++parseModName :: Parse.Parsec Void T.Text T.Text+parseModName = T.intercalate "." <$> Parse.sepBy1 parseSegment (Parse.char '.')+ where+ parseSegment = do+ h <- Parse.upperChar+ rest <- Parse.many (Parse.satisfy (\c -> Char.isAlphaNum c || c == '_'))+ Parse.<?> "module name chars"+ pure . T.pack $ h : rest++parseUnqualIds :: T.Text -> Parse.Parsec Void T.Text [UnqualIdentifier]+parseUnqualIds moName = concat <$>+ Parse.between (Parse.char '(' <* hspaceOrIndent) (Parse.char ')')+ (Parse.sepBy1 (parseIdentifier moName <* hspaceOrIndent) (Parse.char ',' <* hspaceOrIndent))++parseIdentifier :: T.Text -> Parse.Parsec Void T.Text [UnqualIdentifier]+parseIdentifier moName = do+ mNamespace <- Parse.try . Parse.optional $+ (patternP <|> typeP) <* Parse.hspace1+ (parent, parentIsOp) <- identP <|> operatorP+ let parentId =+ UnqualIdentifier+ { importByMod = moName+ , identifier = parent+ , parentTy = Nothing+ , isOperator = parentIsOp+ , namespace = mNamespace+ }+ if parentIsOp || T.all Char.isUpper (T.take 1 parent)+ then do+ hspaceOrIndent+ mChildIds <- Parse.optional childIdsP+ case mChildIds of+ Nothing -> pure [ parentId ]+ Just childIds -> pure . (parentId :) $+ (\(cid, isOp) -> UnqualIdentifier+ { importByMod = moName+ , identifier = cid+ , parentTy = Just (IdInfo parent parentIsOp mNamespace)+ , isOperator = isOp+ , namespace = Nothing+ }) <$> childIds+ else pure [ parentId ]++ where+ identP = do+ fc <- Parse.char '_' <|> Parse.letterChar+ rest <- Parse.many (Parse.satisfy (\c -> Char.isAlphaNum c || c `elem` ['_', '\'', '#']))+ Parse.<?> "identifier chars"+ pure (T.pack $ fc : rest, False)+ operatorP = (, True) . T.pack <$>+ Parse.between (Parse.char '(' <* Parse.hspace) (Parse.hspace *> Parse.char ')')+ (Parse.some (Parse.oneOf (":!#$%&*+./<=>?@\\^|-~" :: String) Parse.<?> "operator char"))+ childIdsP =+ Parse.between (Parse.char '(' <* hspaceOrIndent) (Parse.char ')') $+ Parse.sepBy1 (identP <|> operatorP <* hspaceOrIndent)+ (Parse.char ',' <* hspaceOrIndent)+ patternP = PatternNS <$ Parse.string "pattern"+ typeP = TypeNS <$ Parse.string "type"++parseLineComment :: Parse.Parsec Void T.Text ()+parseLineComment = do+ Parse.hspace+ Parse.skipLineComment "--"++-- Skip horizontal and vertical space until unindented text is found+skipSpaceNoIndent :: Parse.Parsec Void T.Text ()+skipSpaceNoIndent =+ void (Parse.some (Parse.hspace *> Parse.eol))+ <|> Parse.eof++-- | Parse any amount of whitespace not ending in a newline+hspaceOrIndent :: Parse.Parsec Void T.Text ()+hspaceOrIndent = do+ Parse.hspace+ (do void Parse.eol+ s : _ <- reverse <$> Parse.some Parse.spaceChar+ guard (s /= '\n')+ ) <|> pure ()++-- | Diagnostic thrown when config parsing fails+newtype ConfigParseFailDiag = ConfigParseFailDiag String++instance Ghc.Diagnostic ConfigParseFailDiag where+ type DiagnosticOpts ConfigParseFailDiag = Ghc.NoDiagnosticOpts+ diagnosticMessage _ (ConfigParseFailDiag err) = Ghc.mkSimpleDecorated $+ Ghc.text err+ diagnosticReason _ = Ghc.ErrorWithoutFlag+ diagnosticHints _ = []+ diagnosticCode _ = Nothing+#if !MIN_VERSION_ghc(9,8,0)+ defaultDiagnosticOpts = Ghc.NoDiagnosticOpts+#endif
+ src/AutoImport/GhcFacade.hs view
@@ -0,0 +1,259 @@+{-# LANGUAGE CPP #-}+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE PatternSynonyms #-}+module AutoImport.GhcFacade+ ( module Ghc+ , ann'+ , noAnnSrcSpanDP'+ , nameParensAdornment+ , ieThingWithAnn+ , importListAnn+ , nameAnn+ , importEpAnn+ , hasTrailingComma+ , epTokD0+ , pattern IEThingWith'+ , pattern IEVar'+ , pattern TcRnSolverReport'+ , pattern IEThingAbs'+ ) where++import GHC as Ghc+import GHC.Data.Bag as Ghc+import GHC.Data.FastString as Ghc+import GHC.Driver.Env as Ghc+import GHC.Driver.Errors.Types as Ghc+import GHC.Driver.Hooks as Ghc+import GHC.Driver.Pipeline.Execute as Ghc+import GHC.Driver.Pipeline.Phases as Ghc+import GHC.Driver.Plugins as Ghc+import GHC.Driver.Monad as Ghc+import GHC.Tc.Errors.Types as Ghc+import GHC.Tc.Types.Constraint as Ghc+import GHC.Types.Error as Ghc+import GHC.Types.Name.Occurrence as Ghc+import GHC.Types.Name.Reader as Ghc+import GHC.Types.SourceError as Ghc+import GHC.Types.SourceText as Ghc+import GHC.Types.SrcLoc as Ghc+import GHC.Unit.Module.ModSummary as Ghc+import GHC.Utils.Error as Ghc+import GHC.Utils.Outputable as Ghc+import GHC.Utils.Misc as Ghc+#if MIN_VERSION_ghc(9,8,0)+import GHC.Driver.DynFlags as Ghc+#else+import GHC.Driver.Flags as Ghc+import GHC.Driver.Session as Ghc+#endif++import qualified Language.Haskell.GHC.ExactPrint as EP++#if MIN_VERSION_ghc(9,10,0)+ann' :: Ghc.EpAnn ann -> Ghc.EpAnn ann+ann' = id+#else+ann' :: Ghc.SrcSpanAnnA -> Ghc.EpAnn Ghc.AnnListItem+ann' = Ghc.ann+#endif++noAnnSrcSpanDP'+#if MIN_VERSION_ghc(9,10,0)+ :: Ghc.NoAnn ann+ => Ghc.DeltaPos -> Ghc.EpAnn ann+#else+ :: Monoid ann+ => Ghc.DeltaPos -> Ghc.SrcSpanAnn' (Ghc.EpAnn ann)+#endif+noAnnSrcSpanDP'+#if MIN_VERSION_ghc(9,10,0)+ = EP.noAnnSrcSpanDP+#else+ = EP.noAnnSrcSpanDP Ghc.noSrcSpan+#endif++nameParensAdornment :: Ghc.NameAdornment+nameParensAdornment =+#if MIN_VERSION_ghc(9,12,0)+ Ghc.NameParens (Ghc.EpTok EP.d0) (Ghc.EpTok EP.d0)+#else+ Ghc.NameParens+#endif++ieThingWithAnn :: Ghc.XIEThingWith Ghc.GhcPs+ieThingWithAnn =+#if MIN_VERSION_ghc(9,12,0)+ (Nothing, (Ghc.EpTok EP.d0, Ghc.noAnn, Ghc.noAnn, Ghc.EpTok EP.d0))+#elif MIN_VERSION_ghc(9,10,0)+ (Nothing, [Ghc.AddEpAnn Ghc.AnnOpenP EP.d0, Ghc.AddEpAnn Ghc.AnnCloseP EP.d0])+#elif MIN_VERSION_ghc(9,8,0)+ ( Nothing+ , Ghc.EpAnn (Ghc.Anchor Ghc.placeholderRealSpan EP.m0)+ [Ghc.AddEpAnn Ghc.AnnOpenP EP.d0, Ghc.AddEpAnn Ghc.AnnCloseP EP.d0]+ Ghc.emptyComments+ )+#else+ Ghc.EpAnn (Ghc.Anchor Ghc.placeholderRealSpan EP.m0)+ [Ghc.AddEpAnn Ghc.AnnOpenP EP.d0, Ghc.AddEpAnn Ghc.AnnCloseP EP.d0]+ Ghc.emptyComments+#endif++#if MIN_VERSION_ghc(9,12,0)+importListAnn :: Ghc.EpAnn (Ghc.AnnList (Ghc.EpToken "hiding", [Ghc.EpToken ","]))+#elif MIN_VERSION_ghc(9,10,0)+importListAnn :: Ghc.EpAnn Ghc.AnnList+#else+importListAnn :: Ghc.SrcSpanAnn' (Ghc.EpAnn Ghc.AnnList)+#endif+importListAnn =+#if MIN_VERSION_ghc(9,12,0)+ (noAnnSrcSpanDP' @(Ghc.AnnList (Ghc.EpToken "hiding", [Ghc.EpToken ","])) $ Ghc.SameLine 0)+ { Ghc.anns = (Ghc.noAnn :: Ghc.AnnList (Ghc.EpToken "hiding", [Ghc.EpToken ","]))+ { Ghc.al_brackets = Ghc.ListParens (Ghc.EpTok EP.d1) (Ghc.EpTok EP.d0)+ , Ghc.al_rest = (Ghc.noAnn, [])+ }+ }+#elif MIN_VERSION_ghc(9,10,0)+ (noAnnSrcSpanDP' @Ghc.AnnList $ Ghc.SameLine 0)+ { Ghc.anns = (Ghc.noAnn :: Ghc.AnnList)+ { Ghc.al_open = Just $ Ghc.AddEpAnn Ghc.AnnOpenP EP.d1+ , Ghc.al_close = Just $ Ghc.AddEpAnn Ghc.AnnCloseP EP.d0+ }+ }+#else+ (noAnnSrcSpanDP' @Ghc.AnnList $ Ghc.SameLine 0)+ { Ghc.ann = Ghc.EpAnn+ { Ghc.anns = mempty+ { Ghc.al_open = Just $ Ghc.AddEpAnn Ghc.AnnOpenP EP.d0+ , Ghc.al_close = Just $ Ghc.AddEpAnn Ghc.AnnCloseP EP.d0+ }+ , Ghc.entry = Ghc.Anchor Ghc.placeholderRealSpan EP.m1+ , Ghc.comments = Ghc.emptyComments+ }+ }+#endif++nameAnn+ :: Bool+ -> Bool+#if MIN_VERSION_ghc(9,10,0)+ -> Ghc.EpAnn Ghc.NameAnn+#else+ -> Ghc.SrcSpanAnn' (Ghc.EpAnn Ghc.NameAnn)+#endif+nameAnn needsParens addLeftSpace =+#if MIN_VERSION_ghc(9,12,0)+ (Ghc.noAnn :: Ghc.EpAnn Ghc.NameAnn)+ { Ghc.anns = Ghc.NameAnn+ { Ghc.nann_adornment = if needsParens then nameParensAdornment else Ghc.NameNoAdornment+ , Ghc.nann_name = EP.d0+ , Ghc.nann_trailing = []+ }+ , Ghc.entry = if addLeftSpace then EP.d1 else EP.d0+ }+#elif MIN_VERSION_ghc(9,10,0)+ (Ghc.noAnn :: Ghc.EpAnn Ghc.NameAnn)+ { Ghc.anns = if needsParens+ then Ghc.NameAnn+ { Ghc.nann_adornment = nameParensAdornment+ , Ghc.nann_name = EP.d0+ , Ghc.nann_trailing = []+ , Ghc.nann_open = Ghc.noAnn+ , Ghc.nann_close = Ghc.noAnn+ }+ else Ghc.noAnn+ , Ghc.entry = if addLeftSpace then EP.d1 else EP.d0+ }+#else+ Ghc.SrcSpanAnn+ { Ghc.ann = Ghc.EpAnn+ { Ghc.anns = if needsParens+ then Ghc.NameAnn+ { Ghc.nann_adornment = nameParensAdornment+ , Ghc.nann_name = EP.d0+ , Ghc.nann_trailing = []+ , Ghc.nann_open = EP.d0+ , Ghc.nann_close = EP.d0+ }+ else mempty+ , Ghc.entry = Ghc.Anchor Ghc.placeholderRealSpan $+ if addLeftSpace then EP.m1 else EP.m0+ , Ghc.comments = Ghc.emptyComments+ }+ , Ghc.locA = Ghc.noSrcSpan+ }+#endif++importEpAnn :: Ghc.EpAnn Ghc.EpAnnImportDecl+#if MIN_VERSION_ghc(9,12,0)+importEpAnn = (Ghc.noAnn :: Ghc.EpAnn Ghc.EpAnnImportDecl)+ { Ghc.anns = Ghc.noAnn+ { Ghc.importDeclAnnImport = Ghc.EpTok Ghc.noAnn }+ }+#elif MIN_VERSION_ghc(9,10,0)+importEpAnn = Ghc.noAnn+#else+importEpAnn =+ Ghc.EpAnn+ { Ghc.entry = Ghc.Anchor Ghc.placeholderRealSpan EP.m0+ , Ghc.anns = Ghc.EpAnnImportDecl+ { Ghc.importDeclAnnImport = EP.d0+ , Ghc.importDeclAnnPragma = Nothing+ , Ghc.importDeclAnnSafe = Nothing+ , Ghc.importDeclAnnQualified = Nothing+ , Ghc.importDeclAnnPackage = Nothing+ , Ghc.importDeclAnnAs = Nothing+ }+ , Ghc.comments = Ghc.emptyComments+ }+#endif++#if MIN_VERSION_ghc(9,12,0)+epTokD0 :: Ghc.EpToken tok+epTokD0 = Ghc.EpTok EP.d0+#else+epTokD0 :: Ghc.EpaLocation+epTokD0 = EP.d0+#endif++hasTrailingComma :: SrcSpanAnnA -> Bool+#if MIN_VERSION_ghc(9,10,0)+hasTrailingComma = any (\case Ghc.AddCommaAnn{} -> True; _ -> False)+ . Ghc.lann_trailing . Ghc.anns+#else+hasTrailingComma x =+ case Ghc.ann x of+ Ghc.EpAnnNotUsed -> False+ ann -> any (\case Ghc.AddCommaAnn{} -> True; _ -> False)+ . Ghc.lann_trailing $ Ghc.anns ann+#endif++pattern IEThingWith' :: XIEThingWith Ghc.GhcPs -> LIEWrappedName Ghc.GhcPs -> IEWildcard -> [LIEWrappedName Ghc.GhcPs] -> Ghc.IE Ghc.GhcPs+#if MIN_VERSION_ghc(9,10,0)+pattern IEThingWith' x name wc children = Ghc.IEThingWith x name wc children Nothing+#else+pattern IEThingWith' x name wc children = Ghc.IEThingWith x name wc children+#endif++pattern IEThingAbs' :: LIEWrappedName Ghc.GhcPs -> Ghc.IE Ghc.GhcPs+#if MIN_VERSION_ghc(9,10,0)+pattern IEThingAbs' name <- Ghc.IEThingAbs _ name _+#else+pattern IEThingAbs' name <- Ghc.IEThingAbs _ name+#endif++pattern IEVar' :: LIEWrappedName Ghc.GhcPs -> Ghc.IE Ghc.GhcPs+#if MIN_VERSION_ghc(9,10,0)+pattern IEVar' name = Ghc.IEVar Nothing name Nothing+#elif MIN_VERSION_ghc(9,8,0)+pattern IEVar' name = Ghc.IEVar Nothing name+#else+pattern IEVar' name = Ghc.IEVar Ghc.NoExtField name+#endif++pattern TcRnSolverReport' :: Ghc.SolverReportWithCtxt -> Ghc.TcRnMessage+#if MIN_VERSION_ghc(9,10,0)+pattern TcRnSolverReport' report <- Ghc.TcRnSolverReport report _+#else+pattern TcRnSolverReport' report <- Ghc.TcRnSolverReport report _ _+#endif
+ test/Main.hs view
@@ -0,0 +1,62 @@+{-# LANGUAGE CPP #-}+module Main (main) where++import Control.Monad+import Test.Tasty+import Test.Tasty.HUnit+import qualified System.Directory as Dir+import qualified System.Process as Proc++main :: IO ()+main = defaultMain $ testGroup "Tests"+ [ testGroup "qualified"+ [ testCase "1" $ runTest "Case1.hs"+ , testCase "2" $ runTest "Case2.hs"+ , testCase "3" $ runTest "Case3.hs"+ , testCase "4" $ runTest "Case4.hs"+ , testCase "5" $ runTest "Case5.hs"+ , testCase "6" $ runTest "Case6.hs"+ , testCase "7" $ runTest "Case7.hs"+ , testCase "8" $ runTest "Case8.hs"+ , testCase "25" $ runTest "Case25.hs"+ ]+ , testGroup "unqualified"+ [ testCase "9" $ runTest "Case9.hs"+ , testCase "10" $ runTest "Case10.hs"+ , testCase "11" $ runTest "Case11.hs"+ , testCase "12" $ runTest "Case12.hs"+ , testCase "13" $ runTest "Case13.hs"+ , testCase "14" $ runTest "Case14.hs"+ , testCase "15" $ runTest "Case15.hs"+ , testCase "16" $ runTest "Case16.hs"+ , testCase "17" $ runTest "Case17.hs"+ , testCase "18" $ runTest "Case18.hs"+ , testCase "19" $ runTest "Case19.hs"+ , testCase "20" $ runTest "Case20.hs"+ , testCase "21" $ runTest "Case21.hs"+ , testCase "22" $ runTest "Case22.hs"+ , testCase "23" $ runTest "Case23.hs"+ , testCase "24" $ runTest "Case24.hs"+ ]+ ]++testModulePath :: String -> FilePath+testModulePath name = "test-modules/" <> name++-- copy the input file contents to the module file to be compiled+prepTest :: FilePath -> IO ()+prepTest modFile = do+ inp <- readFile (modFile ++ ".input")+ writeFile modFile inp++runTest :: FilePath -> Assertion+runTest name = do+ let modFile = testModulePath name+ prepTest modFile+ (_, _, _, h) <- Proc.createProcess $+ Proc.proc "cabal" ["build", "test-modules:" ++ takeWhile (/= '.') name]+ void $ Proc.waitForProcess h+ updatedMod <- readFile modFile+ expectedMod <- readFile $ modFile ++ ".expected"+ assertEqual "Expected update" expectedMod updatedMod+ Dir.removeFile modFile