-- | The Happy Haskell Programming library.
--   API for interactive processes
module Hhp.Ghc (
    -- * Converting the Ghc monad to the IO monad
    withGHC,
    withGHC',

    -- * Initializing DynFlags
    initializeFlagsWithCradle,

    -- * Ghc utilities
    boot,
    browse,
    check,
    info,
    types,
    modules,

    -- * SymMdlDb
    Symbol,
    SymMdlDb,
    getSymMdlDb,
    lookupSym,

    -- * Misc
    getSystemLibDir,
    liftIO,
    runGhc,
    getMainFileToBeDeleted,
    Ghc,
) where

import GHC (
    Ghc,
    ModSummary,
    getModuleGraph,
    mgModSummaries,
    moduleName,
    moduleNameString,
    ms_mod,
    runGhc,
 )
import qualified GHC as G
import GHC.Utils.Monad (liftIO)

import Data.List (find)
import Data.Maybe (fromMaybe)

import Hhp.Boot
import Hhp.Browse
import Hhp.Check
import Hhp.Find
import Hhp.GHCApi
import Hhp.Info
import Hhp.List

getMainFileToBeDeleted :: FilePath -> Ghc (Maybe FilePath)
getMainFileToBeDeleted :: FilePath -> Ghc (Maybe FilePath)
getMainFileToBeDeleted FilePath
file = FilePath -> Maybe ModSummary -> Maybe FilePath
isSameMainFile FilePath
file (Maybe ModSummary -> Maybe FilePath)
-> Ghc (Maybe ModSummary) -> Ghc (Maybe FilePath)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Ghc (Maybe ModSummary)
getModSummaryForMain

isSameMainFile :: FilePath -> Maybe G.ModSummary -> Maybe FilePath
isSameMainFile :: FilePath -> Maybe ModSummary -> Maybe FilePath
isSameMainFile FilePath
_ Maybe ModSummary
Nothing = Maybe FilePath
forall a. Maybe a
Nothing
isSameMainFile FilePath
file (Just ModSummary
x)
    | FilePath
mainfile FilePath -> FilePath -> Bool
forall a. Eq a => a -> a -> Bool
== FilePath
file = Maybe FilePath
forall a. Maybe a
Nothing
    | Bool
otherwise = FilePath -> Maybe FilePath
forall a. a -> Maybe a
Just FilePath
mainfile
  where
    mmainfile :: Maybe FilePath
mmainfile = ModLocation -> Maybe FilePath
G.ml_hs_file (ModSummary -> ModLocation
G.ms_location ModSummary
x)
    -- G.ms_hspp_file x is a temporary file with CPP.
    -- this is a just fake.
    mainfile :: FilePath
mainfile = FilePath -> Maybe FilePath -> FilePath
forall a. a -> Maybe a -> a
fromMaybe (ModSummary -> FilePath
G.ms_hspp_file ModSummary
x) Maybe FilePath
mmainfile

getModSummaryForMain :: Ghc (Maybe ModSummary)
getModSummaryForMain :: Ghc (Maybe ModSummary)
getModSummaryForMain = (ModSummary -> Bool) -> [ModSummary] -> Maybe ModSummary
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find ModSummary -> Bool
isMain ([ModSummary] -> Maybe ModSummary)
-> (ModuleGraph -> [ModSummary]) -> ModuleGraph -> Maybe ModSummary
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ModuleGraph -> [ModSummary]
mgModSummaries (ModuleGraph -> Maybe ModSummary)
-> Ghc ModuleGraph -> Ghc (Maybe ModSummary)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Ghc ModuleGraph
forall (m :: * -> *). GhcMonad m => m ModuleGraph
getModuleGraph
  where
    isMain :: ModSummary -> Bool
isMain ModSummary
m = ModuleName -> FilePath
moduleNameString (GenModule Unit -> ModuleName
forall unit. GenModule unit -> ModuleName
moduleName (ModSummary -> GenModule Unit
ms_mod ModSummary
m)) FilePath -> FilePath -> Bool
forall a. Eq a => a -> a -> Bool
== FilePath
"Main"