    module Hint.Base (
        MonadInterpreter(..), RunGhc,

        GhcError(..), InterpreterError(..), mayFail, catchIE,

        InterpreterSession, SessionData(..),
        InterpreterState(..), fromState, onState,
        InterpreterConfiguration(..),
        ImportList(..), ModuleQualification(..), ModuleImport(..),

        ModuleName, PhantomModule(..),
        findModule, moduleIsLoaded,
        withDynFlags,

        ghcVersion,

        debug, showGHC
    ) where

    import Control.Monad.IO.Class
    import Control.Monad.Catch as MC

    import Data.IORef
    import Data.Dynamic
    import qualified Data.List

    import qualified Hint.GHC as GHC

    import Hint.Extension

    -- | Version of the underlying ghc api. Values are:
    --
    -- * @804@ for GHC 8.4.x
    --
    -- * @806@ for GHC 8.6.x
    --
    -- * etc...
    ghcVersion :: Int
    ghcVersion :: Int
    ghcVersion = __GLASGOW_HASKELL__

    class (MonadIO m, MonadMask m) => MonadInterpreter m where
        fromSession      :: FromSession m a
        modifySessionRef :: ModifySessionRef m a
        runGhc           :: RunGhc m a

    -- this is for hiding the actual types in haddock
    type FromSession      m a = (InterpreterSession -> a) -> m a
    type ModifySessionRef m a = (InterpreterSession -> IORef a) -> (a -> a) -> m a

    data InterpreterError = UnknownError String
                          | WontCompile [GhcError]
                          | NotAllowed  String
                          -- | GhcExceptions from the underlying GHC API are caught
                          -- and rethrown as this.
                          | GhcException String
                          deriving (Int -> InterpreterError -> ShowS
    [InterpreterError] -> ShowS
    InterpreterError -> String
    (Int -> InterpreterError -> ShowS)
    -> (InterpreterError -> String)
    -> ([InterpreterError] -> ShowS)
    -> Show InterpreterError
    forall a.
    (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
    $cshowsPrec :: Int -> InterpreterError -> ShowS
    showsPrec :: Int -> InterpreterError -> ShowS
    $cshow :: InterpreterError -> String
    show :: InterpreterError -> String
    $cshowList :: [InterpreterError] -> ShowS
    showList :: [InterpreterError] -> ShowS
    Show, Typeable)

    data InterpreterState = St {
                               InterpreterState -> [PhantomModule]
    activePhantoms    :: [PhantomModule],
                               InterpreterState -> [PhantomModule]
    zombiePhantoms    :: [PhantomModule],
                               InterpreterState -> Maybe String
    phantomDirectory  :: Maybe FilePath,
                               InterpreterState -> PhantomModule
    hintSupportModule :: PhantomModule,
                               InterpreterState -> Maybe PhantomModule
    importQualHackMod :: Maybe PhantomModule,
                               InterpreterState -> [ModuleImport]
    qualImports       :: [ModuleImport],
                               InterpreterState -> [(Extension, Bool)]
    defaultExts       :: [(Extension, Bool)], -- R/O
                               InterpreterState -> InterpreterConfiguration
    configuration     :: InterpreterConfiguration
                            }

    data ImportList = NoImportList | ImportList [String] | HidingList [String]
      deriving (ImportList -> ImportList -> Bool
    (ImportList -> ImportList -> Bool)
    -> (ImportList -> ImportList -> Bool) -> Eq ImportList
    forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
    $c== :: ImportList -> ImportList -> Bool
    == :: ImportList -> ImportList -> Bool
    $c/= :: ImportList -> ImportList -> Bool
    /= :: ImportList -> ImportList -> Bool
    Eq, Int -> ImportList -> ShowS
    [ImportList] -> ShowS
    ImportList -> String
    (Int -> ImportList -> ShowS)
    -> (ImportList -> String)
    -> ([ImportList] -> ShowS)
    -> Show ImportList
    forall a.
    (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
    $cshowsPrec :: Int -> ImportList -> ShowS
    showsPrec :: Int -> ImportList -> ShowS
    $cshow :: ImportList -> String
    show :: ImportList -> String
    $cshowList :: [ImportList] -> ShowS
    showList :: [ImportList] -> ShowS
    Show)
    data ModuleQualification = NotQualified | ImportAs String | QualifiedAs (Maybe String)
      deriving (ModuleQualification -> ModuleQualification -> Bool
    (ModuleQualification -> ModuleQualification -> Bool)
    -> (ModuleQualification -> ModuleQualification -> Bool)
    -> Eq ModuleQualification
    forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
    $c== :: ModuleQualification -> ModuleQualification -> Bool
    == :: ModuleQualification -> ModuleQualification -> Bool
    $c/= :: ModuleQualification -> ModuleQualification -> Bool
    /= :: ModuleQualification -> ModuleQualification -> Bool
    Eq, Int -> ModuleQualification -> ShowS
    [ModuleQualification] -> ShowS
    ModuleQualification -> String
    (Int -> ModuleQualification -> ShowS)
    -> (ModuleQualification -> String)
    -> ([ModuleQualification] -> ShowS)
    -> Show ModuleQualification
    forall a.
    (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
    $cshowsPrec :: Int -> ModuleQualification -> ShowS
    showsPrec :: Int -> ModuleQualification -> ShowS
    $cshow :: ModuleQualification -> String
    show :: ModuleQualification -> String
    $cshowList :: [ModuleQualification] -> ShowS
    showList :: [ModuleQualification] -> ShowS
    Show)

    -- | Represent module import statement.
    --   See 'setImportsF'
    data ModuleImport = ModuleImport { ModuleImport -> String
    modName :: String
                                     , ModuleImport -> ModuleQualification
    modQual :: ModuleQualification
                                     , ModuleImport -> ImportList
    modImp  :: ImportList
                                     } deriving (Int -> ModuleImport -> ShowS
    [ModuleImport] -> ShowS
    ModuleImport -> String
    (Int -> ModuleImport -> ShowS)
    -> (ModuleImport -> String)
    -> ([ModuleImport] -> ShowS)
    -> Show ModuleImport
    forall a.
    (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
    $cshowsPrec :: Int -> ModuleImport -> ShowS
    showsPrec :: Int -> ModuleImport -> ShowS
    $cshow :: ModuleImport -> String
    show :: ModuleImport -> String
    $cshowList :: [ModuleImport] -> ShowS
    showList :: [ModuleImport] -> ShowS
    Show)

    data InterpreterConfiguration = Conf {
                                      InterpreterConfiguration -> [String]
    searchFilePath :: [FilePath],
                                      InterpreterConfiguration -> [Extension]
    languageExts   :: [Extension],
                                      InterpreterConfiguration -> Bool
    allModsInScope :: Bool
                                    }

    type InterpreterSession = SessionData ()

    instance Exception InterpreterError
      where
        displayException :: InterpreterError -> String
    displayException (UnknownError String
    err) = String
    "UnknownError: " String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ String
    err
        displayException (WontCompile  [GhcError]
    es)  = [String] -> String
    unlines ([String] -> String)
    -> ([GhcError] -> [String]) -> [GhcError] -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . [String] -> [String]
    forall a. Eq a => [a] -> [a]
    Data.List.nub ([String] -> [String])
    -> ([GhcError] -> [String]) -> [GhcError] -> [String]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (GhcError -> String) -> [GhcError] -> [String]
    forall a b. (a -> b) -> [a] -> [b]
    map GhcError -> String
    errMsg ([GhcError] -> String) -> [GhcError] -> String
    forall a b. (a -> b) -> a -> b
    $ [GhcError]
    es
        displayException (NotAllowed   String
    err) = String
    "NotAllowed: "   String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ String
    err
        displayException (GhcException String
    err) = String
    "GhcException: " String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ String
    err

    type RunGhc  m a =
        (forall n.(MonadIO n, MonadMask n) => GHC.GhcT n a)
     -> m a

    data SessionData a = SessionData {
                           forall a. SessionData a -> IORef InterpreterState
    internalState   :: IORef InterpreterState,
                           forall a. SessionData a -> a
    versionSpecific :: a,
                           forall a. SessionData a -> IORef [GhcError]
    ghcErrListRef   :: IORef [GhcError],
                           forall a. SessionData a -> Logger
    ghcLogger       :: GHC.Logger
                         }

    -- When intercepting errors reported by GHC, we only get a ErrUtils.Message
    -- and a SrcLoc.SrcSpan. The latter holds the file name and the location
    -- of the error. However, SrcSpan is abstract and it doesn't provide
    -- functions to retrieve the line and column of the error... we can only
    -- generate a string with this information. Maybe I can parse this string
    -- later.... (sigh)
    newtype GhcError = GhcError{GhcError -> String
    errMsg :: String} deriving Int -> GhcError -> ShowS
    [GhcError] -> ShowS
    GhcError -> String
    (Int -> GhcError -> ShowS)
    -> (GhcError -> String) -> ([GhcError] -> ShowS) -> Show GhcError
    forall a.
    (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
    $cshowsPrec :: Int -> GhcError -> ShowS
    showsPrec :: Int -> GhcError -> ShowS
    $cshow :: GhcError -> String
    show :: GhcError -> String
    $cshowList :: [GhcError] -> ShowS
    showList :: [GhcError] -> ShowS
    Show

    mapGhcExceptions :: MonadInterpreter m
                     => (String -> InterpreterError)
                     -> m a
                     -> m a
    mapGhcExceptions :: forall (m :: * -> *) a.
    MonadInterpreter m =>
    (String -> InterpreterError) -> m a -> m a
    mapGhcExceptions String -> InterpreterError
    buildEx m a
    action =
        m a
    action
          m a -> (InterpreterError -> m a) -> m a
    forall e a. (HasCallStack, Exception e) => m a -> (e -> m a) -> m a
    forall (m :: * -> *) e a.
    (MonadCatch m, HasCallStack, Exception e) =>
    m a -> (e -> m a) -> m a
    `MC.catch` (\InterpreterError
    err -> case InterpreterError
    err of
                                GhcException String
    s -> InterpreterError -> m a
    forall e a. (HasCallStack, Exception e) => e -> m a
    forall (m :: * -> *) e a.
    (MonadThrow m, HasCallStack, Exception e) =>
    e -> m a
    throwM (String -> InterpreterError
    buildEx String
    s)
                                InterpreterError
    _              -> InterpreterError -> m a
    forall e a. (HasCallStack, Exception e) => e -> m a
    forall (m :: * -> *) e a.
    (MonadThrow m, HasCallStack, Exception e) =>
    e -> m a
    throwM InterpreterError
    err)

    catchIE :: MonadInterpreter m => m a -> (InterpreterError -> m a) -> m a
    catchIE :: forall (m :: * -> *) a.
    MonadInterpreter m =>
    m a -> (InterpreterError -> m a) -> m a
    catchIE = m a -> (InterpreterError -> m a) -> m a
    forall e a. (HasCallStack, Exception e) => m a -> (e -> m a) -> m a
    forall (m :: * -> *) e a.
    (MonadCatch m, HasCallStack, Exception e) =>
    m a -> (e -> m a) -> m a
    MC.catch

    -- | Module names are _not_ filepaths.
    type ModuleName = String

    -- ================ Handling the interpreter state =================

    fromState :: MonadInterpreter m => (InterpreterState -> a) -> m a
    fromState :: forall (m :: * -> *) a.
    MonadInterpreter m =>
    (InterpreterState -> a) -> m a
    fromState InterpreterState -> a
    f = do
      ref_st <- FromSession m (IORef InterpreterState)
    forall a. FromSession m a
    forall (m :: * -> *) a. MonadInterpreter m => FromSession m a
    fromSession SessionData () -> IORef InterpreterState
    forall a. SessionData a -> IORef InterpreterState
    internalState
      liftIO $ f <$> readIORef ref_st

    onState :: MonadInterpreter m => (InterpreterState -> InterpreterState) -> m ()
    onState :: forall (m :: * -> *).
    MonadInterpreter m =>
    (InterpreterState -> InterpreterState) -> m ()
    onState InterpreterState -> InterpreterState
    f = () () -> m InterpreterState -> m ()
    forall a b. a -> m b -> m a
    forall (f :: * -> *) a b. Functor f => a -> f b -> f a
    <$ ModifySessionRef m InterpreterState
    forall a. ModifySessionRef m a
    forall (m :: * -> *) a. MonadInterpreter m => ModifySessionRef m a
    modifySessionRef SessionData () -> IORef InterpreterState
    forall a. SessionData a -> IORef InterpreterState
    internalState InterpreterState -> InterpreterState
    f

    -- =============== Error handling ==============================

    mayFail :: MonadInterpreter m => m (Maybe a) -> m a
    mayFail :: forall (m :: * -> *) a. MonadInterpreter m => m (Maybe a) -> m a
    mayFail m (Maybe a)
    action =
        do
            maybe_res <- m (Maybe a)
    action
            --
            es <- modifySessionRef ghcErrListRef (const [])
            --
            case (maybe_res, null es) of
                (Maybe a
    Nothing, Bool
    True)  -> InterpreterError -> m a
    forall e a. (HasCallStack, Exception e) => e -> m a
    forall (m :: * -> *) e a.
    (MonadThrow m, HasCallStack, Exception e) =>
    e -> m a
    throwM (InterpreterError -> m a) -> InterpreterError -> m a
    forall a b. (a -> b) -> a -> b
    $ String -> InterpreterError
    UnknownError String
    "Got no error message"
                (Maybe a
    Nothing, Bool
    False) -> InterpreterError -> m a
    forall e a. (HasCallStack, Exception e) => e -> m a
    forall (m :: * -> *) e a.
    (MonadThrow m, HasCallStack, Exception e) =>
    e -> m a
    throwM (InterpreterError -> m a) -> InterpreterError -> m a
    forall a b. (a -> b) -> a -> b
    $ [GhcError] -> InterpreterError
    WontCompile ([GhcError] -> [GhcError]
    forall a. [a] -> [a]
    reverse [GhcError]
    es)
                (Just a
    a, Bool
    _)      -> a -> m a
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return a
    a

    -- ================= Debugging stuff ===============

    debug :: MonadInterpreter m => String -> m ()
    debug :: forall (m :: * -> *). MonadInterpreter m => String -> m ()
    debug = IO () -> m ()
    forall a. IO a -> m a
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO (IO () -> m ()) -> (String -> IO ()) -> String -> m ()
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> IO ()
    putStrLn (String -> IO ()) -> ShowS -> String -> IO ()
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (String
    "!! " String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++)

    showGHC :: (MonadInterpreter m, GHC.Outputable a) => a -> m String
    showGHC :: forall (m :: * -> *) a.
    (MonadInterpreter m, Outputable a) =>
    a -> m String
    showGHC a
    a
     = do unqual <- RunGhc m PrintUnqualified
    forall a. RunGhc m a
    forall (m :: * -> *) a. MonadInterpreter m => RunGhc m a
    runGhc GhcT n PrintUnqualified
    forall {n :: * -> *}.
    (MonadIO n, MonadMask n) =>
    GhcT n PrintUnqualified
    forall (m :: * -> *). GhcMonad m => m PrintUnqualified
    GHC.getPrintUnqual
          withDynFlags $ \DynFlags
    df ->
            -- TODO: get unit state from somewhere?
            String -> m String
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (String -> m String) -> String -> m String
    forall a b. (a -> b) -> a -> b
    $ DynFlags -> UnitState -> PrintUnqualified -> SDoc -> String
    GHC.showSDocForUser DynFlags
    df UnitState
    GHC.emptyUnitState PrintUnqualified
    unqual (a -> SDoc
    forall a. Outputable a => a -> SDoc
    GHC.ppr a
    a)

    -- ================ Misc ===================================

    -- this type ought to go in Hint.Context, but ghc dislikes cyclic imports...
    data PhantomModule = PhantomModule{PhantomModule -> String
    pmName :: ModuleName, PhantomModule -> String
    pmFile :: FilePath}
                       deriving (PhantomModule -> PhantomModule -> Bool
    (PhantomModule -> PhantomModule -> Bool)
    -> (PhantomModule -> PhantomModule -> Bool) -> Eq PhantomModule
    forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
    $c== :: PhantomModule -> PhantomModule -> Bool
    == :: PhantomModule -> PhantomModule -> Bool
    $c/= :: PhantomModule -> PhantomModule -> Bool
    /= :: PhantomModule -> PhantomModule -> Bool
    Eq, Int -> PhantomModule -> ShowS
    [PhantomModule] -> ShowS
    PhantomModule -> String
    (Int -> PhantomModule -> ShowS)
    -> (PhantomModule -> String)
    -> ([PhantomModule] -> ShowS)
    -> Show PhantomModule
    forall a.
    (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
    $cshowsPrec :: Int -> PhantomModule -> ShowS
    showsPrec :: Int -> PhantomModule -> ShowS
    $cshow :: PhantomModule -> String
    show :: PhantomModule -> String
    $cshowList :: [PhantomModule] -> ShowS
    showList :: [PhantomModule] -> ShowS
    Show)

    findModule :: MonadInterpreter m => ModuleName -> m GHC.Module
    findModule :: forall (m :: * -> *). MonadInterpreter m => String -> m Module
    findModule String
    mn = (String -> InterpreterError) -> m Module -> m Module
    forall (m :: * -> *) a.
    MonadInterpreter m =>
    (String -> InterpreterError) -> m a -> m a
    mapGhcExceptions String -> InterpreterError
    NotAllowed (m Module -> m Module) -> m Module -> m Module
    forall a b. (a -> b) -> a -> b
    $
                        RunGhc m Module
    forall a. RunGhc m a
    forall (m :: * -> *) a. MonadInterpreter m => RunGhc m a
    runGhc RunGhc m Module -> RunGhc m Module
    forall a b. (a -> b) -> a -> b
    $ ModuleName -> Maybe FastString -> GhcT n Module
    forall (m :: * -> *).
    GhcMonad m =>
    ModuleName -> Maybe FastString -> m Module
    GHC.findModule ModuleName
    mod_name Maybe FastString
    forall a. Maybe a
    Nothing
        where mod_name :: ModuleName
    mod_name = String -> ModuleName
    GHC.mkModuleName String
    mn

    moduleIsLoaded :: MonadInterpreter m => ModuleName -> m Bool
    moduleIsLoaded :: forall (m :: * -> *). MonadInterpreter m => String -> m Bool
    moduleIsLoaded String
    mn = (Bool
    True Bool -> m Module -> m Bool
    forall a b. a -> m b -> m a
    forall (f :: * -> *) a b. Functor f => a -> f b -> f a
    <$ String -> m Module
    forall (m :: * -> *). MonadInterpreter m => String -> m Module
    findModule String
    mn)
                       m Bool -> (InterpreterError -> m Bool) -> m Bool
    forall (m :: * -> *) a.
    MonadInterpreter m =>
    m a -> (InterpreterError -> m a) -> m a
    `catchIE` (\InterpreterError
    e -> case InterpreterError
    e of
                                          NotAllowed{}  -> Bool -> m Bool
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Bool
    False
                                          WontCompile{} -> Bool -> m Bool
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Bool
    False
                                          InterpreterError
    _             -> InterpreterError -> m Bool
    forall e a. (HasCallStack, Exception e) => e -> m a
    forall (m :: * -> *) e a.
    (MonadThrow m, HasCallStack, Exception e) =>
    e -> m a
    throwM InterpreterError
    e)

    withDynFlags :: MonadInterpreter m => (GHC.DynFlags -> m a) -> m a
    withDynFlags :: forall (m :: * -> *) a.
    MonadInterpreter m =>
    (DynFlags -> m a) -> m a
    withDynFlags DynFlags -> m a
    action = do
      df <- RunGhc m DynFlags
    forall a. RunGhc m a
    forall (m :: * -> *) a. MonadInterpreter m => RunGhc m a
    runGhc GhcT n DynFlags
    forall {n :: * -> *}. (MonadIO n, MonadMask n) => GhcT n DynFlags
    forall (m :: * -> *). GhcMonad m => m DynFlags
    GHC.getSessionDynFlags
      action df