Macros.hs

{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE LiberalTypeSynonyms #-}

module Axel.Macros where

import Axel.Prelude

import Axel (isPrelude, preludeMacros)
import Axel.AST
  ( Expression(EFunctionApplication, EIdentifier, ERawExpression)
  , FunctionApplication(FunctionApplication)
  , FunctionDefinition(FunctionDefinition)
  , Identifier
  , ImportSpecification(ImportAll)
  , MacroDefinition
  , QualifiedImport(QualifiedImport)
  , RestrictedImport(RestrictedImport)
  , SMStatement
  , Statement(SFunctionDefinition, SMacroDefinition, SMacroImport,
          SMacroImport, SModuleDeclaration, SQualifiedImport,
          SQualifiedImport, SRawStatement, SRestrictedImport, STypeSignature)
  , ToHaskell(toHaskell)
  , TypeSignature(TypeSignature)
  , _SMacroDefinition
  , _SModuleDeclaration
  , functionDefinition
  , imports
  , moduleName
  , name
  , statementsToProgram
  )
import Axel.Denormalize (denormalizeStatement)
import Axel.Eff ((:>>))
import qualified Axel.Eff as Effs
import Axel.Eff.Error (Error(MacroError, ParseError), fatal)
import qualified Axel.Eff.FileSystem as Effs (FileSystem)
import qualified Axel.Eff.FileSystem as FS
import qualified Axel.Eff.Ghci as Effs (Ghci)
import qualified Axel.Eff.Ghci as Ghci
import qualified Axel.Eff.Log as Effs (Log)
import Axel.Eff.Log (logStrLn)
import qualified Axel.Eff.Process as Effs (Process)
import qualified Axel.Eff.Restartable as Effs (Restartable)
import Axel.Eff.Restartable (restart, runRestartable)
import Axel.Haskell.Error (processStackOutputLine)
import Axel.Haskell.Macros (hygenisizeMacroName)
import Axel.Normalize
  ( normalizeExpression
  , normalizeStatement
  , unsafeNormalize
  , unsafeNormalize
  , withExprCtxt
  )
import Axel.Parse (parseMultiple)
import Axel.Parse.AST (_SExpression, bottomUpFmapSplicing, toAxel)
import qualified Axel.Parse.AST as Parse
import Axel.Sourcemap
  ( ModuleInfo
  , SourceMetadata
  , isCompoundExpressionWrapperHead
  , quoteSMExpression
  , renderSourcePosition
  , unwrapCompoundExpressions
  , wrapCompoundExpressions
  )
import qualified Axel.Sourcemap as SM
import Axel.Utils.FilePath ((<.>), (</>), replaceExtension, takeFileName)
import Axel.Utils.List (filterMap, filterMapOut, head')
import Axel.Utils.Recursion (bottomUpFmap, zipperTopDownTraverse)
import Axel.Utils.Zipper (unsafeLeft, unsafeUp)

import Control.Lens (_1, isn't, op, snoc)
import Control.Lens.Extras (is)
import Control.Lens.Operators ((%~), (^.), (^?))
import Control.Monad (guard, unless, when)
import Control.Monad.Extra (whenJust)

import Data.Function (on)
import Data.Generics.Uniplate.Zipper (Zipper, fromZipper, hole, replaceHole, up)
import Data.Hashable (hash)
import Data.List (intersperse, nub)
import Data.List.Extra (mconcatMap)
import Data.List.Split (split, whenElt)
import qualified Data.Map as M
import Data.Maybe (isNothing)
import qualified Data.Text as T

import qualified Language.Haskell.Ghcid as Ghcid

import Effectful ((:>))
import qualified Effectful as Eff
import qualified Effectful.Error.Static as Eff
import qualified Effectful.Reader.Static as Eff
import qualified Effectful.State.Static.Local as Eff

type FunctionApplicationExpanderArgs a = SM.Expression -> a

type FunctionApplicationExpander effs
   = Effs.Callback effs FunctionApplicationExpanderArgs (Maybe [SM.Expression])

type FileExpanderArgs a = FilePath -> a

type FileExpander effs = Effs.Callback effs FileExpanderArgs ()

-- | Fully expand a program, and add macro definition type signatures.
processProgram ::
     forall fileExpanderEffs funAppExpanderEffs effs innerEffs.
     ( innerEffs ~ (Eff.State [SMStatement] ': Effs.Restartable SM.Expression ': Eff.Reader FilePath ': effs)
     , '[ Eff.Error Error, Effs.Ghci, Eff.Reader Ghcid.Ghci, Eff.State ModuleInfo] :>> effs
     , fileExpanderEffs :>> innerEffs
     , funAppExpanderEffs :>> innerEffs
     )
  => FunctionApplicationExpander funAppExpanderEffs
  -> FileExpander fileExpanderEffs
  -> FilePath
  -> SM.Expression
  -> Eff.Eff effs [SMStatement]
processProgram expandFunApp expandFile filePath program = do
  newProgramExpr <-
    Eff.runReader filePath $
    expandProgramExpr
      @funAppExpanderEffs
      @fileExpanderEffs
      expandFunApp
      expandFile
      program
  newStmts <-
    mapM
      (Eff.runReader filePath . withExprCtxt . normalizeStatement)
      (unwrapCompoundExpressions newProgramExpr)
  withAstImports <-
    insertImports filePath (autogeneratedImports filePath) newStmts
  pure $ finalizeProgram withAstImports

finalizeProgram :: [SMStatement] -> [SMStatement]
finalizeProgram stmts =
  let expandQuotes =
        bottomUpFmapSplicing
          (\case
             Parse.SExpression _ (Parse.Symbol _ "quote":xs) ->
               map quoteSMExpression xs
             x -> [x])
      convertList =
        bottomUpFmap $ \case
          Parse.Symbol ann' "List" -> Parse.Symbol ann' "[]"
          x -> x
      convertUnit =
        bottomUpFmap $ \case
          Parse.Symbol ann' "Unit" -> Parse.Symbol ann' "()"
          Parse.Symbol ann' "unit" -> Parse.Symbol ann' "()"
          x -> x
      (nonMacroDefs, macroDefs) = filterMapOut (^? _SMacroDefinition) stmts
      hygenicMacroDefs = map hygenisizeMacroDefinition macroDefs
      macroTySigs = typeMacroDefinitions hygenicMacroDefs
      toTopLevelStmts =
        map (unsafeNormalize normalizeStatement) . unwrapCompoundExpressions
      toProgramExpr = wrapCompoundExpressions . map denormalizeStatement
   in toTopLevelStmts $ convertUnit $ convertList $ expandQuotes $ toProgramExpr $
      nonMacroDefs <>
      map SMacroDefinition hygenicMacroDefs <>
      macroTySigs

isMacroImported ::
     (Eff.State [SMStatement] :> effs) => Identifier -> Eff.Eff effs Bool
isMacroImported macroName = do
  let isFromPrelude = macroName `elem` preludeMacros
  isImportedDirectly <-
    any
      (\case
         SMacroImport macroImport -> macroName `elem` macroImport ^. imports
         _notSMacroImport -> False) <$>
    Eff.get
  pure $ isFromPrelude || isImportedDirectly

ensureCompiledDependency ::
     forall fileExpanderEffs effs.
     (Eff.State ModuleInfo :> effs, fileExpanderEffs :>> effs)
  => FileExpander fileExpanderEffs
  -> Identifier
  -> Eff.Eff effs ()
ensureCompiledDependency expandFile dependencyName = do
  moduleInfo <-
    Eff.gets (M.filter (\(moduleId', _) -> moduleId' == dependencyName))
  case head' $ M.toList moduleInfo of
    Just (dependencyFilePath, (_, transpiledOutput)) ->
      when (isNothing transpiledOutput) $ expandFile dependencyFilePath
    Nothing -> pure ()

isStatementFocused :: Zipper SM.Expression SM.Expression -> Bool
isStatementFocused zipper =
  let wholeProgramExpr = fromZipper zipper
      isCompoundExpr = Just wholeProgramExpr == (hole <$> up zipper)
      isCompoundExprWrapper =
        case hole zipper of
          Parse.Symbol _ "begin" -> True
          _notSymbolBegin -> False
   in isCompoundExpr && not isCompoundExprWrapper

-- | Fully expand a top-level expression.
--   Macro expansion is top-down: it proceeds top to bottom, outwards to inwards,
--   and left to right. Whenever a macro is successfully expanded to yield new
--   expressions in place of the macro call in question, the substitution is made
--   and macro expansion is repeated from the beginning. As new definitions, etc.
--   are found at the top level while the program tree is being traversed, they
--   will be added to the environment accessible to macros during expansion.
expandProgramExpr ::
     forall funAppExpanderEffs fileExpanderEffs effs innerEffs.
     ( innerEffs ~ (Eff.State [SMStatement] ': Effs.Restartable SM.Expression ': effs)
     , '[ Eff.Error Error, Eff.State ModuleInfo, Eff.Reader Ghcid.Ghci, Eff.Reader FilePath] :>> effs
     , funAppExpanderEffs :>> innerEffs
     , fileExpanderEffs :>> innerEffs
     )
  => FunctionApplicationExpander funAppExpanderEffs
  -> FileExpander fileExpanderEffs
  -> SM.Expression
  -> Eff.Eff effs SM.Expression
expandProgramExpr expandFunApp expandFile programExpr =
  runRestartable @SM.Expression programExpr $
  Eff.evalState ([] :: [SMStatement]) .
  zipperTopDownTraverse
    (\zipper -> do
       when (isStatementFocused zipper) $
         -- NOTE This algorithm will exclude the last statement, but we won't
         --      have any macros that rely on it (since macros can only access
         --      what is before them in the file). Thus, this omission is okay.
         let prevTopLevelExpr = hole $ unsafeLeft zipper
          in unless (isCompoundExpressionWrapperHead prevTopLevelExpr) $
             addStatementToMacroEnvironment
               @fileExpanderEffs
               expandFile
               prevTopLevelExpr
       let expr = hole zipper
       when (is _SExpression expr) $ do
         maybeNewExprs <- expandFunApp expr
         case maybeNewExprs of
           Just newExprs -> replaceExpr zipper newExprs >>= restart
           Nothing -> pure ()
       pure expr)

-- | Returns the full program expr (after the necessary substitution has been applied).
replaceExpr ::
     ('[ Eff.Error Error, Eff.Reader FilePath] :>> effs)
  => Zipper SM.Expression SM.Expression
  -> [SM.Expression]
  -> Eff.Eff effs SM.Expression
replaceExpr zipper newExprs =
  let programExpr = fromZipper zipper
      oldExpr = hole zipper
      -- NOTE Using `unsafeUp` is safe since `begin` cannot be the name of a macro,
      --      and thus `zipper` will never be focused on the whole program.
      oldParentExprZ = unsafeUp zipper
      newParentExpr =
        case hole oldParentExprZ of
          Parse.SExpression ann' xs ->
            let xs' = do
                  x <- xs
                  -- TODO What if there are multiple, equivalent copies of `oldExpr`?
                  --      If they are not top-level statements, then the macro in question
                  --      must already exist and thus we would have expanded it already.
                  --      If they are top-level statements, but e.g. were auto-generated, then
                  --      `==` will call them equal. If the macro in question did not exist
                  --      when the first statement was defined, but it does by the second
                  --      statement, then our result may be incorrect.
                  if x == oldExpr
                    then newExprs
                    else pure x
             in Parse.SExpression ann' xs'
          _notSExpression -> fatal "expandProgramExpr" "0001"
      newProgramExpr = fromZipper $ replaceHole newParentExpr oldParentExprZ
   in if newProgramExpr == programExpr
        then throwLoopError oldExpr newExprs
        else pure newProgramExpr

throwLoopError ::
     ('[ Eff.Error Error, Eff.Reader FilePath] :>> effs)
  => SM.Expression
  -> [SM.Expression]
  -> Eff.Eff effs a
throwLoopError oldExpr newExprs = do
  filePath <- Eff.ask
  Eff.throwError $
    MacroError
      filePath
      oldExpr
      ("Infinite loop detected during macro expansion!\nCheck that no macro calls expand (directly or indirectly) to themselves.\n" <>
       toAxel oldExpr <>
       " expanded into " <>
       T.unwords (map toAxel newExprs) <>
       ".")

addStatementToMacroEnvironment ::
     forall fileExpanderEffs effs.
     ( '[ Eff.Error Error, Eff.State ModuleInfo, Eff.Reader FilePath, Eff.State [SMStatement]] :>> effs
     , fileExpanderEffs :>> effs
     )
  => FileExpander fileExpanderEffs
  -> SM.Expression
  -> Eff.Eff effs ()
addStatementToMacroEnvironment expandFile newExpr = do
  filePath <- Eff.ask
  stmt <- Eff.runReader filePath $ withExprCtxt $ normalizeStatement newExpr
  let maybeDependencyName =
        case stmt of
          SRestrictedImport restrictedImport ->
            Just $ restrictedImport ^. moduleName
          SQualifiedImport qualifiedImport ->
            Just $ qualifiedImport ^. moduleName
          SMacroImport macroImport -> Just $ macroImport ^. moduleName
          _ -> Nothing
  whenJust maybeDependencyName $
    ensureCompiledDependency @fileExpanderEffs expandFile
  Eff.modify @[SMStatement] (`snoc` stmt)

-- | If a function application is a macro call, expand it.
handleFunctionApplication ::
     ('[ Eff.Error Error, Effs.FileSystem, Effs.Ghci, Effs.Log, Effs.Process, Eff.State ModuleInfo, Eff.Reader Ghcid.Ghci, Eff.Reader FilePath, Eff.State [SMStatement]] :>> effs)
  => SM.Expression
  -> Eff.Eff effs (Maybe [SM.Expression])
handleFunctionApplication fnApp@(Parse.SExpression ann (Parse.Symbol _ functionName:args)) = do
  shouldExpand <- isMacroCall $ T.pack functionName
  if shouldExpand
    then Just <$>
         withExpansionId
           fnApp
           (expandMacroApplication ann (T.pack functionName) args)
    else pure Nothing
handleFunctionApplication _ = pure Nothing

isMacroCall ::
     (Eff.State [SMStatement] :> effs) => Identifier -> Eff.Eff effs Bool
isMacroCall function = do
  localDefs <- lookupMacroDefinitions function
  let isDefinedLocally = not $ null localDefs
  isImported <- isMacroImported function
  pure $ isImported || isDefinedLocally

lookupMacroDefinitions ::
     (Eff.State [SMStatement] :> effs)
  => Identifier
  -> Eff.Eff effs [MacroDefinition (Maybe SM.Expression)]
lookupMacroDefinitions identifier =
  filterMap
    (\stmt -> do
       macroDef <- stmt ^? _SMacroDefinition
       guard $ identifier == (macroDef ^. functionDefinition . name)
       pure macroDef) <$>
  Eff.get

hygenisizeMacroDefinition :: MacroDefinition ann -> MacroDefinition ann
hygenisizeMacroDefinition = functionDefinition . name %~ hygenisizeMacroName

insertImports ::
     (Eff.Error Error :> effs)
  => FilePath
  -> [SMStatement]
  -> [SMStatement]
  -> Eff.Eff effs [SMStatement]
insertImports filePath newStmts program =
  case split (whenElt $ is _SModuleDeclaration) program of
    [preEnv, [moduleDecl@(SModuleDeclaration _ _)], postEnv] ->
      pure $ preEnv <> [moduleDecl] <> newStmts <> postEnv
    [preEnv, [moduleDecl@(SModuleDeclaration _ _)]] ->
      pure $ preEnv <> [moduleDecl] <> newStmts
    [[moduleDecl@(SModuleDeclaration _ _)], postEnv] ->
      pure $ [moduleDecl] <> newStmts <> postEnv
    [[moduleDecl@(SModuleDeclaration _ _)]] -> pure $ [moduleDecl] <> newStmts
    _ ->
      Eff.throwError $
      ParseError
        filePath
        "Axel files must contain exactly one module declaration!"

mkMacroTypeSignature :: Identifier -> SMStatement
mkMacroTypeSignature macroName =
  SRawStatement Nothing $
  SM.raw (toHaskell (EIdentifier (Nothing :: Maybe SM.Expression) macroName)) <>
  " :: [AxelRuntime_AST.Expression AxelRuntime_Sourcemap.SourceMetadata] -> AxelRuntime_GHCPrelude.IO [AxelRuntime_AST.Expression AxelRuntime_Sourcemap.SourceMetadata]"

newtype ExpansionId =
  ExpansionId Text

mkMacroDefAndEnvModuleName :: ExpansionId -> Identifier
mkMacroDefAndEnvModuleName (ExpansionId expansionId) =
  "AutogeneratedAxelMacroDefinitionAndEnvironment" <> expansionId

mkScaffoldModuleName :: ExpansionId -> Identifier
mkScaffoldModuleName (ExpansionId expansionId) =
  "AutogeneratedAxelScaffold" <> expansionId

autogeneratedImports :: FilePath -> [SMStatement]
autogeneratedImports filePath
  -- We can't import the Axel prelude if we're actually compiling it.
 =
  [ SRestrictedImport $ RestrictedImport Nothing "Axel" (ImportAll Nothing)
  | not $ isPrelude filePath
  ] <>
  [ SQualifiedImport $
    QualifiedImport
      Nothing
      "Prelude"
      "AxelRuntime_GHCPrelude"
      (ImportAll Nothing) -- (in case `-XNoImplicitPrelude` is enabled)
  , SQualifiedImport $
    QualifiedImport
      Nothing
      "Axel.Parse.AST"
      "AxelRuntime_AST"
      (ImportAll Nothing)
  , SQualifiedImport $
    QualifiedImport
      Nothing
      "Axel.Sourcemap"
      "AxelRuntime_Sourcemap"
      (ImportAll Nothing)
  ]

generateMacroProgram ::
     ('[ Eff.Error Error, Effs.FileSystem, Eff.Reader ExpansionId, Eff.State [SMStatement]] :>> effs)
  => FilePath
  -> Identifier
  -> [SM.Expression]
  -> Eff.Eff effs (SM.Output, SM.Output)
generateMacroProgram filePath' oldMacroName args = do
  macroDefAndEnvModuleName <- Eff.asks mkMacroDefAndEnvModuleName
  scaffoldModuleName <- Eff.asks mkScaffoldModuleName
  let newMacroName = hygenisizeMacroName oldMacroName
  let mainFnName = "main_AXEL_AUTOGENERATED_FUNCTION_DEFINITION"
  let footer =
        [ mkMacroTypeSignature mainFnName
        , SRawStatement Nothing $ mainFnName <> " = " <>
          SM.raw
            (toHaskell
               (EIdentifier (Nothing :: Maybe SM.Expression) newMacroName))
        ]
  let (header, scaffold) =
        let mkModuleDecl = SModuleDeclaration Nothing
            mkQualImport moduleName' alias =
              SQualifiedImport $
              QualifiedImport Nothing moduleName' alias (ImportAll Nothing)
            mkId = EIdentifier Nothing
            mkQualId moduleName' identifier =
              EIdentifier Nothing $ moduleName' <> "." <> identifier
            mkTySig fnName ty =
              STypeSignature $ TypeSignature Nothing fnName [] ty
            mkFnDef fnName args' body =
              SFunctionDefinition $
              FunctionDefinition Nothing fnName args' body []
            mkFnApp fn args' =
              EFunctionApplication $ FunctionApplication Nothing fn args'
            mkRawExpr = ERawExpression Nothing
            mkList xs =
              mkFnApp (mkId "[") $ intersperse (mkRawExpr ",") xs <> [mkId "]"] -- This is VERY hacky, but it'll work without too much effort for now.
         in ( autogeneratedImports filePath' <>
              [mkQualImport "Axel.Sourcemap" "AxelRuntime_Sourcemap"]
            , mkModuleDecl scaffoldModuleName : autogeneratedImports filePath' <>
              [ mkQualImport macroDefAndEnvModuleName macroDefAndEnvModuleName
              , mkQualImport "Axel.Sourcemap" "AxelRuntime_Sourcemap"
              , mkTySig "main" $
                mkFnApp (mkId "AxelRuntime_GHCPrelude.IO") [mkId "()"]
              , mkFnDef "main" [] $
                mkFnApp
                  (mkId "(AxelRuntime_GHCPrelude.>>=)")
                  [ mkFnApp
                      (mkQualId
                         macroDefAndEnvModuleName
                         "main_AXEL_AUTOGENERATED_FUNCTION_DEFINITION")
                      [ mkList
                          (map
                             (unsafeNormalize normalizeExpression .
                              quoteSMExpression)
                             args)
                      ]
                  , mkFnApp
                      (mkId "(AxelRuntime_GHCPrelude..)")
                      [ mkId "AxelRuntime_GHCPrelude.putStrLn"
                      , mkFnApp
                          (mkId "(AxelRuntime_GHCPrelude..)")
                          [ mkId "AxelRuntime_GHCPrelude.unlines"
                          , mkFnApp
                              (mkId "AxelRuntime_GHCPrelude.map")
                              [mkId "AxelRuntime_AST.toAxel'"]
                          ]
                      ]
                  ]
              ])
  prevStmts <- Eff.get @[SMStatement]
  -- Mitigate the `::`/`=`-ordering problem (see the description of issue #65).
  let auxEnv =
        reverse . dropWhile (isn't _SMacroDefinition) . reverse $ prevStmts
  -- TODO If the file being transpiled has pragmas but no explicit module declaration,
  --      they will be erroneously included *after* the module declaration.
  --      Should we just require Axel files to have module declarations, or is there a
  --      less intrusive alternate solution?
  macroDefAndEnv <-
    do let moduleDecl = SModuleDeclaration Nothing macroDefAndEnvModuleName
       programStmts <-
         insertImports filePath' header $ replaceModuleDecl moduleDecl $ auxEnv <>
         footer
       pure $ finalizeProgram programStmts
  pure $ ((,) `on` toHaskell . statementsToProgram) scaffold macroDefAndEnv
  where
    replaceModuleDecl newModuleDecl stmts =
      if any (is _SModuleDeclaration) stmts
        then map
               (\case
                  SModuleDeclaration _ _ -> newModuleDecl
                  x -> x)
               stmts
        else newModuleDecl : stmts

typeMacroDefinitions :: [MacroDefinition ann] -> [SMStatement]
typeMacroDefinitions = map mkMacroTypeSignature . getMacroNames
  where
    getMacroNames = nub . map (^. functionDefinition . name)

-- | Source metadata is lost.
--   Use only for logging and such where that doesn't matter.
losslyReconstructMacroCall :: Identifier -> [SM.Expression] -> SM.Expression
losslyReconstructMacroCall macroName args =
  Parse.SExpression
    Nothing
    (Parse.Symbol Nothing (T.unpack macroName) : map (Nothing <$) args)

withExpansionId ::
     SM.Expression
  -> Eff.Eff (Eff.Reader ExpansionId ': effs) a
  -> Eff.Eff effs a
withExpansionId originalCall x =
  let expansionId = showText $ abs $ hash originalCall -- We take the absolute value so that folder names don't start with dashes
                                                       -- (it looks weird, even though it's not technically wrong).
                                                       -- In theory, this allows for collisions, but the chances are negligibly small(?).
   in Eff.runReader (ExpansionId expansionId) x

expandMacroApplication ::
     ('[ Eff.Error Error, Effs.FileSystem, Effs.Ghci, Effs.Log, Effs.Process, Eff.Reader ExpansionId, Eff.Reader Ghcid.Ghci, Eff.Reader FilePath, Eff.State [SMStatement]] :>> effs)
  => SourceMetadata
  -> Identifier
  -> [SM.Expression]
  -> Eff.Eff effs [SM.Expression]
expandMacroApplication originalAnn macroName args = do
  logStrLn $ "Expanding: " <> toAxel (losslyReconstructMacroCall macroName args)
  filePath' <- Eff.ask @FilePath
  macroProgram <- generateMacroProgram filePath' macroName args
  (tempFilePath, newSource) <-
    uncurry (evalMacro originalAnn macroName args) macroProgram
  logStrLn $ "Result: " <> newSource <> "\n\n"
  parseMultiple (Just tempFilePath) newSource

isMacroDefinitionStatement :: Statement ann -> Bool
isMacroDefinitionStatement (SMacroDefinition _) = True
isMacroDefinitionStatement _ = False

evalMacro ::
     forall effs.
     ('[ Eff.Error Error, Effs.FileSystem, Effs.Ghci, Effs.Process, Eff.Reader Ghcid.Ghci, Eff.Reader FilePath, Eff.Reader ExpansionId] :>> effs)
  => SourceMetadata
  -> Identifier
  -> [SM.Expression]
  -> SM.Output
  -> SM.Output
  -> Eff.Eff effs (FilePath, Text)
evalMacro originalCallAnn macroName args scaffoldProgram macroDefAndEnvProgram = do
  macroDefAndEnvModuleName <- Eff.asks mkMacroDefAndEnvModuleName
  scaffoldModuleName <- Eff.asks mkScaffoldModuleName
  tempDir <- getTempDirectory
  let macroDefAndEnvFileName =
        tempDir </> FilePath macroDefAndEnvModuleName <.> "hs"
  let scaffoldFileName = tempDir </> FilePath scaffoldModuleName <.> "hs"
  let resultFile = tempDir </> FilePath "result.axel"
  FS.writeFile scaffoldFileName scaffold
  FS.writeFile macroDefAndEnvFileName macroDefAndEnv
  let moduleInfo =
        M.fromList $
        map
          (_1 %~ flip replaceExtension "axel")
          [ (scaffoldFileName, (scaffoldModuleName, Just scaffoldProgram))
          , ( macroDefAndEnvFileName
            , (macroDefAndEnvModuleName, Just macroDefAndEnvProgram))
          ]
  ghci <- Eff.ask @Ghcid.Ghci
  loadResult <- Ghci.addFiles ghci [scaffoldFileName, macroDefAndEnvFileName]
  if any ("Ok, " `T.isPrefixOf`) loadResult
    then do
      result <- T.unlines <$> Ghci.exec ghci (scaffoldModuleName <> ".main")
      FS.writeFile resultFile $
        generateExpansionRecord
          originalCallAnn
          macroName
          args
          result
          scaffoldFileName
          macroDefAndEnvFileName
      if any ("*** Exception:" `T.isPrefixOf`) (T.lines result)
        then throwMacroError result
        else pure (resultFile, result)
    else throwMacroError $ mconcat $
         mconcatMap (processStackOutputLine moduleInfo) loadResult
  where
    macroDefAndEnv = SM.raw macroDefAndEnvProgram
    scaffold = SM.raw scaffoldProgram
    getTempDirectory = do
      ExpansionId expansionId <- Eff.ask @ExpansionId
      let dirName = FilePath "axelTemp" </> FilePath expansionId
      FS.createDirectoryIfMissing True dirName
      pure dirName
    throwMacroError msg = do
      originalFilePath <- Eff.ask @FilePath
      Eff.throwError $
        MacroError
          originalFilePath
          (losslyReconstructMacroCall macroName args)
          msg

generateExpansionRecord ::
     SourceMetadata
  -> Identifier
  -> [SM.Expression]
  -> Text
  -> FilePath
  -> FilePath
  -> Text
generateExpansionRecord originalAnn macroName args result scaffoldFilePath macroDefAndEnvFilePath =
  T.unlines
    [ result
    , "-- This file is an autogenerated record of a macro call and expansion."
    , "-- It is (likely) not a valid Axel program, so you probably don't want to run it directly."
    , ""
    , "-- The beginning of this file contains the result of the macro invocation at " <>
      locationHint <>
      ":"
    , toAxel (losslyReconstructMacroCall macroName args)
    , ""
    , "-- The macro call itself is transpiled in " <>
      op FilePath (takeFileName scaffoldFilePath) <>
      "."
    , ""
    , "-- To see the (transpiled) modules, definitions, extensions, etc. visible during the expansion, check " <>
      op FilePath (takeFileName macroDefAndEnvFilePath) <>
      "."
    ]
  where
    locationHint = maybe "<unknown>" renderSourcePosition originalAnn