auto-export (empty) → 0.1.0.0
raw patch · 7 files changed
+675/−0 lines, 7 filesdep +basedep +bytestringdep +containers
Dependencies added: base, bytestring, containers, directory, ghc, ghc-exactprint, ghc-paths, mtl, process, tasty, tasty-hunit
Files
- CHANGELOG.md +5/−0
- LICENSE +29/−0
- README.md +71/−0
- auto-export.cabal +55/−0
- src/AutoExport.hs +297/−0
- src/AutoExport/GhcFacade.hs +167/−0
- test/Main.hs +51/−0
+ CHANGELOG.md view
@@ -0,0 +1,5 @@+# Revision history for auto-export++## 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,71 @@+# auto-export :outbox_tray:++This is a GHC plugin that edits the file being compiled by adding a target+top-level definition to the explicit export list of the module.++### 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.+Here is an example command for starting a REPL for a stack project with the+`auto-export` plugin enabled (you may need to add `auto-export` to your+`extra-deps` first):++```+stack repl my-project --package auto-export --ghci-options='-fplugin AutoExport'+```++likewise for a cabal project (you may need to run `cabal update` first):++```+cabal repl my-project --build-depends auto-export --repl-options='-fplugin AutoExport'+```++With the plugin enabled, mark the expression to be exported by placing+`!EXPORT` on a line above it then compile the module. If the module has an+explicit export list, the definition will be automatically added to it.+Compilation is aborted after the code is updated.++For example, given this program:++```haskell+module M () where++data Colors = Red | Green | Blue+ deriving (Enum, Bounded)++allColors :: [Colors]+allColors = [minBound .. maxBound]+```++Insert the export targets:++```haskell+module M () where++!EXPORT+data Colors = Red | Green | Blue+ deriving (Enum, Bounded)++!EXPORT+allColors :: [Colors]+allColors = [minBound .. maxBound]+```++Compiling the module will result in the source code being updated to:++```haskell+module M (Colors(..), allColors) where++data Colors = Red | Green | Blue+ deriving (Enum, Bounded)++allColors :: [Colors]+allColors = [minBound .. maxBound]+```++Data declarations and type classes are always exported in full using `(..)`.++The plugin only supports certain GHC versions with the intent of supporting the+four latest release series, i.e. `9.6.*` thru `9.12.*`. The cabal file+indicates the currently supported versions.
+ auto-export.cabal view
@@ -0,0 +1,55 @@+cabal-version: 3.0+name: auto-export+version: 0.1.0.0+synopsis: Automatically add things to module export list+description: Automatically add things to module export list using a GHC plugin+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-export++common warnings+ ghc-options: -Wall++library+ import: warnings+ exposed-modules: AutoExport+ AutoExport.GhcFacade+ -- other-modules:+ default-extensions: LambdaCase+ build-depends: base < 5,+ ghc >= 9.6 && < 9.13,+ bytestring < 0.13,+ mtl >= 2.3,+ ghc-exactprint,+ ghc-paths,+ containers+ hs-source-dirs: src+ default-language: GHC2021++test-suite auto-export-test+ import: warnings+ default-language: GHC2021+ -- other-modules:+ -- other-extensions:+ type: exitcode-stdio-1.0+ hs-source-dirs: test+ main-is: Main.hs+ ghc-options: -threaded -rtsopts -with-rtsopts=-N+ build-depends:+ base <5,+ process,+ directory,+ tasty,+ tasty-hunit,+ ghc
+ src/AutoExport.hs view
@@ -0,0 +1,297 @@+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE CPP #-}+module AutoExport+ ( plugin+ ) where++import Control.Exception+import Control.Monad.IO.Class (liftIO)+import qualified Control.Monad.Writer.CPS as W+import qualified Data.ByteString as BS hiding (uncons)+import qualified Data.ByteString.Char8 as BS+import qualified Data.ByteString.Internal as BS+import qualified Data.Char as Char+import Data.Maybe+import Data.Monoid+import qualified Data.Set as Set+import Data.String+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 qualified AutoExport.GhcFacade as Ghc++plugin :: Ghc.Plugin+plugin = Ghc.defaultPlugin+ { Ghc.driverPlugin = const modifyHscEnv+ , Ghc.pluginRecompile = mempty+ }++modifyHscEnv :: Ghc.HscEnv -> IO Ghc.HscEnv+modifyHscEnv hscEnv =+ pure hscEnv { Ghc.hsc_hooks = modifyHooks (Ghc.hsc_hooks hscEnv) }+ where+ isExportError msgEnv =+ case Ghc.errMsgDiagnostic msgEnv of+ Ghc.GhcPsMessage (Ghc.PsErrBangPatWithoutSpace (Ghc.L _ (Ghc.HsVar _ (Ghc.L _ rdr))))+ | "EXPORT" <- rdrNameFS rdr -> True+ _ -> False++ modifyHooks hooks =+ let runPhaseOrExistingHook :: Ghc.TPhase res -> IO res+ runPhaseOrExistingHook = maybe Ghc.runPhase (\(Ghc.PhaseHook h) -> h)+ $ Ghc.runPhaseHook hooks+ phaseHook :: Ghc.PhaseHook+ phaseHook = Ghc.PhaseHook $ \phase -> case phase of+ Ghc.T_Hsc env modSum -> catch (runPhaseOrExistingHook phase) $+ \ (Ghc.SourceError msgs) ->+ case any isExportError $ Ghc.getMessages msgs of+ True | Just updatedBuffer <- modifyBuffer =<< Ghc.ms_hspp_buf modSum+ -> do+ let innerPlugin = mkInnerPlugin hscEnv+ updatedModSum = modSum { Ghc.ms_hspp_buf = Just updatedBuffer }+ staticPlugin = Ghc.StaticPlugin+ { Ghc.spPlugin = Ghc.PluginWithArgs innerPlugin []+#if MIN_VERSION_ghc(9,12,0)+ , Ghc.spInitialised = True+#endif+ }+ newEnv = env+ { Ghc.hsc_plugins = let plugins = Ghc.hsc_plugins hscEnv in plugins+ { Ghc.staticPlugins = staticPlugin : Ghc.staticPlugins plugins }+ }+ runPhaseOrExistingHook (Ghc.T_Hsc newEnv updatedModSum)+ _ -> throw $ Ghc.SourceError msgs+ _ -> runPhaseOrExistingHook phase+ in hooks+ { Ghc.runPhaseHook = Just phaseHook }++rdrNameFS :: Ghc.RdrName -> Ghc.FastString+rdrNameFS = Ghc.occNameFS . Ghc.rdrNameOcc++modifyBuffer :: Ghc.StringBuffer -> Maybe Ghc.StringBuffer+modifyBuffer = fmap Ghc.stringBufferFromByteString . rewriteRawExtract . stringBufferToBS++stringBufferToBS :: Ghc.StringBuffer -> BS.ByteString+stringBufferToBS Ghc.StringBuffer {Ghc.buf = buf, Ghc.len = len} =+ BS.BS buf len++rewriteRawExtract :: BS.ByteString -> Maybe BS.ByteString+rewriteRawExtract = toMaybe . W.runWriter . traverse update . BS.lines+ where+ update x | isExportCmd x = W.writer ("{-# ANN EXPORT () #-}", Any True)+ | otherwise = pure x+ toMaybe (x, Any True) = Just $ BS.unlines x+ toMaybe _ = Nothing++removeExportCmds :: BS.ByteString -> BS.ByteString+removeExportCmds = BS.unlines . filter (not . isExportCmd) . BS.lines++isExportCmd :: BS.ByteString -> Bool+isExportCmd = (== "!EXPORT") . BS.strip++mkInnerPlugin :: Ghc.HscEnv -> Ghc.Plugin+mkInnerPlugin hscEnv = Ghc.defaultPlugin+ { Ghc.parsedResultAction = \_ modSum result -> do+ let newExportItems =+ getExports . Ghc.hsmodDecls . Ghc.unLoc . Ghc.hpm_module+ $ Ghc.parsedResultModule result+ case Ghc.ml_hs_file (Ghc.ms_location modSum) of+ Nothing -> pure result+ Just filePath -> do+ liftIO $ prepareSourceForParsing filePath+ let dynFlags = Ghc.ms_hspp_opts modSum `Ghc.gopt_set` Ghc.Opt_KeepRawTokenStream+ parseResult <- liftIO $ parseModule hscEnv dynFlags filePath+ case parseResult of+ (Right parsedMod, usesCpp) ->+ liftIO $ modifyModule parsedMod usesCpp newExportItems filePath+ (Left _, _) -> pure ()++ let exportErr =+ let fn = fromMaybe "<UNKNOWN>" $ Ghc.ml_hs_file (Ghc.ms_location modSum)+ in Ghc.mkPlainErrorMsgEnvelope+ (Ghc.mkGeneralSrcSpan $ fromString fn)+ (Ghc.ghcUnknownMessage ExportDiag)+ Ghc.throwOneError exportErr+ }++modifyModule+ :: Ghc.ParsedSource+ -> Bool+ -> [Ghc.IE Ghc.GhcPs]+ -> FilePath+ -> IO ()+modifyModule parsedMod usesCpp newIEs filePath = do+ putStrLn . Ghc.showSDocUnsafe $ Ghc.ppr newIEs+ let ast = EP.makeDeltaAst parsedMod+ addIEs m = m+ { Ghc.hsmodExports = fmap (addExports newIEs) <$> Ghc.hsmodExports m }+ updatedMod = addIEs <$> ast+ -- 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.+ let removeTrailingNewlines+ | usesCpp =+ reverse . ('\n' :) . dropWhile (== '\n') . reverse+ | otherwise = id+ printed = removeTrailingNewlines $ EP.exactPrint updatedMod+ writeFile filePath printed++addExports :: [Ghc.IE Ghc.GhcPs] -> [Ghc.LIE Ghc.GhcPs] -> [Ghc.LIE Ghc.GhcPs]+addExports [] lies = lies+addExports newIEs lies = liesWithComma ++ newIEsWithCommas+ where+ existingNames = Set.fromList $ Ghc.ieName . Ghc.unLoc <$> lies+ iesToAdd = filter ((`Set.notMember` existingNames) . Ghc.ieName) newIEs+ addComma (Ghc.L l ie) = Ghc.L (EP.addComma l) ie+ liesWithComma = case reverse lies of+ l : ls -> reverse $ addComma l : ls+ [] -> []+ newIEsWithCommas = case reverse (Ghc.L Ghc.anchorD1 <$> iesToAdd) of+ l : ls -> reverse $ l : (addComma <$> ls)+ [] -> []++getExports :: [Ghc.LHsDecl Ghc.GhcPs] -> [Ghc.IE Ghc.GhcPs]+getExports (Ghc.L _ a : Ghc.L locB b : rest)+ | Ghc.AnnD _ (Ghc.HsAnnotation _ prov _) <- a+ , Ghc.ValueAnnProvenance (Ghc.L _ rdrName) <- prov+ , "EXPORT" <- rdrNameFS rdrName+ , ies <- mkIE b+ = ies ++ getExports (Ghc.L locB b : rest)+ | otherwise = getExports (Ghc.L locB b : rest)+getExports _ = []++mkIE :: Ghc.HsDecl Ghc.GhcPs -> [Ghc.IE Ghc.GhcPs]+mkIE = \case+ Ghc.TyClD _ tyCl ->+ let getTyName = Ghc.unLoc . Ghc.tyClDeclLName+ in case tyCl of+ _ | Ghc.isTypeFamilyDecl tyCl -> [mkThingAbsIE (getTyName tyCl)]+ _ | Ghc.isDataFamilyDecl tyCl -> [mkThingAllIE False (getTyName tyCl)]+ Ghc.SynDecl{} -> [mkThingAbsIE (getTyName tyCl)]+ _ -> [mkThingAllIE (isTypeData tyCl) (getTyName tyCl)]+ Ghc.ValD _ (Ghc.FunBind _ (Ghc.L _ name) _) -> [mkVarIE name]+ Ghc.ValD _ (Ghc.PatSynBind _ psb) -> [mkPatternIE (Ghc.unLoc $ Ghc.psb_id psb)]+ Ghc.SigD _ sig -> case sig of+ Ghc.TypeSig _ names _ -> mkVarIE . Ghc.unLoc <$> names+ Ghc.PatSynSig _ names _ -> mkPatternIE . Ghc.unLoc <$> names+ _ -> []+ Ghc.KindSigD _ (Ghc.StandaloneKindSig _ (Ghc.L _ name) _) -> [mkThingAbsIE name]+ Ghc.ForD _ for -> [mkVarIE . Ghc.unLoc $ Ghc.fd_name for]+ Ghc.InstD _ Ghc.DataFamInstD{Ghc.dfid_inst = inst} ->+ [mkThingAllIE False . Ghc.unLoc . Ghc.feqn_tycon $ Ghc.dfid_eqn inst]+ _ -> []+ where+ mkThingAllIE :: Bool -> Ghc.RdrName -> Ghc.IE Ghc.GhcPs+ mkThingAllIE isTyData name =+ Ghc.IEThingAll Ghc.ieThingAllAnn+ (Ghc.L Ghc.noSrcSpanA+ (if isOperator name || isTyData+ then+ Ghc.IEType Ghc.ieTypeAnn+ (addOpParens $ Ghc.L Ghc.anchorD1 name)+ else+ Ghc.IEName Ghc.noExtField+ (addOpParens $ Ghc.L Ghc.anchorD0 name)+ )+ )+#if MIN_VERSION_ghc(9,10,0)+ Nothing+#endif+ mkVarIE :: Ghc.RdrName -> Ghc.IE Ghc.GhcPs+ mkVarIE name = Ghc.ieVar+ (Ghc.L Ghc.noSrcSpanA+ (Ghc.IEName Ghc.noExtField . addOpParens $ Ghc.L Ghc.anchorD0 name)+ )+ mkPatternIE :: Ghc.RdrName -> Ghc.IE Ghc.GhcPs+ mkPatternIE name = Ghc.ieThingAbs+ (Ghc.L Ghc.noSrcSpanA+ (Ghc.IEPattern Ghc.iePatternAnn+ (addOpParens $ Ghc.L Ghc.anchorD1 name)+ )+ )+ mkThingAbsIE :: Ghc.RdrName -> Ghc.IE Ghc.GhcPs+ mkThingAbsIE name = Ghc.ieThingAbs+ (Ghc.L Ghc.noSrcSpanA+ (if isOperator name+ then+ Ghc.IEType Ghc.ieTypeAnn+ (addOpParens $ Ghc.L Ghc.anchorD1 name)+ else+ Ghc.IEName+ Ghc.noExtField+ (addOpParens $ Ghc.L Ghc.anchorD0 name)+ )+ )+ -- Adds parens for operators+ addOpParens :: Ghc.LIdP Ghc.GhcPs -> Ghc.LIdP Ghc.GhcPs+ addOpParens (Ghc.L loc name)+ | isOperator name =+ Ghc.L+#if MIN_VERSION_ghc(9,10,0)+ (loc { Ghc.anns = Ghc.nameAnnParens })+#else+ (loc { Ghc.ann = case Ghc.ann loc of+ Ghc.EpAnnNotUsed -> Ghc.noAnn -- doesn't happen+ a -> a { Ghc.anns = Ghc.nameAnnParens }+ })+#endif+ name+ | otherwise = Ghc.L loc name++ isTypeData = \case+ Ghc.DataDecl { Ghc.tcdDataDefn = defn } ->+ Ghc.isTypeDataDefnCons $ Ghc.dd_cons defn+ _ -> False++isOperator :: Ghc.RdrName -> Bool+isOperator name =+ case BS.uncons (Ghc.bytesFS $ rdrNameFS name) of+ Nothing -> False+ Just (c, _) ->+ c /= '_' && not (Char.isAlpha c)++-- | Parse the given module file. Accounts for CPP comments+parseModule+ :: Ghc.HscEnv+ -> Ghc.DynFlags+ -> FilePath+ -> 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+ )++-- | Diagnostic thrown when extraction occurs+data ExportDiag = ExportDiag++instance Ghc.Diagnostic ExportDiag where+ type DiagnosticOpts ExportDiag = Ghc.NoDiagnosticOpts+ diagnosticMessage _ _ = Ghc.mkSimpleDecorated $+ Ghc.text "Module updated by auto-export, compilation aborted"+ diagnosticReason _ = Ghc.ErrorWithoutFlag+ diagnosticHints _ = []+ diagnosticCode _ = Nothing+#if !MIN_VERSION_ghc(9,8,0)+ defaultDiagnosticOpts = Ghc.NoDiagnosticOpts+#endif+++prepareSourceForParsing+ :: FilePath+ -> IO ()+prepareSourceForParsing filePath = do+ content <- BS.readFile filePath+ BS.writeFile filePath (removeExportCmds content)
+ src/AutoExport/GhcFacade.hs view
@@ -0,0 +1,167 @@+{-# LANGUAGE CPP #-}+{-# OPTIONS_GHC -Wno-orphans #-}+module AutoExport.GhcFacade+ ( module Ghc+ , ieThingAllAnn+ , ieTypeAnn+ , iePatternAnn+ , nameAnnParens+ , anchorD1+ , anchorD0+ , ieVar+ , ieThingAbs+ ) where++import GHC.Driver.Plugins as Ghc+import GHC.Driver.Env.Types as Ghc+import GHC.Driver.Hooks as Ghc+import GHC.Driver.Pipeline.Phases as Ghc+import GHC.Driver.Pipeline.Execute as Ghc+import GHC.Types.SourceError as Ghc+import GHC.Types.Error as Ghc+import GHC.Unit.Module.ModSummary as Ghc+import Language.Haskell.Syntax.Expr as Ghc+import GHC.Driver.Errors.Types as Ghc+import GHC.Parser.Errors.Types as Ghc+import GHC.Types.SrcLoc as Ghc+import GHC.Types.Name.Reader as Ghc+import GHC.Types.Name.Occurrence as Ghc+import GHC.Data.FastString as Ghc+import GHC.Data.StringBuffer as Ghc+import Language.Haskell.Syntax.Decls as Ghc+import GHC.Hs.Extension as Ghc+import Language.Haskell.Syntax.ImpExp as Ghc+import GHC.Hs as Ghc+import GHC.Driver.Monad as Ghc+import GHC as Ghc+import GHC.Utils.Outputable as Ghc+import GHC.Utils.Error as Ghc+#if MIN_VERSION_ghc(9,8,0)+import GHC.Driver.DynFlags as Ghc+#else+import GHC.Driver.Session as Ghc+#endif++import qualified Language.Haskell.GHC.ExactPrint as EP++ieThingAllAnn :: Ghc.XIEThingAll Ghc.GhcPs+ieThingAllAnn =+#if MIN_VERSION_ghc(9,12,0)+ (Nothing, (Ghc.EpTok EP.d0, Ghc.EpTok EP.d0, Ghc.EpTok EP.d0))+#elif MIN_VERSION_ghc(9,10,0)+ (Nothing, [ Ghc.AddEpAnn Ghc.AnnOpenP EP.d0+ , Ghc.AddEpAnn Ghc.AnnDotdot 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.AnnDotdot 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.AnnDotdot EP.d0+ , Ghc.AddEpAnn Ghc.AnnCloseP EP.d0 ]+ Ghc.emptyComments+#endif++ieTypeAnn :: Ghc.XIEType Ghc.GhcPs+ieTypeAnn =+#if MIN_VERSION_ghc(9,12,0)+ (Ghc.EpTok EP.d0)+#else+ EP.d0+#endif++iePatternAnn :: Ghc.XIEPattern Ghc.GhcPs+iePatternAnn =+#if MIN_VERSION_ghc(9,12,0)+ (Ghc.EpTok EP.d0)+#else+ EP.d0+#endif++nameAnnParens :: Ghc.NameAnn+nameAnnParens =+#if MIN_VERSION_ghc(9,12,0)+ Ghc.NameAnn+ { Ghc.nann_adornment = Ghc.NameParens (Ghc.EpTok EP.d0) (Ghc.EpTok EP.d0)+ , Ghc.nann_name = EP.d0+ , Ghc.nann_trailing = []+ }+#else+ Ghc.NameAnn+ { Ghc.nann_adornment = Ghc.NameParens+ , Ghc.nann_open = EP.d0+ , Ghc.nann_name = EP.d0+ , Ghc.nann_close = EP.d0+ , Ghc.nann_trailing = []+ }+#endif++anchorD1, anchorD0+#if MIN_VERSION_ghc(9,10,0)+ :: Ghc.NoAnn ann => Ghc.EpAnn ann+anchorD1 = EP.noAnnSrcSpanDP1+anchorD0 = EP.noAnnSrcSpanDP0+#elif MIN_VERSION_ghc(9,6,0)+ :: Monoid ann => Ghc.SrcAnn ann++-- blarg+instance Monoid Ghc.NoEpAnns where+ mempty = Ghc.NoEpAnns++anchorD1 =+ Ghc.SrcSpanAnn+ (Ghc.EpAnn+ (Ghc.Anchor Ghc.placeholderRealSpan (Ghc.MovedAnchor (Ghc.SameLine 1)))+ mempty+ Ghc.emptyComments+ )+ Ghc.generatedSrcSpan+anchorD0 =+ Ghc.SrcSpanAnn+ (Ghc.EpAnn+ (Ghc.Anchor Ghc.placeholderRealSpan Ghc.UnchangedAnchor)+ mempty+ Ghc.emptyComments+ )+ Ghc.generatedSrcSpan+#endif++ieVar :: Ghc.LIEWrappedName Ghc.GhcPs -> Ghc.IE Ghc.GhcPs+ieVar name =+ Ghc.IEVar+#if MIN_VERSION_ghc(9,10,0)+ Ghc.noAnn+#elif MIN_VERSION_ghc(9,8,0)+ Nothing+#else+ Ghc.noExtField+#endif+ name+#if MIN_VERSION_ghc(9,10,0)+ Nothing+#endif++ieThingAbs :: Ghc.LIEWrappedName Ghc.GhcPs -> Ghc.IE Ghc.GhcPs+ieThingAbs name =+ Ghc.IEThingAbs+#if MIN_VERSION_ghc(9,10,0)+ Ghc.noAnn+#elif MIN_VERSION_ghc(9,8,0)+ (Nothing, Ghc.noAnn)+#else+ Ghc.noAnn+#endif+ name+#if MIN_VERSION_ghc(9,10,0)+ Nothing+#endif
+ test/Main.hs view
@@ -0,0 +1,51 @@+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"+ [ testCase "Class1" $ runTest "Class1.hs"+ , testCase "Data1" $ runTest "Data1.hs"+ , testCase "Data2" $ runTest "Data2.hs"+ , testCase "Data3" $ runTest "Data3.hs"+ , testCase "Data4" $ runTest "Data4.hs"+ , testCase "KindSig1" $ runTest "KindSig1.hs"+ , testCase "Pat1" $ runTest "Pat1.hs"+ , testCase "Pat2" $ runTest "Pat2.hs"+ , testCase "Ty1" $ runTest "Ty1.hs"+ , testCase "Ty2" $ runTest "Ty2.hs"+ , testCase "Ty3" $ runTest "Ty3.hs"+ , testCase "Ty4" $ runTest "Ty4.hs"+ , testCase "Ty5" $ runTest "Ty5.hs"+ , testCase "Ty6" $ runTest "Ty6.hs"+ , testCase "Var1" $ runTest "Var1.hs"+ , testCase "Var2" $ runTest "Var2.hs"+ , testCase "Var3" $ runTest "Var3.hs"+ , testCase "Var4" $ runTest "Var4.hs"+ , testCase "Var5" $ runTest "Var5.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