    module Hint.Configuration (
          setGhcOption, setGhcOptions,

          defaultConf,

          get, set, Option, OptionVal(..),

          languageExtensions, availableExtensions, Extension(..),
          installedModulesInScope,

          searchPath,

          configureDynFlags, parseDynamicFlags,

    ) where

    import Control.Monad
    import Control.Monad.Catch
    import Data.Char
    import Data.Maybe (maybe)
    import Data.List (intercalate)

    import qualified Hint.GHC as GHC
    import Hint.Base
    import Hint.Util (quote)

    import Hint.Extension

    setGhcOptions :: MonadInterpreter m => [String] -> m ()
    setGhcOptions :: forall (m :: * -> *). MonadInterpreter m => [String] -> m ()
    setGhcOptions [String]
    opts =
        do old_flags <- 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
           logger <- fromSession ghcLogger
           (new_flags,not_parsed) <- runGhc $ parseDynamicFlags logger old_flags opts
           unless (null not_parsed) $
                throwM $ UnknownError
                                $ concat ["flags: ", unwords $ map quote not_parsed,
                                                   "not recognized"]
           _ <- runGhc $ GHC.setSessionDynFlags new_flags
           return ()

    setGhcOption :: MonadInterpreter m => String -> m ()
    setGhcOption :: forall (m :: * -> *). MonadInterpreter m => String -> m ()
    setGhcOption String
    opt = [String] -> m ()
    forall (m :: * -> *). MonadInterpreter m => [String] -> m ()
    setGhcOptions [String
    opt]

    defaultConf :: InterpreterConfiguration
    defaultConf :: InterpreterConfiguration
    defaultConf = Conf {
                    languageExts :: [Extension]
    languageExts   = [],
                    allModsInScope :: Bool
    allModsInScope = Bool
    False,
                    searchFilePath :: [String]
    searchFilePath = [String
    "."]
                  }

    -- | Available options are:
    --
    --    * 'languageExtensions'
    --
    --    * 'installedModulesInScope'
    --
    --    * 'searchPath'
    data Option m a = Option{
                        forall (m :: * -> *) a.
    Option m a -> MonadInterpreter m => a -> m ()
    _set :: MonadInterpreter m => a -> m (),
                        forall (m :: * -> *) a. Option m a -> MonadInterpreter m => m a
    _get :: MonadInterpreter m => m a
                      }

    data OptionVal m = forall a . (Option m a) := a

    -- | Use this function to set or modify the value of any option. It is
    --   invoked like this:
    --
    --   @set [opt1 := val1, opt2 := val2,... optk := valk]@
    set :: MonadInterpreter m => [OptionVal m] -> m ()
    set :: forall (m :: * -> *). MonadInterpreter m => [OptionVal m] -> m ()
    set = (OptionVal m -> m ()) -> [OptionVal m] -> m ()
    forall (t :: * -> *) (m :: * -> *) a b.
    (Foldable t, Monad m) =>
    (a -> m b) -> t a -> m ()
    mapM_ ((OptionVal m -> m ()) -> [OptionVal m] -> m ())
    -> (OptionVal m -> m ()) -> [OptionVal m] -> m ()
    forall a b. (a -> b) -> a -> b
    $ \(Option m a
    opt := a
    val) -> Option m a -> MonadInterpreter m => a -> m ()
    forall (m :: * -> *) a.
    Option m a -> MonadInterpreter m => a -> m ()
    _set Option m a
    opt a
    val

    -- | Retrieves the value of an option.
    get :: MonadInterpreter m => Option m a -> m a
    get :: forall (m :: * -> *) a. MonadInterpreter m => Option m a -> m a
    get = \Option m a
    o -> Option m a -> MonadInterpreter m => m a
    forall (m :: * -> *) a. Option m a -> MonadInterpreter m => m a
    _get Option m a
    o

    -- | Language extensions in use by the interpreter.
    --
    -- Default is: @[]@ (i.e. none, pure Haskell 98)
    languageExtensions :: MonadInterpreter m => Option m [Extension]
    languageExtensions :: forall (m :: * -> *). MonadInterpreter m => Option m [Extension]
    languageExtensions = (MonadInterpreter m => [Extension] -> m ())
    -> (MonadInterpreter m => m [Extension]) -> Option m [Extension]
    forall (m :: * -> *) a.
    (MonadInterpreter m => a -> m ())
    -> (MonadInterpreter m => m a) -> Option m a
    Option [Extension] -> m ()
    MonadInterpreter m => [Extension] -> m ()
    setter m [Extension]
    MonadInterpreter m => m [Extension]
    getter
        where setter :: [Extension] -> m ()
    setter [Extension]
    es = do m ()
    resetExtensions
                             [String] -> m ()
    forall (m :: * -> *). MonadInterpreter m => [String] -> m ()
    setGhcOptions ([String] -> m ()) -> [String] -> m ()
    forall a b. (a -> b) -> a -> b
    $ (Extension -> String) -> [Extension] -> [String]
    forall a b. (a -> b) -> [a] -> [b]
    map (Bool -> Extension -> String
    extFlag Bool
    True) [Extension]
    es
                             (InterpreterConfiguration -> InterpreterConfiguration) -> m ()
    forall (m :: * -> *).
    MonadInterpreter m =>
    (InterpreterConfiguration -> InterpreterConfiguration) -> m ()
    onConf ((InterpreterConfiguration -> InterpreterConfiguration) -> m ())
    -> (InterpreterConfiguration -> InterpreterConfiguration) -> m ()
    forall a b. (a -> b) -> a -> b
    $ \InterpreterConfiguration
    c -> InterpreterConfiguration
    c{languageExts = es}
              --
              getter :: m [Extension]
    getter = (InterpreterConfiguration -> [Extension]) -> m [Extension]
    forall (m :: * -> *) a.
    MonadInterpreter m =>
    (InterpreterConfiguration -> a) -> m a
    fromConf InterpreterConfiguration -> [Extension]
    languageExts
              --
              resetExtensions :: m ()
    resetExtensions = do es <- (InterpreterState -> [(Extension, Bool)]) -> m [(Extension, Bool)]
    forall (m :: * -> *) a.
    MonadInterpreter m =>
    (InterpreterState -> a) -> m a
    fromState InterpreterState -> [(Extension, Bool)]
    defaultExts
                                   setGhcOptions $ uncurry (flip extFlag) <$> es

    extFlag :: Bool -> Extension -> String
    extFlag :: Bool -> Extension -> String
    extFlag = Bool -> Extension -> String
    mkFlag
      where mkFlag :: Bool -> Extension -> String
    mkFlag Bool
    b (UnknownExtension String
    o)   = Bool -> String -> String
    strToFlag Bool
    b String
    o
            mkFlag Bool
    b Extension
    o                      = Bool -> String -> String
    strToFlag Bool
    b (Extension -> String
    forall a. Show a => a -> String
    show Extension
    o)
            --
            strToFlag :: Bool -> String -> String
    strToFlag Bool
    b o :: String
    o@(Char
    'N':Char
    'o':(Char
    c:String
    _))
                                 | Char -> Bool
    isUpper Char
    c = String
    "-X" String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ Int -> String -> String
    forall a. Int -> [a] -> [a]
    drop (if Bool
    b then Int
    0 else Int
    2) String
    o
            strToFlag Bool
    b String
    o                    = String
    "-X" String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ [String] -> String
    forall (t :: * -> *) a. Foldable t => t [a] -> [a]
    concat [String
    "No"|Bool -> Bool
    not Bool
    b] String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    o

    -- | When set to @True@, every module in every available package is implicitly
    --   imported qualified. This is very convenient for interactive
    --   evaluation, but can be a problem in sandboxed environments
    --   (e.g. 'System.Unsafe.unsafePerformIO' is in scope).
    --
    --   Default value is @True@.
    --
    --   Observe that due to limitations in the GHC-API, when set to @False@, the
    --   private symbols in interpreted modules will not be in scope.
    installedModulesInScope :: MonadInterpreter m => Option m Bool
    installedModulesInScope :: forall (m :: * -> *). MonadInterpreter m => Option m Bool
    installedModulesInScope = (MonadInterpreter m => Bool -> m ())
    -> (MonadInterpreter m => m Bool) -> Option m Bool
    forall (m :: * -> *) a.
    (MonadInterpreter m => a -> m ())
    -> (MonadInterpreter m => m a) -> Option m a
    Option Bool -> m ()
    MonadInterpreter m => Bool -> m ()
    forall {m :: * -> *}. MonadInterpreter m => Bool -> m ()
    setter m Bool
    MonadInterpreter m => m Bool
    getter
        where getter :: m Bool
    getter = (InterpreterConfiguration -> Bool) -> m Bool
    forall (m :: * -> *) a.
    MonadInterpreter m =>
    (InterpreterConfiguration -> a) -> m a
    fromConf InterpreterConfiguration -> Bool
    allModsInScope
              setter :: Bool -> m ()
    setter Bool
    b = do (InterpreterConfiguration -> InterpreterConfiguration) -> m ()
    forall (m :: * -> *).
    MonadInterpreter m =>
    (InterpreterConfiguration -> InterpreterConfiguration) -> m ()
    onConf ((InterpreterConfiguration -> InterpreterConfiguration) -> m ())
    -> (InterpreterConfiguration -> InterpreterConfiguration) -> m ()
    forall a b. (a -> b) -> a -> b
    $ \InterpreterConfiguration
    c -> InterpreterConfiguration
    c{allModsInScope = b}
                            String -> m ()
    forall (m :: * -> *). MonadInterpreter m => String -> m ()
    setGhcOption (String -> m ()) -> String -> m ()
    forall a b. (a -> b) -> a -> b
    $ String
    "-f"                   String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++
                                           [String] -> String
    forall (t :: * -> *) a. Foldable t => t [a] -> [a]
    concat [String
    "no-" | Bool -> Bool
    not Bool
    b] String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++
                                           String
    "implicit-import-qualified"

    -- | The search path for source files. Observe that every time it is set,
    --   it overrides the previous search path. The default is @[\".\"]@.
    --
    --   Keep in mind that by a limitation in ghc, @\".\"@ is always in scope.
    searchPath :: MonadInterpreter m => Option m [FilePath]
    searchPath :: forall (m :: * -> *). MonadInterpreter m => Option m [String]
    searchPath = (MonadInterpreter m => [String] -> m ())
    -> (MonadInterpreter m => m [String]) -> Option m [String]
    forall (m :: * -> *) a.
    (MonadInterpreter m => a -> m ())
    -> (MonadInterpreter m => m a) -> Option m a
    Option [String] -> m ()
    MonadInterpreter m => [String] -> m ()
    forall (m :: * -> *). MonadInterpreter m => [String] -> m ()
    setter m [String]
    MonadInterpreter m => m [String]
    getter
        where getter :: m [String]
    getter = (InterpreterConfiguration -> [String]) -> m [String]
    forall (m :: * -> *) a.
    MonadInterpreter m =>
    (InterpreterConfiguration -> a) -> m a
    fromConf InterpreterConfiguration -> [String]
    searchFilePath
              setter :: [String] -> m ()
    setter [String]
    p = do (InterpreterConfiguration -> InterpreterConfiguration) -> m ()
    forall (m :: * -> *).
    MonadInterpreter m =>
    (InterpreterConfiguration -> InterpreterConfiguration) -> m ()
    onConf ((InterpreterConfiguration -> InterpreterConfiguration) -> m ())
    -> (InterpreterConfiguration -> InterpreterConfiguration) -> m ()
    forall a b. (a -> b) -> a -> b
    $ \InterpreterConfiguration
    c -> InterpreterConfiguration
    c{searchFilePath = p}
                            String -> m ()
    forall (m :: * -> *). MonadInterpreter m => String -> m ()
    setGhcOption String
    "-i" -- clear the old path
                            String -> m ()
    forall (m :: * -> *). MonadInterpreter m => String -> m ()
    setGhcOption (String -> m ()) -> String -> m ()
    forall a b. (a -> b) -> a -> b
    $ String
    "-i" String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String -> [String] -> String
    forall a. [a] -> [[a]] -> [a]
    intercalate String
    ":" [String]
    p

                            mfp <- (InterpreterState -> Maybe String) -> m (Maybe String)
    forall (m :: * -> *) a.
    MonadInterpreter m =>
    (InterpreterState -> a) -> m a
    fromState InterpreterState -> Maybe String
    phantomDirectory
                            maybe (return ())
                                  (\String
    fp -> String -> m ()
    forall (m :: * -> *). MonadInterpreter m => String -> m ()
    setGhcOption (String -> m ()) -> String -> m ()
    forall a b. (a -> b) -> a -> b
    $ String
    "-i" String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    fp) mfp

    fromConf :: MonadInterpreter m => (InterpreterConfiguration -> a) -> m a
    fromConf :: forall (m :: * -> *) a.
    MonadInterpreter m =>
    (InterpreterConfiguration -> a) -> m a
    fromConf InterpreterConfiguration -> a
    f = (InterpreterState -> a) -> m a
    forall (m :: * -> *) a.
    MonadInterpreter m =>
    (InterpreterState -> a) -> m a
    fromState (InterpreterConfiguration -> a
    f (InterpreterConfiguration -> a)
    -> (InterpreterState -> InterpreterConfiguration)
    -> InterpreterState
    -> a
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . InterpreterState -> InterpreterConfiguration
    configuration)

    onConf :: MonadInterpreter m
           => (InterpreterConfiguration -> InterpreterConfiguration)
           -> m ()
    onConf :: forall (m :: * -> *).
    MonadInterpreter m =>
    (InterpreterConfiguration -> InterpreterConfiguration) -> m ()
    onConf InterpreterConfiguration -> InterpreterConfiguration
    f = (InterpreterState -> InterpreterState) -> m ()
    forall (m :: * -> *).
    MonadInterpreter m =>
    (InterpreterState -> InterpreterState) -> m ()
    onState ((InterpreterState -> InterpreterState) -> m ())
    -> (InterpreterState -> InterpreterState) -> m ()
    forall a b. (a -> b) -> a -> b
    $ \InterpreterState
    st -> InterpreterState
    st{configuration = f (configuration st)}

    configureDynFlags :: GHC.DynFlags -> GHC.DynFlags
    configureDynFlags :: DynFlags -> DynFlags
    configureDynFlags DynFlags
    dflags =
        (if Bool
    GHC.dynamicGhc then Way -> DynFlags -> DynFlags
    GHC.addWay Way
    GHC.WayDyn else DynFlags -> DynFlags
    forall a. a -> a
    id)
        (DynFlags -> DynFlags)
    -> (DynFlags -> DynFlags) -> DynFlags -> DynFlags
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . DynFlags -> DynFlags
    GHC.setBackendToInterpreter
        (DynFlags -> DynFlags) -> DynFlags -> DynFlags
    forall a b. (a -> b) -> a -> b
    $
                               DynFlags
    dflags{GHC.ghcMode    = GHC.CompManager,
                                      GHC.ghcLink    = GHC.LinkInMemory,
                                      GHC.verbosity  = 0}

    parseDynamicFlags :: GHC.GhcMonad m
                      => GHC.Logger -> GHC.DynFlags -> [String] -> m (GHC.DynFlags, [String])
    parseDynamicFlags :: forall (m :: * -> *).
    GhcMonad m =>
    Logger -> DynFlags -> [String] -> m (DynFlags, [String])
    parseDynamicFlags Logger
    l DynFlags
    d = ((DynFlags, [GenLocated SrcSpan String], Messages DriverMessage)
     -> (DynFlags, [String]))
    -> m (DynFlags, [GenLocated SrcSpan String],
          Messages DriverMessage)
    -> m (DynFlags, [String])
    forall a b. (a -> b) -> m a -> m b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap (DynFlags, [GenLocated SrcSpan String], Messages DriverMessage)
    -> (DynFlags, [String])
    forall {a} {l} {b} {c}. (a, [GenLocated l b], c) -> (a, [b])
    firstTwo (m (DynFlags, [GenLocated SrcSpan String], Messages DriverMessage)
     -> m (DynFlags, [String]))
    -> ([String]
        -> m (DynFlags, [GenLocated SrcSpan String],
              Messages DriverMessage))
    -> [String]
    -> m (DynFlags, [String])
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Logger
    -> DynFlags
    -> [GenLocated SrcSpan String]
    -> m (DynFlags, [GenLocated SrcSpan String],
          Messages DriverMessage)
    forall (m :: * -> *).
    MonadIO m =>
    Logger
    -> DynFlags
    -> [GenLocated SrcSpan String]
    -> m (DynFlags, [GenLocated SrcSpan String],
          Messages DriverMessage)
    GHC.parseDynamicFlags Logger
    l DynFlags
    d ([GenLocated SrcSpan String]
     -> m (DynFlags, [GenLocated SrcSpan String],
           Messages DriverMessage))
    -> ([String] -> [GenLocated SrcSpan String])
    -> [String]
    -> m (DynFlags, [GenLocated SrcSpan String],
          Messages DriverMessage)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (String -> GenLocated SrcSpan String)
    -> [String] -> [GenLocated SrcSpan String]
    forall a b. (a -> b) -> [a] -> [b]
    map String -> GenLocated SrcSpan String
    forall e. e -> Located e
    GHC.noLoc
        where firstTwo :: (a, [GenLocated l b], c) -> (a, [b])
    firstTwo (a
    a,[GenLocated l b]
    b,c
    _) = (a
    a, (GenLocated l b -> b) -> [GenLocated l b] -> [b]
    forall a b. (a -> b) -> [a] -> [b]
    map GenLocated l b -> b
    forall l e. GenLocated l e -> e
    GHC.unLoc [GenLocated l b]
    b)