{-# LANGUAGE LambdaCase #-}
module Smuggler2.Plugin
( plugin,
)
where
import Avail ( AvailInfo, Avails )
import Control.Monad ( unless )
import Data.Bool ( bool )
import Data.Maybe ( fromMaybe, isNothing )
import Data.Version ( showVersion )
import DynFlags
( DynFlags(dumpDir), HasDynFlags(getDynFlags), xopt )
import ErrUtils ( compilationProgressMsg, fatalErrorMsg )
import GHC
( GenLocated(L),
GhcPs,
HsModule(hsmodExports, hsmodImports),
ImportDecl(ideclHiding, ideclImplicit),
LIE,
LImportDecl,
Located,
ms_location,
ml_hs_file,
ModSummary(ms_hspp_buf, ms_mod),
Module(moduleName),
ParsedSource,
moduleNameString,
unLoc )
import GHC.LanguageExtensions ( Extension(Cpp) )
import GHC.IO.Encoding ( setLocaleEncoding, utf8 )
import IOEnv ( MonadIO(liftIO), readMutVar )
import Language.Haskell.GHC.ExactPrint
( Anns,
TransformT,
addTrailingCommaT,
exactPrint,
graftT,
runTransform,
setEntryDPT )
import Language.Haskell.GHC.ExactPrint.Types ( DeltaPos(DP) )
import Outputable
( Outputable(ppr), neverQualify, printForUser, text, vcat )
import Paths_smuggler2 ( version )
import Plugins
( CommandLineOption,
Plugin(pluginRecompile, typeCheckResultAction),
defaultPlugin,
purePlugin )
import RnNames ( ImportDeclUsage, findImportUsage )
import Smuggler2.Anns ( mkLoc, mkParenT )
import Smuggler2.Imports ( getMinimalImports )
import Smuggler2.Exports ( mkExportAnnT )
import Smuggler2.Options
( ExportAction(AddExplicitExports, NoExportProcessing,
ReplaceExports),
ImportAction(MinimiseImports, NoImportProcessing),
Options(exportAction, importAction, newExtension),
parseCommandLineOptions )
import Smuggler2.Parser ( runParser )
import StringBuffer ( StringBuffer(StringBuffer), lexemeToString )
import System.Directory ( removeFile )
import System.FilePath ( (-<.>), (</>), isExtensionOf, takeExtension )
import System.IO ( IOMode(WriteMode), withFile )
import TcRnExports ( exports_from_avail )
import TcRnTypes
( TcGblEnv(tcg_rdr_env, tcg_imports, tcg_mod, tcg_exports,
tcg_rn_imports, tcg_used_gres, tcg_rn_exports),
TcM,
RnM )
plugin :: Plugin
plugin :: Plugin
plugin =
Plugin
defaultPlugin
{ typeCheckResultAction :: [CommandLineOption] -> ModSummary -> TcGblEnv -> TcM TcGblEnv
typeCheckResultAction = [CommandLineOption] -> ModSummary -> TcGblEnv -> TcM TcGblEnv
smugglerPlugin,
pluginRecompile :: [CommandLineOption] -> IO PluginRecompile
pluginRecompile = [CommandLineOption] -> IO PluginRecompile
purePlugin
}
smugglerPlugin :: [CommandLineOption] -> ModSummary -> TcGblEnv -> TcM TcGblEnv
smugglerPlugin :: [CommandLineOption] -> ModSummary -> TcGblEnv -> TcM TcGblEnv
smugglerPlugin [CommandLineOption]
clopts ModSummary
modSummary TcGblEnv
tcEnv
| (Options -> ImportAction
importAction Options
options ImportAction -> ImportAction -> Bool
forall a. Eq a => a -> a -> Bool
== ImportAction
NoImportProcessing)
Bool -> Bool -> Bool
&& (Options -> ExportAction
exportAction Options
options ExportAction -> ExportAction -> Bool
forall a. Eq a => a -> a -> Bool
== ExportAction
NoExportProcessing) =
TcGblEnv -> TcM TcGblEnv
forall (m :: * -> *) a. Monad m => a -> m a
return TcGblEnv
tcEnv
| Bool
otherwise = do
let imports :: [LImportDecl GhcRn]
imports = TcGblEnv -> [LImportDecl GhcRn]
tcg_rn_imports TcGblEnv
tcEnv
[GlobalRdrElt]
uses <- IORef [GlobalRdrElt]
-> IOEnv (Env TcGblEnv TcLclEnv) [GlobalRdrElt]
forall a env. IORef a -> IOEnv env a
readMutVar (IORef [GlobalRdrElt]
-> IOEnv (Env TcGblEnv TcLclEnv) [GlobalRdrElt])
-> IORef [GlobalRdrElt]
-> IOEnv (Env TcGblEnv TcLclEnv) [GlobalRdrElt]
forall a b. (a -> b) -> a -> b
$ TcGblEnv -> IORef [GlobalRdrElt]
tcg_used_gres TcGblEnv
tcEnv
let usage :: [ImportDeclUsage]
usage = [LImportDecl GhcRn] -> [GlobalRdrElt] -> [ImportDeclUsage]
findImportUsage [LImportDecl GhcRn]
imports [GlobalRdrElt]
uses
let noUnusedImports :: Bool
noUnusedImports = (ImportDeclUsage -> Bool) -> [ImportDeclUsage] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (\(LImportDecl GhcRn
_decl, [GlobalRdrElt]
used, [Name]
unused) -> Bool -> Bool
not ([GlobalRdrElt] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [GlobalRdrElt]
used) Bool -> Bool -> Bool
&& [Name] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Name]
unused) [ImportDeclUsage]
usage
let hasExplicitExports :: Bool
hasExplicitExports = case TcGblEnv -> Maybe [(Located (IE GhcRn), Avails)]
tcg_rn_exports TcGblEnv
tcEnv of
Maybe [(Located (IE GhcRn), Avails)]
Nothing -> Bool
False
(Just []) -> Bool
False
(Just [(Located (IE GhcRn), Avails)]
_) -> Bool
True
if (Options -> ImportAction
importAction Options
options ImportAction -> ImportAction -> Bool
forall a. Eq a => a -> a -> Bool
== ImportAction
NoImportProcessing Bool -> Bool -> Bool
|| Bool
noUnusedImports)
Bool -> Bool -> Bool
&& ( Options -> ExportAction
exportAction Options
options ExportAction -> ExportAction -> Bool
forall a. Eq a => a -> a -> Bool
== ExportAction
NoExportProcessing
Bool -> Bool -> Bool
|| (Bool
hasExplicitExports Bool -> Bool -> Bool
&& Options -> ExportAction
exportAction Options
options ExportAction -> ExportAction -> Bool
forall a. Eq a => a -> a -> Bool
/= ExportAction
ReplaceExports)
)
then TcGblEnv -> TcM TcGblEnv
forall (m :: * -> *) a. Monad m => a -> m a
return TcGblEnv
tcEnv
else do
DynFlags
dflags <- IOEnv (Env TcGblEnv TcLclEnv) DynFlags
forall (m :: * -> *). HasDynFlags m => m DynFlags
getDynFlags
IO () -> IOEnv (Env TcGblEnv TcLclEnv) ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> IOEnv (Env TcGblEnv TcLclEnv) ())
-> IO () -> IOEnv (Env TcGblEnv TcLclEnv) ()
forall a b. (a -> b) -> a -> b
$ DynFlags -> CommandLineOption -> IO ()
compilationProgressMsg DynFlags
dflags (CommandLineOption
"smuggler2 " CommandLineOption -> CommandLineOption -> CommandLineOption
forall a. [a] -> [a] -> [a]
++ Version -> CommandLineOption
showVersion Version
version)
let minImpFilePath :: CommandLineOption
minImpFilePath = DynFlags -> Module -> CommandLineOption
mkMinimalImportsPath DynFlags
dflags (ModSummary -> Module
ms_mod ModSummary
modSummary)
DynFlags
-> CommandLineOption
-> [ImportDeclUsage]
-> IOEnv (Env TcGblEnv TcLclEnv) ()
printMinimalImports' DynFlags
dflags CommandLineOption
minImpFilePath [ImportDeclUsage]
usage
TcGblEnv
tcEnv TcGblEnv -> IOEnv (Env TcGblEnv TcLclEnv) () -> TcM TcGblEnv
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ DynFlags -> CommandLineOption -> IOEnv (Env TcGblEnv TcLclEnv) ()
smuggling DynFlags
dflags CommandLineOption
minImpFilePath
where
smuggling :: DynFlags -> FilePath -> RnM ()
smuggling :: DynFlags -> CommandLineOption -> IOEnv (Env TcGblEnv TcLclEnv) ()
smuggling DynFlags
dflags CommandLineOption
minImpFilePath = do
let modulePath :: CommandLineOption
modulePath = case ModLocation -> Maybe CommandLineOption
ml_hs_file (ModLocation -> Maybe CommandLineOption)
-> ModLocation -> Maybe CommandLineOption
forall a b. (a -> b) -> a -> b
$ ModSummary -> ModLocation
ms_location ModSummary
modSummary of
Maybe CommandLineOption
Nothing -> CommandLineOption -> CommandLineOption
forall a. HasCallStack => CommandLineOption -> a
error CommandLineOption
"smuggler2: missing source file location"
Just CommandLineOption
loc -> CommandLineOption
loc
IO () -> IOEnv (Env TcGblEnv TcLclEnv) ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> IOEnv (Env TcGblEnv TcLclEnv) ())
-> IO () -> IOEnv (Env TcGblEnv TcLclEnv) ()
forall a b. (a -> b) -> a -> b
$ TextEncoding -> IO ()
setLocaleEncoding TextEncoding
utf8
let modFileContents :: CommandLineOption
modFileContents = case ModSummary -> Maybe StringBuffer
ms_hspp_buf ModSummary
modSummary of
Maybe StringBuffer
Nothing -> CommandLineOption -> CommandLineOption
forall a. HasCallStack => CommandLineOption -> a
error (CommandLineOption -> CommandLineOption)
-> CommandLineOption -> CommandLineOption
forall a b. (a -> b) -> a -> b
$ CommandLineOption
"smuggler2: missing source file: " CommandLineOption -> CommandLineOption -> CommandLineOption
forall a. [a] -> [a] -> [a]
++ CommandLineOption
modulePath
Just StringBuffer
contents -> StringBuffer -> CommandLineOption
strBufToStr StringBuffer
contents
DynFlags
-> CommandLineOption
-> CommandLineOption
-> RnM (Either () (Anns, ParsedSource))
runParser DynFlags
dflags CommandLineOption
modulePath CommandLineOption
modFileContents RnM (Either () (Anns, ParsedSource))
-> (Either () (Anns, ParsedSource)
-> IOEnv (Env TcGblEnv TcLclEnv) ())
-> IOEnv (Env TcGblEnv TcLclEnv) ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
Left () -> () -> IOEnv (Env TcGblEnv TcLclEnv) ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
Right (Anns
annsHsMod, ParsedSource
astHsMod) -> do
CommandLineOption
minImpFileContents <- IO CommandLineOption
-> IOEnv (Env TcGblEnv TcLclEnv) CommandLineOption
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO CommandLineOption
-> IOEnv (Env TcGblEnv TcLclEnv) CommandLineOption)
-> IO CommandLineOption
-> IOEnv (Env TcGblEnv TcLclEnv) CommandLineOption
forall a b. (a -> b) -> a -> b
$ CommandLineOption -> IO CommandLineOption
readFile CommandLineOption
minImpFilePath
DynFlags
-> CommandLineOption
-> CommandLineOption
-> RnM (Either () (Anns, ParsedSource))
runParser DynFlags
dflags CommandLineOption
minImpFilePath CommandLineOption
minImpFileContents RnM (Either () (Anns, ParsedSource))
-> (Either () (Anns, ParsedSource)
-> IOEnv (Env TcGblEnv TcLclEnv) ())
-> IOEnv (Env TcGblEnv TcLclEnv) ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
Left () ->
IO () -> IOEnv (Env TcGblEnv TcLclEnv) ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> IOEnv (Env TcGblEnv TcLclEnv) ())
-> IO () -> IOEnv (Env TcGblEnv TcLclEnv) ()
forall a b. (a -> b) -> a -> b
$
DynFlags -> MsgDoc -> IO ()
fatalErrorMsg DynFlags
dflags (CommandLineOption -> MsgDoc
text (CommandLineOption -> MsgDoc) -> CommandLineOption -> MsgDoc
forall a b. (a -> b) -> a -> b
$ CommandLineOption
"smuggler: failed to parse minimal imports from " CommandLineOption -> CommandLineOption -> CommandLineOption
forall a. [a] -> [a] -> [a]
++ CommandLineOption
minImpFilePath)
Right (Anns
annsImpMod, L SrcSpan
_ HsModule GhcPs
impMod) -> do
let minImports :: [LImportDecl GhcPs]
minImports = HsModule GhcPs -> [LImportDecl GhcPs]
forall pass. HsModule pass -> [LImportDecl pass]
hsmodImports HsModule GhcPs
impMod
Avails
exports <-
if Options -> ExportAction
exportAction Options
options ExportAction -> ExportAction -> Bool
forall a. Eq a => a -> a -> Bool
== ExportAction
ReplaceExports
then RnM Avails
exportable
else Avails -> RnM Avails
forall (m :: * -> *) a. Monad m => a -> m a
return (Avails -> RnM Avails) -> Avails -> RnM Avails
forall a b. (a -> b) -> a -> b
$ TcGblEnv -> Avails
tcg_exports TcGblEnv
tcEnv
let (ParsedSource
astHsMod', (Anns
annsHsMod', Int
_locIndex), [CommandLineOption]
_log) =
Anns
-> Transform ParsedSource
-> (ParsedSource, (Anns, Int), [CommandLineOption])
forall a.
Anns -> Transform a -> (a, (Anns, Int), [CommandLineOption])
runTransform Anns
annsHsMod (Transform ParsedSource
-> (ParsedSource, (Anns, Int), [CommandLineOption]))
-> Transform ParsedSource
-> (ParsedSource, (Anns, Int), [CommandLineOption])
forall a b. (a -> b) -> a -> b
$
Anns
-> [LImportDecl GhcPs] -> ParsedSource -> Transform ParsedSource
forall (m :: * -> *).
Monad m =>
Anns
-> [LImportDecl GhcPs] -> ParsedSource -> TransformT m ParsedSource
replaceImports Anns
annsImpMod [LImportDecl GhcPs]
minImports ParsedSource
astHsMod
Transform ParsedSource
-> (ParsedSource -> Transform ParsedSource)
-> Transform ParsedSource
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Avails -> ParsedSource -> Transform ParsedSource
forall (m :: * -> *).
Monad m =>
Avails -> ParsedSource -> TransformT m ParsedSource
addExplicitExports Avails
exports
let usedCpp :: CommandLineOption
usedCpp = CommandLineOption -> CommandLineOption -> Bool -> CommandLineOption
forall a. a -> a -> Bool -> a
bool CommandLineOption
"" CommandLineOption
"-cpp" (Extension -> DynFlags -> Bool
xopt Extension
Cpp DynFlags
dflags)
let wasLhs :: CommandLineOption
wasLhs = CommandLineOption -> CommandLineOption -> Bool -> CommandLineOption
forall a. a -> a -> Bool -> a
bool CommandLineOption
"" CommandLineOption
"-lhs" (CommandLineOption -> CommandLineOption -> Bool
isExtensionOf CommandLineOption
"lhs" CommandLineOption
modulePath)
let ext :: CommandLineOption
ext =
CommandLineOption -> Maybe CommandLineOption -> CommandLineOption
forall a. a -> Maybe a -> a
fromMaybe (CommandLineOption -> CommandLineOption
takeExtension CommandLineOption
modulePath) (Options -> Maybe CommandLineOption
newExtension Options
options)
CommandLineOption -> CommandLineOption -> CommandLineOption
forall a. [a] -> [a] -> [a]
++ CommandLineOption
usedCpp
CommandLineOption -> CommandLineOption -> CommandLineOption
forall a. [a] -> [a] -> [a]
++ CommandLineOption
wasLhs
let newContent :: CommandLineOption
newContent = ParsedSource -> Anns -> CommandLineOption
forall ast.
Annotate ast =>
Located ast -> Anns -> CommandLineOption
exactPrint ParsedSource
astHsMod' Anns
annsHsMod'
IO () -> IOEnv (Env TcGblEnv TcLclEnv) ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> IOEnv (Env TcGblEnv TcLclEnv) ())
-> IO () -> IOEnv (Env TcGblEnv TcLclEnv) ()
forall a b. (a -> b) -> a -> b
$ CommandLineOption -> CommandLineOption -> IO ()
writeFile (CommandLineOption
modulePath CommandLineOption -> CommandLineOption -> CommandLineOption
-<.> CommandLineOption
ext) CommandLineOption
newContent
IO () -> IOEnv (Env TcGblEnv TcLclEnv) ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> IOEnv (Env TcGblEnv TcLclEnv) ())
-> IO () -> IOEnv (Env TcGblEnv TcLclEnv) ()
forall a b. (a -> b) -> a -> b
$ CommandLineOption -> IO ()
removeFile CommandLineOption
minImpFilePath
where
exportable :: RnM [AvailInfo]
exportable :: RnM Avails
exportable = do
let rdr_env :: GlobalRdrEnv
rdr_env = TcGblEnv -> GlobalRdrEnv
tcg_rdr_env TcGblEnv
tcEnv
let imports :: ImportAvails
imports = TcGblEnv -> ImportAvails
tcg_imports TcGblEnv
tcEnv
let this_mod :: Module
this_mod = TcGblEnv -> Module
tcg_mod TcGblEnv
tcEnv
(Maybe [(Located (IE GhcRn), Avails)], Avails)
exports <- Maybe (Located [LIE GhcPs])
-> GlobalRdrEnv
-> ImportAvails
-> Module
-> RnM (Maybe [(Located (IE GhcRn), Avails)], Avails)
exports_from_avail Maybe (Located [LIE GhcPs])
forall a. Maybe a
Nothing GlobalRdrEnv
rdr_env ImportAvails
imports Module
this_mod
Avails -> RnM Avails
forall (m :: * -> *) a. Monad m => a -> m a
return ((Maybe [(Located (IE GhcRn), Avails)], Avails) -> Avails
forall a b. (a, b) -> b
snd (Maybe [(Located (IE GhcRn), Avails)], Avails)
exports)
replaceImports ::
Monad m =>
Anns ->
[LImportDecl GhcPs] ->
ParsedSource ->
TransformT m ParsedSource
replaceImports :: Anns
-> [LImportDecl GhcPs] -> ParsedSource -> TransformT m ParsedSource
replaceImports Anns
anns [LImportDecl GhcPs]
minImports t :: ParsedSource
t@(L SrcSpan
l HsModule GhcPs
m) =
case Options -> ImportAction
importAction Options
options of
ImportAction
NoImportProcessing -> ParsedSource -> TransformT m ParsedSource
forall (m :: * -> *) a. Monad m => a -> m a
return ParsedSource
t
ImportAction
_ -> do
[LImportDecl GhcPs]
imps <- Anns -> [LImportDecl GhcPs] -> TransformT m [LImportDecl GhcPs]
forall a (m :: * -> *).
(Data a, Monad m) =>
Anns -> a -> TransformT m a
graftT Anns
anns [LImportDecl GhcPs]
minImports
Bool -> TransformT m () -> TransformT m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless ([LImportDecl GhcPs] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [LImportDecl GhcPs]
imps) (TransformT m () -> TransformT m ())
-> TransformT m () -> TransformT m ()
forall a b. (a -> b) -> a -> b
$ LImportDecl GhcPs -> DeltaPos -> TransformT m ()
forall a (m :: * -> *).
(Constraints a, Monad m) =>
a -> DeltaPos -> TransformT m ()
setEntryDPT ([LImportDecl GhcPs] -> LImportDecl GhcPs
forall a. [a] -> a
head [LImportDecl GhcPs]
imps) ((Int, Int) -> DeltaPos
DP (Int
2, Int
0))
ParsedSource -> TransformT m ParsedSource
forall (m :: * -> *) a. Monad m => a -> m a
return (ParsedSource -> TransformT m ParsedSource)
-> ParsedSource -> TransformT m ParsedSource
forall a b. (a -> b) -> a -> b
$ SrcSpan -> HsModule GhcPs -> ParsedSource
forall l e. l -> e -> GenLocated l e
L SrcSpan
l HsModule GhcPs
m {hsmodImports :: [LImportDecl GhcPs]
hsmodImports = [LImportDecl GhcPs]
imps}
addExplicitExports ::
Monad m =>
Avails ->
ParsedSource ->
TransformT m ParsedSource
addExplicitExports :: Avails -> ParsedSource -> TransformT m ParsedSource
addExplicitExports Avails
exports t :: ParsedSource
t@(L SrcSpan
astLoc HsModule GhcPs
hsMod) =
case Options -> ExportAction
exportAction Options
options of
ExportAction
NoExportProcessing -> ParsedSource -> TransformT m ParsedSource
forall (m :: * -> *) a. Monad m => a -> m a
return ParsedSource
t
ExportAction
AddExplicitExports ->
if Maybe (Located [LIE GhcPs]) -> Bool
forall a. Maybe a -> Bool
isNothing Maybe (Located [LIE GhcPs])
currentExplicitExports then TransformT m ParsedSource
forall (m :: * -> *). Monad m => TransformT m ParsedSource
result else ParsedSource -> TransformT m ParsedSource
forall (m :: * -> *) a. Monad m => a -> m a
return ParsedSource
t
ExportAction
ReplaceExports -> TransformT m ParsedSource
forall (m :: * -> *). Monad m => TransformT m ParsedSource
result
where
currentExplicitExports :: Maybe (Located [LIE GhcPs])
currentExplicitExports :: Maybe (Located [LIE GhcPs])
currentExplicitExports = HsModule GhcPs -> Maybe (Located [LIE GhcPs])
forall pass. HsModule pass -> Maybe (Located [LIE pass])
hsmodExports HsModule GhcPs
hsMod
result :: Monad m => TransformT m ParsedSource
result :: TransformT m ParsedSource
result
| Avails -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null Avails
exports = ParsedSource -> TransformT m ParsedSource
forall (m :: * -> *) a. Monad m => a -> m a
return ParsedSource
t
| Bool
otherwise = do
[LIE GhcPs]
exportsList <- (AvailInfo -> TransformT m (LIE GhcPs))
-> Avails -> TransformT m [LIE GhcPs]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM AvailInfo -> TransformT m (LIE GhcPs)
forall (m :: * -> *).
Monad m =>
AvailInfo -> TransformT m (LIE GhcPs)
mkExportAnnT Avails
exports
(LIE GhcPs -> TransformT m ()) -> [LIE GhcPs] -> TransformT m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ LIE GhcPs -> TransformT m ()
forall a (m :: * -> *).
(Data a, Monad m) =>
Located a -> TransformT m ()
addTrailingCommaT ([LIE GhcPs] -> [LIE GhcPs]
forall a. [a] -> [a]
init [LIE GhcPs]
exportsList)
Located [LIE GhcPs]
lExportsList <- [LIE GhcPs] -> TransformT m (Located [LIE GhcPs])
forall e (m :: * -> *).
(Data e, Monad m) =>
e -> TransformT m (Located e)
mkLoc [LIE GhcPs]
exportsList TransformT m (Located [LIE GhcPs])
-> (Located [LIE GhcPs] -> TransformT m (Located [LIE GhcPs]))
-> TransformT m (Located [LIE GhcPs])
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Located [LIE GhcPs] -> [LIE GhcPs])
-> Located [LIE GhcPs] -> TransformT m (Located [LIE GhcPs])
forall x (m :: * -> *).
(Data x, Monad m) =>
(Located x -> x) -> Located x -> TransformT m (Located x)
mkParenT Located [LIE GhcPs] -> [LIE GhcPs]
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc
ParsedSource -> TransformT m ParsedSource
forall (m :: * -> *) a. Monad m => a -> m a
return (ParsedSource -> TransformT m ParsedSource)
-> ParsedSource -> TransformT m ParsedSource
forall a b. (a -> b) -> a -> b
$ SrcSpan -> HsModule GhcPs -> ParsedSource
forall l e. l -> e -> GenLocated l e
L SrcSpan
astLoc HsModule GhcPs
hsMod {hsmodExports :: Maybe (Located [LIE GhcPs])
hsmodExports = Located [LIE GhcPs] -> Maybe (Located [LIE GhcPs])
forall a. a -> Maybe a
Just Located [LIE GhcPs]
lExportsList}
printMinimalImports' :: DynFlags -> FilePath -> [ImportDeclUsage] -> RnM ()
printMinimalImports' :: DynFlags
-> CommandLineOption
-> [ImportDeclUsage]
-> IOEnv (Env TcGblEnv TcLclEnv) ()
printMinimalImports' DynFlags
dflags CommandLineOption
filename [ImportDeclUsage]
imports_w_usage =
do
[LImportDecl GhcRn]
imports' <- [ImportDeclUsage] -> RnM [LImportDecl GhcRn]
Smuggler2.Imports.getMinimalImports [ImportDeclUsage]
imports_w_usage
IO () -> IOEnv (Env TcGblEnv TcLclEnv) ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> IOEnv (Env TcGblEnv TcLclEnv) ())
-> IO () -> IOEnv (Env TcGblEnv TcLclEnv) ()
forall a b. (a -> b) -> a -> b
$
CommandLineOption -> IOMode -> (Handle -> IO ()) -> IO ()
forall r. CommandLineOption -> IOMode -> (Handle -> IO r) -> IO r
withFile
CommandLineOption
filename
IOMode
WriteMode
( \Handle
h ->
DynFlags -> Handle -> PrintUnqualified -> MsgDoc -> IO ()
printForUser DynFlags
dflags Handle
h PrintUnqualified
neverQualify ([MsgDoc] -> MsgDoc
vcat ((LImportDecl GhcRn -> MsgDoc) -> [LImportDecl GhcRn] -> [MsgDoc]
forall a b. (a -> b) -> [a] -> [b]
map LImportDecl GhcRn -> MsgDoc
forall a. Outputable a => a -> MsgDoc
ppr ((LImportDecl GhcRn -> Bool)
-> [LImportDecl GhcRn] -> [LImportDecl GhcRn]
forall a. (a -> Bool) -> [a] -> [a]
filter (ImportDecl GhcRn -> Bool
forall pass. ImportDecl pass -> Bool
letThrough (ImportDecl GhcRn -> Bool)
-> (LImportDecl GhcRn -> ImportDecl GhcRn)
-> LImportDecl GhcRn
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LImportDecl GhcRn -> ImportDecl GhcRn
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc) [LImportDecl GhcRn]
imports')))
)
where
notImplicit :: ImportDecl pass -> Bool
notImplicit :: ImportDecl pass -> Bool
notImplicit = Bool -> Bool
not (Bool -> Bool)
-> (ImportDecl pass -> Bool) -> ImportDecl pass -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ImportDecl pass -> Bool
forall pass. ImportDecl pass -> Bool
ideclImplicit
notInstancesOnly :: ImportDecl pass -> Bool
notInstancesOnly :: ImportDecl pass -> Bool
notInstancesOnly ImportDecl pass
i = case ImportDecl pass -> Maybe (Bool, Located [LIE pass])
forall pass. ImportDecl pass -> Maybe (Bool, Located [LIE pass])
ideclHiding ImportDecl pass
i of
Just (Bool
False, L SrcSpan
_ []) -> Bool
False
Maybe (Bool, Located [LIE pass])
_ -> Bool
True
keepInstanceOnlyImports :: Bool
keepInstanceOnlyImports :: Bool
keepInstanceOnlyImports = Options -> ImportAction
importAction Options
options ImportAction -> ImportAction -> Bool
forall a. Eq a => a -> a -> Bool
/= ImportAction
MinimiseImports
letThrough :: ImportDecl pass -> Bool
letThrough :: ImportDecl pass -> Bool
letThrough ImportDecl pass
i = ImportDecl pass -> Bool
forall pass. ImportDecl pass -> Bool
notImplicit ImportDecl pass
i Bool -> Bool -> Bool
&& (Bool
keepInstanceOnlyImports Bool -> Bool -> Bool
|| ImportDecl pass -> Bool
forall pass. ImportDecl pass -> Bool
notInstancesOnly ImportDecl pass
i)
mkMinimalImportsPath :: DynFlags -> Module -> FilePath
mkMinimalImportsPath :: DynFlags -> Module -> CommandLineOption
mkMinimalImportsPath DynFlags
dflags Module
this_mod
| Just CommandLineOption
d <- DynFlags -> Maybe CommandLineOption
dumpDir DynFlags
dflags = CommandLineOption
d CommandLineOption -> CommandLineOption -> CommandLineOption
</> CommandLineOption
basefn
| Bool
otherwise = CommandLineOption
basefn
where
basefn :: CommandLineOption
basefn =
CommandLineOption
"smuggler2-" CommandLineOption -> CommandLineOption -> CommandLineOption
forall a. [a] -> [a] -> [a]
++ ModuleName -> CommandLineOption
moduleNameString (Module -> ModuleName
moduleName Module
this_mod) CommandLineOption -> CommandLineOption -> CommandLineOption
forall a. [a] -> [a] -> [a]
++ CommandLineOption
"."
CommandLineOption -> CommandLineOption -> CommandLineOption
forall a. [a] -> [a] -> [a]
++ CommandLineOption -> Maybe CommandLineOption -> CommandLineOption
forall a. a -> Maybe a -> a
fromMaybe CommandLineOption
"smuggler2" (Options -> Maybe CommandLineOption
newExtension Options
options)
CommandLineOption -> CommandLineOption -> CommandLineOption
forall a. [a] -> [a] -> [a]
++ CommandLineOption
".imports"
options :: Options
options :: Options
options = [CommandLineOption] -> Options
parseCommandLineOptions [CommandLineOption]
clopts
strBufToStr :: StringBuffer -> String
strBufToStr :: StringBuffer -> CommandLineOption
strBufToStr sb :: StringBuffer
sb@(StringBuffer ForeignPtr Word8
_ Int
len Int
_) = StringBuffer -> Int -> CommandLineOption
lexemeToString StringBuffer
sb Int
len