{-# LANGUAGE LambdaCase #-}

-- |
-- Description: the core of the 'Smuggler2.Plugin'
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' interface to GHC
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 -- Don't force recompilation.  [Is this the right approach?]
    }

-- | The plugin itself
smugglerPlugin :: [CommandLineOption] -> ModSummary -> TcGblEnv -> TcM TcGblEnv
smugglerPlugin :: [CommandLineOption] -> ModSummary -> TcGblEnv -> TcM TcGblEnv
smugglerPlugin [CommandLineOption]
clopts ModSummary
modSummary TcGblEnv
tcEnv
  -- short circuit, if nothing to do
  | (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
    -- Get the imports and their usage
    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

    -- This ensures that the source file is not touched if there are no unused
    -- imports, or exports already exist and we are not replacing them
    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 -- There is not even a module header
          (Just []) -> Bool
False
          (Just [(Located (IE GhcRn), Avails)]
_) -> Bool
True
    -- ... so short circuit if:
    -- - we are skipping import processing or there are no unused imports, and
    -- - we are skipping export processing or there are explict exports and we are not replacing them
    -- (This is not a complete check; ideally, that the new imp/exports are
    -- different from the existing ones, etc)
    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)

        -- Dump GHC's view of what the minimal imports are for the current
        -- module, so that they can be annotated when parsed back in
        -- This is needed because there too much information loss between
        -- the parsed and renamed AST to use the latter for reconstituting the
        -- source.  An alternative would be to  "index" each name location with
        -- a SrcSpan to allow the name matchup, and to make the 'ParsedSource' a
        -- 100% representation of the original source (modulo tabs, trailing
        -- whitespace per line).
        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

        -- Run smuggling only for its side effects
        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
    -- Does all the work
    smuggling :: DynFlags -> FilePath -> RnM ()
    smuggling :: DynFlags -> CommandLineOption -> IOEnv (Env TcGblEnv TcLclEnv) ()
smuggling DynFlags
dflags CommandLineOption
minImpFilePath = do
      -- The preprocessed source
      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

      -- Read files as UTF-8 strings (GHC accepts only ASCII or UTF-8)
      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

      -- Get the pre-processed module source code
      let modFileContents :: CommandLineOption
modFileContents = case ModSummary -> Maybe StringBuffer
ms_hspp_buf ModSummary
modSummary of
            -- Not clear under what circumstances this could happen
            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

      -- Parse the whole module
      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 () -- do nothing if file is invalid Haskell
        Right (Anns
annsHsMod, ParsedSource
astHsMod) -> do
          -- Read the dumped file of minimal imports
          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

          -- Parse the minimal imports file -- gets the annnotations too
          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
              -- The actual minimal imports themselves, as generated by GHC
              let minImports :: [LImportDecl GhcPs]
minImports = HsModule GhcPs -> [LImportDecl GhcPs]
forall pass. HsModule pass -> [LImportDecl pass]
hsmodImports HsModule GhcPs
impMod

              -- What is exported by the module
              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 -- what is currently exported

              -- Bringing it all together: generate a new ast and annotations for it
              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

              -- Generate new file extension
              -- Was the CPP used?
              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)
              -- Was the source literate Haskell
              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)
              -- prefix any user-supplied options
              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

              -- Print the result
              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

              -- Clean up: delete the GHC-generated imports file
              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

            -- Generates the things that would be exportabe if there were no
            -- explicit export header, so suitable for replacing one
            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 --  actually not needed for the Nothing case
              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)

            --  Replace a target module's imports
            --  See <https://github.com/facebookincubator/retrie/blob/master/Retrie/CPP.hs>
            replaceImports ::
              Monad m =>
              -- | annotations for the replacement imports
              Anns ->
              -- | the replacement imports
              [LImportDecl GhcPs] ->
              -- | target module
              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
                  -- This does all the work
                  -- retrie has a neat `insertImports' function that also
                  -- deduplicates
                  [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
                  -- nudge down the imports list onto a new line
                  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}

            -- Add explict exports to the target module
            addExplicitExports ::
              Monad m =>
              -- | The list of exports to be added
              Avails ->
              -- | target module
              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 ->
                  -- Only add explicit exports if there are none.
                  -- Seems to work even if there is no explict module declaration
                  -- presumably because the annotations that we generate are just
                  -- unused by exactPrint
                  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
                -- This does all the export replacement work
                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 -- there is nothing exportable
                  | Bool
otherwise = do
                    -- Generate the exports list
                    [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
                    -- add commas in between and parens around
                    (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

                    -- No need to do any graftTing here as we have been modifying the
                    -- annotations in the current transformation
                    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}

    -- This version of the GHC function ignores implicit imports, as they
    -- cannot be parsed back in.  (There is an extraneous (implicit))
    -- It also provides for leaving out instance-only imports (eg, Data.List() )
    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 ->
                -- The neverQualify is important.  We are printing Names
                -- but they are in the context of an 'import' decl, and
                -- we never qualify things inside there
                -- E.g.   import Blag( f, b )
                -- not    import Blag( Blag.f, Blag.g )!
                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)

    -- Construct the path into which GHC's version of minimal imports is dumped
    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