module Hint.Configuration (
setGhcOption, setGhcOptions,
defaultConf,
get, set, Option, OptionVal(..),
languageExtensions, availableExtensions, Extension(..),
installedModulesInScope,
searchPath
) where
import Control.Monad
import Control.Monad.Catch
import Data.Char
import Data.List (intercalate)
import qualified Hint.GHC as GHC
import qualified Hint.Compat as Compat
import Hint.Base
import Hint.Util (quote)
import Hint.Extension
setGhcOptions :: MonadInterpreter m => [String] -> m ()
setGhcOptions opts =
do old_flags <- runGhc GHC.getSessionDynFlags
(new_flags,not_parsed) <- runGhc2 Compat.parseDynamicFlags old_flags opts
unless (null not_parsed) $
throwM $ UnknownError
$ concat ["flags: ", unwords $ map quote not_parsed,
"not recognized"]
_ <- runGhc1 GHC.setSessionDynFlags new_flags
return ()
setGhcOption :: MonadInterpreter m => String -> m ()
setGhcOption opt = setGhcOptions [opt]
defaultConf :: InterpreterConfiguration
defaultConf = Conf {
languageExts = [],
allModsInScope = False,
searchFilePath = ["."]
}
data Option m a = Option{
_set :: MonadInterpreter m => a -> m (),
_get :: MonadInterpreter m => m a
}
data OptionVal m = forall a . (Option m a) := a
set :: MonadInterpreter m => [OptionVal m] -> m ()
set = mapM_ $ \(opt := val) -> _set opt val
get :: MonadInterpreter m => Option m a -> m a
get = _get
languageExtensions :: MonadInterpreter m => Option m [Extension]
languageExtensions = Option setter getter
where setter es = do resetExtensions
setGhcOptions $ map (extFlag True) es
onConf $ \c -> c{languageExts = es}
getter = fromConf languageExts
resetExtensions = do es <- fromState defaultExts
setGhcOptions $ map (uncurry $ flip extFlag) es
extFlag :: Bool -> Extension -> String
extFlag = mkFlag
where mkFlag b (UnknownExtension o) = strToFlag b o
mkFlag b o = strToFlag b (show o)
strToFlag b o@('N':'o':(c:_))
| isUpper c = "-X" ++ drop (if b then 0 else 2) o
strToFlag b o = "-X" ++ concat ["No"|not b] ++ o
installedModulesInScope :: MonadInterpreter m => Option m Bool
installedModulesInScope = Option setter getter
where getter = fromConf allModsInScope
setter b = do onConf $ \c -> c{allModsInScope = b}
setGhcOption $ "-f" ++
concat ["no-" | not b] ++
"implicit-import-qualified"
searchPath :: MonadInterpreter m => Option m [FilePath]
searchPath = Option setter getter
where getter = fromConf searchFilePath
setter p = do onConf $ \c -> c{searchFilePath = p}
setGhcOption "-i"
setGhcOption $ "-i" ++ intercalate ":" p
fromConf :: MonadInterpreter m => (InterpreterConfiguration -> a) -> m a
fromConf f = fromState (f . configuration)
onConf :: MonadInterpreter m
=> (InterpreterConfiguration -> InterpreterConfiguration)
-> m ()
onConf f = onState $ \st -> st{configuration = f (configuration st)}